Graph theory in Dialog

Oh, yeah, this is much better. It easily handles 20 people on the Z-machine without a problem, with no noticeable lag. So let’s take this from the top!

Once again, our global variables. These could just as well be constants, really, except that for the demo I want the player to supply them.

(global variable (total number of people 5))
(global variable (number of knaves 2))
(number of knights $Knights)
	(total number of people $Total)
	(number of knaves $Knaves)
	($Total minus $Knaves into $Knights)
(global variable (number of statements 8))

Now, once again, we want to build a graph with [total number of people] vertices, with the following properties:

  • [number of statements] directed edges
  • every vertex has at least one edge originating from it
  • the graph is connected, when edge directions are ignored

But this time we’re going to come at it from the opposite direction: we’re going to generate a minimal connected graph (that is, a spanning tree), then add random edges to it, instead of starting with a maximal connected graph (a complete graph) and removing random edges.

Since the graphs are going to be sparse, now, we can use adjacency lists instead of an adjacency matrix. In other words, our graph representation will be a list of lists of edges, with one list for each vertex.

(empty graph $G)
	(total number of people $N)
	($N instances of [] into $G)

(0 instances of $ into [])
($N instances of $Value into [$Value|$Tail])
	($N minus 1 into $Nm1)
	($Nm1 instances of $Value into $Tail)

As before, I find the way the library named these predicates deeply unintuitive, so I’m using my own.

(change entry 1 of [$|$Tail] to $Value into [$Value|$Tail])
(change entry $N of [$Head|$Tail] to $Value into [$Head|$NewTail])
	($N minus 1 into $Nm1)
	(change entry $Nm1 of $Tail to $Value into $NewTail)

(entry 1 of [$Head | $] into $Head)
(entry $N of [$ | $Tail] into $Value)
	($N minus 1 into $Nm1)
	(entry $Nm1 of $Tail into $Value)

And some more utilities in the same vein, since Dialog doesn’t have “modify in place” as a core concept.

(increment entry 1 of [$Old|$Tail] into [$New|$Tail])
	($Old plus 1 into $New)
(increment entry $N of [$Head|$Tail] into [$Head|$NewTail])
	($N minus 1 into $Nm1)
	(increment entry $Nm1 of $Tail into $NewTail)

(decrement entry 1 of [$Old|$Tail] into [$New|$Tail])
	($Old minus 1 into $New)
(decrement entry $N of [$Head|$Tail] into [$Head|$NewTail])
	($N minus 1 into $Nm1)
	(decrement entry $Nm1 of $Tail into $NewTail)

(prepend $Value to entry 1 of [$Head|$Tail] into [ [$Value|$Head] | $Tail])
(prepend $Value to entry $N of [$Head|$Tail] into [$Head|$NewTail])
	($N minus 1 into $Nm1)
	(prepend $Value to entry $Nm1 of $Tail into $NewTail)

(delete $Value from entry 1 of [$Old|$Tail] into [$New|$Tail])
	(delete $Value from $Old into $New)
(delete $Value from entry $N of [$Head|$Tail] into [$Head|$NewTail])
	($N minus 1 into $Nm1)
	(delete $Value from entry $Nm1 of $Tail into $NewTail)

%% Remove the first instance of a value from a list
(delete $Value from [$Value|$Tail] into $Tail)
(delete $Value from [$Head|$Tail] into [$Head|$NewTail])
	(delete $Value from $Tail into $NewTail)

Now, how are we going to generate a random spanning tree? Turns out there’s a standard algorithm for that! Specifically, there’s a bijection between Prüfer sequences (a sequence of N-2 numbers, all between 1 and N), and undirected labelled trees (with N vertices). So all we have to do is generate a random Prüfer sequence, and we can turn it into a random tree!

(0 random values between $ and $ into [])
($N random values between $Low and $High into [$Random|$Tail])
	(random from $Low to $High into $Random)
	($N minus 1 into $Nm1)
	($Nm1 random values between $Low and $High into $Tail)

(random Prüfer sequence $Prüfer)
	(total number of people $N)
	($N minus 2 into $Length)
	($Length random values between 1 and $N into $Prüfer)

Fun fact: Dialog allows non-ASCII characters in its identifiers, probably because it was invented by a guy named Åkesson. (Though it doesn’t have full Unicode compatibility, because Swedish still uses the Latin alphabet.)

Now, we just implement the algorithm from Wikipedia to turn a Prüfer sequence into a tree. The hardest part is that this algorithm wants a mutable array, storing a “degree” for each vertex, and that doesn’t work very well with Dialog’s paradigm. But, we can make it work.

(convert Prüfer sequence $Prüfer into tree $G)
	(total number of people $N)
	(empty graph $Empty)
	($N instances of 1 into $InitialDegrees)
	(update degrees $InitialDegrees from sequence $Prüfer into $Degrees)
	
	(use Prüfer sequence $Prüfer on $Empty and $Degrees to make $NewTree and $NewDegrees)
	(use degrees $NewDegrees to add final connection to $NewTree to make $G)

The first sub-component is populating the $Degrees list.

(update degrees $Degrees from sequence [] into $Degrees)
(update degrees $Degrees from sequence [$Head|$Tail] into $Updated)
	(increment entry $Head of $Degrees into $Intermediate)
	(update degrees $Intermediate from sequence $Tail into $Updated)

Conveniently, the algorithm only iterates over the Prüfer sequence once (and never does any random access), so we can make that a straightforward recursive predicate.

(use Prüfer sequence [] on $Tree and $Degrees to make $Tree and $Degrees)
(use Prüfer sequence [$I|$Tail] on $OldTree and $OldDegrees to make $NewTree and $NewDegrees)
	(first index of 1 in $OldDegrees is $J)
	(decrement entry $I of $OldDegrees into $Tmp)
	(decrement entry $J of $Tmp into $Degrees)
	(prepend $J to entry $I of $OldTree into $Tree)
	(use Prüfer sequence $Tail on $Tree and $Degrees to make $NewTree and $NewDegrees)

And once the sequence is complete, find the last two nodes that have non-zero degree values, and link them together.

(use degrees $Degrees to add final connection to $OldTree to make $NewTree)
	(first index of 1 in $Degrees is $U)
	(decrement entry $U of $Degrees into $NewDegrees)
	(first index of 1 in $NewDegrees is $V)
	(prepend $V to entry $U of $OldTree into $NewTree)

This “first index of value” predicate turns out to be a bit clunky. Since memory is our most insurmountable limit, and basically everything is implemented with recursion, I want to do tail recursion as much as possible. (Tail recursion is when the recursive call is the last query in a predicate; when this happens, it doesn’t use any extra stack space, so it’s just as efficient as iterating over the list with a classic for-loop would be.)

Which means designing it like this:

%% This predicate is implemented a bit awkwardly to ensure all recursion is in tail position
%% The more elegant way to do it (without the "counting from") requires addition after the recursive call
(first index of $Value in [$Value|$] counting from $N is $N)
(first index of $Value in [$|$Tail] counting from $N is $Result)
	($N plus 1 into $Np1)
	(first index of $Value in $Tail counting from $Np1 is $Result)

%% So we have a convenience predicate for the standard case
(first index of $Value in $List is $N)
	(first index of $Value in $List counting from 1 is $N)

Now we’ve generated a random tree…with the edges pointing in arbitrary directions. That’s going to be a problem, since we want every knight and knave to make at least one statement. (If you don’t have that requirement, though, you don’t have to worry about this next part. The puzzle is perfectly solvable even if some people are only spoken about, and never speak up themselves.)

So our next goal is to ensure every vertex has at least one outgoing edge. We iterate over the vertices, and if any of them have no outgoing edges:

  • Check if another vertex has two or more outgoing edges, and one of them points to us. If so, flip that edge around.
  • Otherwise, add a new edge from this vertex to a random other vertex.

We also need to keep track of how many new edges we added, for later, which means the same sort of clunkiness as before to ensure recursion is always in tail position.

(ensure testimony from $Tree into $G by adding $E edges)
	(total number of people $N)
	(improve node $N of $Tree into $G by adding $E edges counting from 0)

(improve node $I of $Tree into $G by adding $ENew edges counting from $EOld) %% $EOld is how many we already added; we need to pass it in for tail recursion purposes
	(total number of people $N)
	(if) (entry $I of $Tree into $List) ~(empty $List) (then) %% No need to add anything, there's already an edge here
		($ETmp = $EOld)
		($New = $Tree)
	(elseif) *(have $J count up from 1 to $N) (node $J of $Tree has redundant edge to $I) (then) %% We can flip an edge
		(delete $I from entry $J of $Tree into $Tmp)
		(prepend $J to entry $I of $Tmp into $New)
		($ETmp = $EOld)
	(else) %% We have to insert a new edge
		%% We want to pick a random entry that's NOT this node
		(random from 1 to $N excluding $I into $J)
		(prepend $J to entry $I of $Tree into $New)
		($EOld plus 1 into $ETmp)
	(endif)
	
	%% Now, potentially recurse (counting down because it's a bit easier that way)
	(if) ($I > 1) (then)
		($I minus 1 into $Next)
		(improve node $Next of $New into $G by adding $ENew edges counting from $ETmp)
	(else)
		($G = $New)
		($ENew = $ETmp)
	(endif)

We count down instead of counting up because the code is a bit shorter that way, and it doesn’t really matter.

This requires two simple utilities:

(node $J of $Tree has redundant edge to $I)
	(entry $J of $Tree into $List)
	(length of $List into $Length)
	($Length > 1)
	($I is one of $List)

(random from $Low to $High excluding $Exclude into $Result)
	($High minus 1 into $NewHigh)
	(random from $Low to $NewHigh into $Random) %% Generate a random number in [Low..High-1]
	(if) ($Random < $Exclude) (then) %% If it's less than Exclude, use it directly
		($Result = $Random)
	(else) %% Otherwise, bump it up by 1 to skip over Exclude
		($Random plus 1 into $Result)
	(endif)

This last utility predicate may be useful elsewhere too! Sadly, though, this is the only place we get to use it in this example.

So now we have a puzzle that’s guaranteed to be solvable, where every knight and knave makes at least one statement. Mission complete, right? Well, not quite. We have that global variable at the top specifying how many statements there should be. If we’re not at that number yet, add random edges until we are.

(add 0 random edges to $G into $G)
(add $K random edges to $In into $Out)
	(total number of people $N)
	(random from 1 to $N into $I)
	(entry $I of $In into $Existing)
	(collect $Choice)
		*(have $Choice count up from 1 to $N)
	(into $RawChoices)
	(remove from $RawChoices matching [$I | $Existing] into $Choices)
	(randomly select $J from $Choices)
	(prepend $J to entry $I of $In into $Tmp)
	($K minus 1 into $Km1)
	(add $Km1 random edges to $Tmp into $Out)

We have to use “randomly select” with an explicit list of choices here, because our “random excluding” predicate only lets us exclude one number. Here, we want to exclude the vertex itself, and any vertices it already has connections to, since two statements saying exactly the same thing aren’t much of a puzzle.

Putting these two steps together, we go from a tree to a graph:

(flesh out $Tree into $G)
	(number of statements $Goal)
	(total number of people $N)
	($N minus 1 into $Edges)
	
	(ensure testimony from $Tree into $Tmp by adding $E edges)
	(log) {Improved: $Tmp}
	(if) ($Goal minus $Edges into $Add) ($Add minus $E into $Remaining) (then)
		(add $Remaining random edges to $Tmp into $G)
	(else)
		($G = $Tmp)
	(endif)

And wrap up the whole thing!

(generate random puzzle $G)
	(random Prüfer sequence $Prüfer)
	(log) { Sequence: $Prüfer }
	(convert Prüfer sequence $Prüfer into tree $Tree)
	(log) { Tree: $Tree }
	(flesh out $Tree into $G)
	(log) { G: $G }

Those “log” statements are for debugging; they’ll display in dgdebug but not in the Z-machine. Feel free to comment them out or remove them if they get annoying.

The rest of the code is exactly the same as before, to randomly choose some knaves and present the puzzle. I did expand the “name for index” predicate, though, to handle an arbitrary number of people.

(name for index $Index) %% Automatically generated with regexes
	(if) ($Index = 1) (then)
		Alice
 	(elseif) ($Index = 2) (then)
		Bob
 	(elseif) ($Index = 3) (then)
		Claire
 	(elseif) ($Index = 4) (then)
		Dave
 	(elseif) ($Index = 5) (then)
		Emma
 	(elseif) ($Index = 6) (then)
		Fred
 	(elseif) ($Index = 7) (then)
		Gwen
 	(elseif) ($Index = 8) (then)
		Harry
 	(elseif) ($Index = 9) (then)
		Isabelle
 	(elseif) ($Index = 10) (then)
		Jake
 	(elseif) ($Index = 11) (then)
		Kyra
 	(elseif) ($Index = 12) (then)
		Liam
 	(elseif) ($Index = 13) (then)
		Mary
 	(elseif) ($Index = 14) (then)
		Nick
 	(elseif) ($Index = 15) (then)
		Olivia
 	(elseif) ($Index = 16) (then)
		Pedro
 	(elseif) ($Index = 17) (then)
		Qilin
 	(elseif) ($Index = 18) (then)
		Randall
 	(elseif) ($Index = 19) (then)
		Samantha
 	(elseif) ($Index = 20) (then)
		Thomas
 	(elseif) ($Index = 21) (then)
		Ursula
 	(elseif) ($Index = 22) (then)
		Victor
 	(elseif) ($Index = 23) (then)
		Wynn
 	(elseif) ($Index = 24) (then)
		Xavier
 	(elseif) ($Index = 25) (then)
		Yasmine
 	(elseif) ($Index = 26) (then)
		Zen
	(else)
		Person \#(no space)$Index
	(endif)

And voilà! Have some big puzzles! These were generated on the Z-machine, taking no noticeable time.

16 people have been accused of a crime! 8 of them are actually guilty. The innocent will tell the truth, the guilty will lie.
Alice says: “Pedro is guilty!”
Alice says: “Fred is innocent!”
Bob says: “Nick is guilty!”
Claire says: “Gwen is guilty!”
Dave says: “Kyra is innocent!”
Emma says: “Pedro is guilty!”
Emma says: “Mary is innocent!”
Fred says: “Emma is innocent!”
Fred says: “Jake is guilty!”
Gwen says: “Bob is innocent!”
Harry says: “Gwen is guilty!”
Isabelle says: “Emma is guilty!”
Jake says: “Dave is innocent!”
Kyra says: “Isabelle is innocent!”
Liam says: “Kyra is guilty!”
Mary says: “Jake is guilty!”
Nick says: “Emma is innocent!”
Nick says: “Gwen is guilty!”
Olivia says: “Emma is guilty!”
Pedro says: “Nick is guilty!”
You also have conclusive evidence that Alice is guilty.
Knaves: Emma Harry Fred Nick Alice Mary Claire Liam

27 people have been accused of a crime! 13 of them are actually guilty. The innocent will tell the truth, the guilty will lie.
Alice says: “Xavier is innocent!”
Bob says: “Randall is innocent!”
Claire says: “Gwen is guilty!”
Dave says: “Person #27 is guilty!”
Emma says: “Pedro is guilty!”
Fred says: “Wynn is innocent!”
Gwen says: “Victor is guilty!”
Harry says: “Alice is guilty!”
Isabelle says: “Emma is innocent!”
Jake says: “Fred is innocent!”
Kyra says: “Thomas is guilty!”
Kyra says: “Harry is innocent!”
Liam says: “Samantha is guilty!”
Mary says: “Isabelle is innocent!”
Nick says: “Olivia is innocent!”
Olivia says: “Nick is innocent!”
Pedro says: “Yasmine is innocent!”
Qilin says: “Person #27 is innocent!”
Randall says: “Mary is guilty!”
Samantha says: “Jake is innocent!”
Thomas says: “Olivia is innocent!”
Ursula says: “Nick is innocent!”
Victor says: “Ursula is guilty!”
Wynn says: “Randall is innocent!”
Wynn says: “Gwen is guilty!”
Xavier says: “Zen is guilty!”
Yasmine says: “Xavier is guilty!”
Zen says: “Person #27 is guilty!”
Zen says: “Kyra is innocent!”
Person #27 says: “Samantha is guilty!”
Knaves: Alice Mary Ursula Nick Qilin Thomas Emma Liam Gwen Person #27 Isabelle Olivia Xavier

It still runs out of memory around 40 people, but I think if you’re generating 40-person knights-and-knaves puzzles, hitting the Z-machine RAM limit is to be expected.

knaves2.dg (14.0 KB)
knaves2.z8 (29.6 KB)

4 Likes