% Another minesweeper end game % In the last few steps of a minesweeper game you have a single mine to flag % There are 3 mines somewhere in the 6 squares in the bottom right hand corner of the board % The corner looks like this ( f is a flag, U,V,W, X, Y, Z are unknown squares) % 2 f 2 0 % 1 2 f 3 1 % 1 2 3 U V % 1 1 f W X % 1 2 Y Z % Where is the best place to play to avoid hiting a mine and what are the odds? % Encode U, ..., Z as 1 for a mine and 0 for no mine on that square % b(X) -- bit X, X is either 0 or 1. b(1). b(0). :-dynamic(counters/6). counters(0,0,0,0,0,0). :-dynamic(total/1). total(0). % orginal problem where(Field):-Field=[U,V,W, X, Y, Z], b(U), b(V), b(W), b(X), b(Y), Z is 3-Y-X-W-V-U, b(Z), 1 is U+V, 3 is 2+U+V, 3 is 2+U+W, 2 is 1+Y+Z. % Optimized where2(Field):-Field=[U,V,W, X, Y, Z], b(U), V is 1-U, W is 1-U, b(W), b(X), b(Y), Z is 3-Y-X-W-V-U, b(Z), 1 is Y+Z. field(F):-F=[U1,V1,W1,X1,Y1,Z1], write(U1), write('\t'), write(V1), nl, write(W1), write('\t'), write(X1), nl, write(Y1), write('\t'), write(Z1), nl. go:-where(Field), count(Field), fail. results:-counters(U,V, W,X,Y,Z), total(T), U1 is 100.0*U/T, write(U1), write('\t'), V1 is 100.0*V/T, write(V1), nl, W1 is 100.0*W/T, write(W1), write('\t'), X1 is 100.0*X/T, write(X1), nl, Y1 is 100.0*Y/T, write(Y1), write('\t'), Z1 is 100.0*Z/T, write(Z1), nl. reset:-retract(counters(_,_,_,_,_,_)), assert(counters(0,0,0,0,0,0)), retract(total(_)), assert(total(0)). count(Field):-retract(total(T0)), T1 is T0+1, assert(total(T1)), retract(counters(U0,V0,W0, X0, Y0, Z0)), Field=[U,V,W,X,Y,Z], U1 is U0+U, V1 is V0+V, W1 is W0+W, X1 is X0+X, Y1 is Y0+Y, Z1 is Z0+Z, assert(counters(U1,V1,W1,X1,Y1,Z1)).