Functional Solutions to Mastermind in Q

Mastermind

  • A popular code-breaking game sold since 1975
  • The “codemaker” picks a 4-color code
  • The “codebreaker” attempts to discover the code by submitting guesses
  • Responses provide two sets of information
    • the number correct colored pegs in the correct position
    • the number of correct colored pegs in the wrong position
  • A winning response would be (4,0)
  • Donald E. Knuth published a 5-move algorithm in 1976
  • Better algorithms have since been published that:
    • achieve lower average move counts
    • but require some solution to use more than 5 moves
  • Some editions increase the number of pegs and/or colors

Permutations (with repeat)

The classic Mastermind game allows the code to have repeated colors.

perm:{$[x>0;(cross/)x#enlist y;{raze x{x,/:y except x}\:y}[;y]/[-1-x;y]]}
,,,,

Taking 4 pegs from 6 colors generates 1296 permutations:

q)show C:.mm.perm[4] "123456"
"1111"
"1112"
"1113"
"1114"
"1115"
"1116"
"1121"
..

Permutations (without repeat)

Preventing repeats shrinks the solution space to 360 permutations:

q).mm.perm[-4] "123456"
"1234"
"1235"
"1236"
"1243"
"1245"
"1246"
"1253"
..

Increasing the number of colors from 6 to 8 brings the complexity of the problem close to the classic game:

q)count .mm.perm[-4] "12345678"
1680

Scoring

/ drop the first instance of y in x
drop:{x _ x ? y}
/ vectorize an atomic function
veca:{[f;x;y]$[type x;$[type y;f[x;y];x f/: y];type y;x f\: y;x f/:\: y]}
/ x,y = score,guess in any order
scr:{(e;count[x]-(e:"j"$sum x=y)+count x drop/ y)}
score:veca scr
q).mm.score["1123";("1234";"5432")]
1 2
0 2

Score Distributions

freq:count each group@          / frequency distribution
hist:freq asc@                  / histogram
q).mm.hist .mm.score[C] "1234"
0 0| 16
0 1| 152
0 2| 312
0 3| 136
0 4| 9
1 0| 108
1 1| 252
1 2| 132
1 3| 8
2 0| 96
2 1| 48
2 2| 6
3 0| 20
4 0| 1

Peg Distributions

First Guess

/ compute the frequency distribution of x with (c)olumn names
freqdist:{[c;x]([]x:u)!flip c!freq'[x]@\:u:asc distinct raze x}
q)G:("1111";"1112";"1122";"1123";"1234")
q)show T:`score xcol .mm.freqdist[`$G] .mm.score[G;C]
score| 1111 1112 1122 1123 1234
-----| ------------------------
0 0  | 625  256  256  81   16  
0 1  |      308  256  276  152 
0 2  |      61   96   222  312 
0 3  |           16   44   136 
0 4  |           1    2    9   
1 0  | 500  317  256  182  108 
1 1  |      156  208  230  252 
1 2  |      27   36   84   132 
1 3  |                4    8   
2 0  | 150  123  114  105  96  
2 1  |      24   32   40   48  
2 2  |      3    4    5    6   
3 0  | 20   20   20   20   20  
4 0  | 1    1    1    1    1   

MINIMAX (knuth)

q)T upsert (1 2#0N),value max T
score| 1111 1112 1122 1123 1234
-----| ------------------------
0 0  | 625  256  256  81   16  
0 1  |      308  256  276  152 
0 2  |      61   96   222  312 
0 3  |           16   44   136 
0 4  |           1    2    9   
1 0  | 500  317  256  182  108 
1 1  |      156  208  230  252 
1 2  |      27   36   84   132 
1 3  |                4    8   
2 0  | 150  123  114  105  96  
2 1  |      24   32   40   48  
2 2  |      3    4    5    6   
3 0  | 20   20   20   20   20  
4 0  | 1    1    1    1    1   
     | 625  317  256  276  312 

IRVING (min expected size)

q)show T upsert (1 2#0N),value "j"$T wavg T
score| 1111 1112 1122 1123 1234
-----| ------------------------
0 0  | 625  256  256  81   16  
0 1  |      308  256  276  152 
0 2  |      61   96   222  312 
0 3  |           16   44   136 
0 4  |           1    2    9   
1 0  | 500  317  256  182  108 
1 1  |      156  208  230  252 
1 2  |      27   36   84   132 
1 3  |                4    8   
2 0  | 150  123  114  105  96  
2 1  |      24   32   40   48  
2 2  |      3    4    5    6   
3 0  | 20   20   20   20   20  
4 0  | 1    1    1    1    1   
     | 512  236  205  185  188 

MAXENT (maximum entropy)

q)show T upsert (1 2#0N),value "j"$100*.mm.entropy each flip value T
score| 1111 1112 1122 1123 1234
-----| ------------------------
0 0  | 625  256  256  81   16  
0 1  |      308  256  276  152 
0 2  |      61   96   222  312 
0 3  |           16   44   136 
0 4  |           1    2    9   
1 0  | 500  317  256  182  108 
1 1  |      156  208  230  252 
1 2  |      27   36   84   132 
1 3  |                4    8   
2 0  | 150  123  114  105  96  
2 1  |      24   32   40   48  
2 2  |      3    4    5    6   
3 0  | 20   20   20   20   20  
4 0  | 1    1    1    1    1   
     | 150  269  289  304  306 

MOSTPARTS (most partitions)

q)show T upsert (1 2#0N),value sum 0<T
score| 1111 1112 1122 1123 1234
-----| ------------------------
0 0  | 625  256  256  81   16  
0 1  |      308  256  276  152 
0 2  |      61   96   222  312 
0 3  |           16   44   136 
0 4  |           1    2    9   
1 0  | 500  317  256  182  108 
1 1  |      156  208  230  252 
1 2  |      27   36   84   132 
1 3  |                4    8   
2 0  | 150  123  114  105  96  
2 1  |      24   32   40   48  
2 2  |      3    4    5    6   
3 0  | 20   20   20   20   20  
4 0  | 1    1    1    1    1   
     | 5    11   13   14   14  

Filtering

Filter guess list to only those that would produce returned score

/ unused (C)odes, viable (G)uesses, next (g)uess, (s)core
filt:{[C;G;g;s](drop[C;g];G where (s~score[g]@) each G)}
q)last .mm.filt[C;C;"1234";1 1]
"1112"
"1113"
"1121"
"1122"
"1125"
"1126"
"1141"
..

Guess Algorithms

Given the frequency distribution of the remaining guesses, we have four one-step algorithms to pick the next best guess.

minimax:{x=min x:max each x}       / min max size (knuth)
irving:{x=min x:{x wavg x} each x} / min expected size
maxent:{x=max x:entropy each x}    / max entropy
maxparts:{x=max x:count each x}    / most parts
q)C where .mm.maxent .mm.freq each .mm.score[C;C]
"1234"
"1235"
"1236"
"1243"
"1245"
"1246"
"1253"
..

Best Guess

/ use (f)unction to filter all unpicked (C)odes for best split. 
/ pick a solution from viable (G)uesses (if possible)
best:{[f;C;G]first $[3>count G;G;count G:G inter C@:where f freq each score[C;G];G;C]}
q)CG:.mm.filt[C;C;"1234";1 1]
q).mm.best[;CG 0;CG 1] each `.mm.minimax`.mm.irving`.mm.maxent`.mm.maxparts
"1135"
"1256"
"1356"
"1125"

A Game

  • A turn calls the algorithm and returns the score of the guess.

    turn:{[a;c;CGgs] CGg,enlist score[c]last CGg:a CGgs}
    
  • A game keeps taking turns until a perfect score is reached.

    game:{[a;C;g;c](not count[g]=first last@) turn[a;c]\(C;C;g;score[c;g])}
    
  • A game summary returns the number of viable guesses, the actual guess and the resulting guess.

    summary:{[CGgs]`n`guess`score!(count CGgs 1),-2#CGgs}
    

An Interactive Game

With these abstractions, we can compose a new game which allows us to pass each guess in from STDIN.

q).mm.summary each .mm.game[.mm.stdin[.mm.onestep[`.mm.maxent]];C;"1234"] rand C
n    guess  score
-----------------
1296 "1234" 0 2  
guess (HINT 2356): 2356
n   guess  score
----------------
312 "2356" 1 0  
guess (HINT 4164): 4164
n  guess  score
---------------
22 "4164" 3 0  
guess (HINT 4166): 4166
n    guess  score
-----------------
1296 "1234" 0 2  
312  "2356" 1 0  
22   "4164" 3 0  
1    "4166" 4 0  

Faster

Calculating the average guess count for a given algorithm involves iterating over every possible score.

  • The slowest part of the process is the scoring algorithm.
  • What if we pre-calculated each of the scores?

    q)score:C!C!/:C .mm.score\:/: C
    q)C score\:/: C
    'rank
      [0]  C score\:/: C
    
  • This works for matrices though?!

    x:(1 2 3;4 5 6;7 8 9)
    q)0 1 2 x/:\: 2 1 0
    3 2 1
    6 5 4
    9 8 7
    

Vector Indexing

The solution is vector indexing.

  • Vector indexing works for matrices,

    q)x[0 1 2;2 1 0]
    3 2 1
    6 5 4
    9 8 7
    
  • and dictionaries - because vector indexing is implemented as ‘each right’ - ‘each left’.

    q) score[C;C]
    4 0 3 0 3 0 3 0 3..
    3 0 4 0 3 0 3 0 3..
    3 0 3 0 4 0 3 0 3..
    3 0 3 0 3 0 4 0 3..
    3 0 3 0 3 0 3 0 4..
    3 0 3 0 3 0 3 0 3..
    3 0 2 2 2 1 2 1 2..
    ..
    

== Algorithm Comparison

With the speed improvement gained through caching the scoring function, we can now traverse all paths and see which algorithm takes the least turns (on average)footnote:[in 1993, Kenji Koyama and Tony W. Lai found a method that required an average of 5625/1296 = 4.340 turns to solve, with a worst-case scenario of six turns. The game theory optimal value is 5600/1296 = 4.321.].

q)D:`turns xcol .mm.freqdist[`simple`minimax`irving`maxent`maxparts] (a;b;c;d;e)
q)show ("f"$D) upsert 0N,value[flip value D] wavg\: key[D]`turns
turns| simple  minimax irving   maxent   maxparts
-----| ------------------------------------------
1    | 1       1       1        1        1       
2    | 4       6       10       4        12      
3    | 25      62      54       71       72      
4    | 108     533     645      612      635     
5    | 305     694     583      596      569     
6    | 602             3        12       7       
7    | 196                                       
8    | 49                                        
9    | 6                                         
     | 5.76466 4.47608 4.395062 4.415123 4.373457

Solutions

#include"k.h"
#include <string.h>

// x,y: 4-digit char vector representing mastermind code and guess
// returns (# correct value,position;# correct value wrong position)
K2(score) {
  K r;
  I i,j,e,n;
  char X[5], Y[5];

  P(xt != KC || y->t != KC, krr("type"));
  P(xn !=  4 || y->n !=  4, krr("length"));

  memcpy(X,kC(x),4);            // copy data before manipulating
  memcpy(Y,kC(y),4);

  i=0;
  n=xn;
  do {                
    if (X[i] == Y[i]){          // first check for correct positions
      memmove(X+i,X+i+1,--n);   // remove matches from list
      memmove(Y+i,Y+i+1,n);
    } else
      i++;
  } while(i<n);

  e=xn-n;                       // record exact matches

  // now we check for matches but in the wrong position
  if(n>1) // can't have wrong position unless 2 or more values remain
    for(i=n-1;i>=0;--i)
      for(j=0;j<n;++j)
        if(X[i] == Y[j]){
          memmove(Y+j,Y+j+1,--n); // remove match from list
          break;
        }

  r=ktn(KI,2);
  kI(r)[0]=e;
  kI(r)[1]=xn-e-n;
  R r;
}
score:{n,4-(n:sum x=y)+count{x _x?y}/[x;y]}
score:{(4-c),$[f2~df:distinct f2:f where not (c:count w)=f:(x@:w)?y@:w:where not x=y;
  count df;
  count[df]+sum @[y;f?df;:;"_"] in @[x;df;:;" "]
  ]}
score:{n:0 0 0 0 0 0 0 0 0 0 0 0i;n[-49 -49 -49 -49 -43 -43 -43 -43i+"i"$x,y]+:1i;b,(sum(&). 0 6_n)-b:sum x=y}
k)score:{[x;y;z;w]y@6/:x w,z}[@[&,55;"123456";:;!6];{(+/m;0+/&/g@\:!*g:(#:'=:)'(y n;x n:&~m:x=y))}.',/(,\:/:)/2#,,:'.q.cross/4#,"123456"]