RosettaCodeData/Task/Mastermind/Phix/mastermind.phix

570 lines
21 KiB
Plaintext

-- demo/rosetta/mastermind.exw
constant SET_LIMIT = 1_000_000 -- above this, it uses random sampling.
constant help_text = """
The game of mastermind, with a Knuth solver.
Specify the number of colours (1..20), the code length (1..10), the
number of guesses allowed (1-20), and whether colours can be repeated
(auto-ticked & greyed-out inactive when length>colours).
Note that at the highest settings there are 10,240,000,000,000 possible
answers: the (order n squared) analysis of that is simply not practical,
as indeed is simply building the initial list of all possible answers,
and therefore a fixed limit of 1,000,000 has been applied, which also
just about manages to keep the program responsive. Obviously, should the
actual answer not be among those samples, it cannot possibly find it,
and it will tell you in plain english when that occurs. You can always
trim the search space back to something more reasonable at any time, and
still play the game when that limit is breached, with weaker hints.
Conversely the lowest settings do not make for an interesting game, but
proved quite useful when ironing out some bugs, so were left in.
The Use button (disabled until something useful found) allows you to
take the best found (so far), displayed at the top of the colours frame.
Obviously "1/1 (100%)" means that it has deduced the correct answer.
Below that the colours frame shows all available colours, which can be
individually clicked in any order.
Press Delete or click on the last peg (in the left-hand game frame)
to remove it, before the last one is placed, however once full your
turn is immediately scored and cannot be undone.
New Game, Help, and Exit buttons are assumed to be self-explanatory.
Changing the option settings implicitly triggers a new game, except
for the number of permitted guesses, pre-game-over. Reducing the
number of guesses can also be used as a means of conceding.
When a correct guess is entered or all guesses have been used the hint
and colours are replaced with "GAME OVER - YOU WIN/LOSE" under the
actual answer.
"""
include pGUI.e
Ihandle dlg, colours, codelen, maxgoes, repeats, progress,
usehint, game_canvas, colour_canvas
integer ncolours, ncodelen, nmaxgoes
bool brepeats
sequence secret = {},
hint = {},
guesses = {{}},
scores = {}
--
-- note: while the game is ongoing, length(guesses) should always be
-- length(scores)+1; equal lengths is equivalent to game over.
--
function get_score(sequence guess, goal)
integer blacks = 0, -- (right colour & place)
whites = 0 -- ("" but wrong place)
for i=1 to length(guess) do
if guess[i]=goal[i] then
blacks += 1
guess[i] = ' '
goal[i] = ' '
end if
end for
for i=1 to length(guess) do
if guess[i]!=' ' then
integer k = find(guess[i],goal)
if k then
whites += 1
goal[k] = ' '
end if
end if
end for
return {blacks, whites}
end function
function random_set()
-- create the secret code, and/or (when rqd) a SET_LIMIT random sample
sequence cset = tagset(ncolours),
res = repeat(0,ncodelen)
for i=1 to ncodelen do
integer c = rand(length(cset))
res[i] = cset[c]
if not brepeats then
cset[c..c] = {}
end if
end for
return res
end function
sequence initial_set
atom is_len, -- logically length(initial_set), except when > SET_LIMIT.
excluded -- initialset[1..excluded-1], are not, [excluded..$] are.
procedure create_initial_set()
is_len = iff(brepeats?power(ncolours,ncodelen):k_perm(ncolours,ncodelen))
if is_len<=SET_LIMIT then
--
-- generate the full set
--
initial_set = repeat(0,is_len)
excluded = is_len+1 -- (ie none)
sequence next = iff(brepeats?repeat(1,ncodelen):tagset(ncodelen))
for i=1 to is_len do
initial_set[i] = next
for ndx=length(next) to 1 by -1 do
integer n = next[ndx]
while n<=ncolours do
n += 1
if brepeats
-- or not find(n,next[1..ndx-1]) then
or not find(n,next) then --(see below)
exit
end if
end while
next[ndx] = n
if n<=ncolours then
if not brepeats then
--
-- Fill in the rest lowest-first, eg
-- in the 4 colours and 4 holes case:
-- (start) (above) (this)
-- {1,2,3,4} --> {1,2,4,_} --> {1,2,4,3}
-- {1,2,4,3} --> {1,3,_,_} --> {1,3,2,4}
-- ... (20 other cases omitted)
-- {4,3,1,2} --> {4,3,2,_} --> {4,3,2,1}
--
-- (probably sub-optimal, but insignificant
-- vs. the o(n^2) analysis which follows.)
--
for j=ndx+1 to length(next) do
for k=1 to ncolours do
-- if not find(k,next[1..j-1]) then
if not find(k,next) then --(see below)
next[j] = k
exit
end if
end for
end for
end if
exit
end if
--
-- technical note: if not brepeats, we are going to
-- replace all next[ndx..$] later/above anyway, but
-- replacing with 0 means we can avoid those slices.
-- The next three all work: 1 is perfect for the
-- brepeats=true case, but brepeats=false needs the
-- above slices, while the 2nd & 3rd are equivalent
-- the latter is obviously somewhat faster, at the
-- cost of a wtf?!, without a comment such as this.
--
-- next[ndx] = 1
-- next[ndx] = iff(brepeats?1:0)
next[ndx] = brepeats -- (equivalent)
end for
end for
else
--
-- generate SET_LIMIT random codes
-- note that if (as is quite likely) the actual answer is
-- not present in initial_set, then obviously it cannot
-- possibly find it!
--
initial_set = repeat(0,SET_LIMIT)
excluded = SET_LIMIT+1 -- (ie none)
for i=1 to SET_LIMIT do
initial_set[i] = random_set()
end for
end if
end procedure
atom done, is_done, best
function idle_action()
atom to_do = excluded-1,
t1 = time()+1
string samp = iff(is_len=length(initial_set)?"":sprintf(" samples of %,d",{is_len}))
for i=1 to 100000 do -- reasonable slice of work
done += 1
is_done += (done<excluded)
sequence guest = initial_set[done],
scores = {}, counts = {}
if not find(guest,guesses) then
for j=1 to excluded-1 do
sequence s = get_score(guest,initial_set[j])
integer k = find(s,scores)
if k=0 then
scores = append(scores,s)
counts = append(counts,1)
else
counts[k] += 1
end if
end for
if length(counts)=0 then
IupSetStrAttribute(progress,"TITLE","[answer not in %,d%s]",{SET_LIMIT,samp})
return IUP_IGNORE -- (stop idle)
end if
integer k = largest(counts,return_index:=true),
ck = counts[k]
if ck<best then
best = ck
hint = guest
IupSetInt(usehint,"ACTIVE",true)
IupUpdate(colour_canvas)
end if
end if
if done=length(initial_set) then
IupSetStrAttribute(progress,"TITLE","%,d/%,d%s (100%%)",{is_done,to_do,samp})
return IUP_IGNORE -- (stop idle)
end if
if time()>t1 then exit end if
end for
IupSetStrAttribute(progress,"TITLE","%,d/%,d%s (%d%%)",{is_done,to_do,samp,100*(is_done/to_do)})
return IUP_DEFAULT
end function
constant idle_action_cb = Icallback("idle_action")
procedure start_idle()
done = 0
is_done = 0
best = length(initial_set)+1
IupSetGlobalFunction("IDLE_ACTION",idle_action_cb)
end procedure
procedure new_game()
ncolours = IupGetInt(colours,"VALUE")
ncodelen = IupGetInt(codelen,"VALUE")
nmaxgoes = IupGetInt(maxgoes,"VALUE")
brepeats = IupGetInt(repeats,"VALUE")
secret = random_set()
guesses = {{}}
scores = {}
hint = {}
create_initial_set()
start_idle()
end procedure
constant colour_table = {#e6194b, -- Red
#3cb44b, -- Green
#ffe119, -- Yellow
#4363d8, -- Blue
#f58231, -- Orange
#911eb4, -- Purple
#42d4f4, -- Cyan
#f032e6, -- Magenta
#bfef45, -- Lime
#fabebe, -- Pink
#469990, -- Teal
#e6beff, -- Lavender
#9A6324, -- Brown
#fffac8, -- Beige
#800000, -- Maroon
#aaffc3, -- Mint
#808000, -- Olive
#ffd8b1, -- Apricot
#000075, -- Navy
#a9a9a9} -- Grey
-- saved in redraw_cb(), for click testing in button_cb():
sequence last_guess = {},
colour_centres = {}
integer guess_r2 = 0,
colour_r2 = 0
function redraw_cb(Ihandle ih, integer /*posx*/, integer /*posy*/)
Ihandle frame = IupGetParent(ih)
string title = IupGetAttribute(ih,"TITLE")
if not find(title,{"Game","Colours"}) then ?9/0 end if
integer {cw,ch} = IupGetIntInt(ih, "DRAWSIZE")
cdCanvas cddbuffer = IupGetAttributePtr(ih,"DBUFFER")
IupGLMakeCurrent(ih)
cdCanvasActivate(cddbuffer)
cdCanvasClear(cddbuffer)
if title="Game" then
integer mx = min(floor(cw/(ncodelen*1.5+0.5)),floor(ch/(nmaxgoes+1))),
diameter = floor(mx/2),
px = floor((cw-(ncodelen*1.5+0.5)*mx)/2), -- (set margin)
cy = ch, cx, c, r
last_guess = {}
for g=1 to length(guesses) do
cy -= mx
cx = px+floor(mx/2)
for i=1 to 2*ncodelen+1 do
if i!=ncodelen+1 then
if i<=ncodelen then
if i<=length(guesses[g]) then
c = colour_table[guesses[g][i]]
if g=length(guesses) then
last_guess = {{cx,ch-cy}}
end if
else
c = CD_GREY
end if
r = diameter
else
c = CD_GREY
if g<=length(scores) then
integer k = i-ncodelen-1,
{b,w} = scores[g]
c = iff(k<=b ? CD_BLACK : iff(k<=b+w ? CD_WHITE : CD_GREY))
end if
r = floor(diameter*0.5)
end if
cdCanvasSetForeground(cddbuffer,c)
cdCanvasSector(cddbuffer, cx, cy, r, r, 0, 360)
cdCanvasSetForeground(cddbuffer,CD_DARK_GREY)
cdCanvasCircle(cddbuffer, cx, cy, r)
end if
cx += iff(i<ncodelen?mx:floor(mx/2))
end for
end for
guess_r2 = floor(diameter*diameter/4)
elsif title="Colours" then
integer mx = min(floor(cw/ncodelen),floor(ch/2)),
r = floor(mx/2),
px = floor((cw-ncodelen*mx)/2), -- (set margin)
cy = ch-r, cx, c
cx = px+floor(mx/2)
bool active = length(hint)>0
if length(scores)=nmaxgoes then
hint = secret
active = true
end if
for i=1 to ncodelen do
c = iff(active?colour_table[hint[i]]:CD_GREY)
cdCanvasSetForeground(cddbuffer,c)
cdCanvasSector(cddbuffer, cx, cy, r, r, 0, 360)
cdCanvasSetForeground(cddbuffer,CD_DARK_GREY)
cdCanvasCircle(cddbuffer, cx, cy, r)
cx += mx
end for
if length(scores)=nmaxgoes
or guesses[$]=secret then
ch -= floor(mx/2)
{} = cdCanvasTextAlignment(cddbuffer, CD_CENTER)
string wl = iff(guesses[$]=secret?"WIN":"LOSE"),
msg = sprintf("GAME OVER - YOU %s",{wl})
cdCanvasText(cddbuffer, cw/2, ch/2, msg)
else
integer ch0 = ch
ch -= mx
--
-- calculate the best nw*nh way to fit all the colours in:
-- (if nw ends up = ncodelen there is no clear separation
-- between the hint and the colour table; the start with
-- ncodelen+1 solves that and looks pretty good to me.)
--
integer nw = ncodelen+1, -- (as above)
nh = 1
while nw*nh<ncolours do
if (cw/(nw+1))>(ch/(nh+1)) then
nw += 1
else
nh += 1
end if
end while
--
-- now draw all the colours
--
mx = min(floor(cw/nw),floor(ch/nh))
r = floor(mx/2)
px = floor((cw-nw*mx)/2)
cx = px+floor(mx/2)
cy = ch-r
integer this_row = 0
colour_centres = repeat(0,ncolours)
colour_r2 = floor(r*r/4)
for i=1 to ncolours do
colour_centres[i] = {cx,ch0-cy}
c = colour_table[i]
cdCanvasSetForeground(cddbuffer,c)
cdCanvasSector(cddbuffer, cx, cy, r, r, 0, 360)
cdCanvasSetForeground(cddbuffer,CD_DARK_GREY)
cdCanvasCircle(cddbuffer, cx, cy, r)
cx += mx
this_row += 1
if this_row>=nw then
this_row = 0
cx = px + floor(mx/2)
cy -= mx
end if
end for
end if
end if
cdCanvasFlush(cddbuffer)
return IUP_DEFAULT
end function
function map_cb(Ihandle ih)
IupGLMakeCurrent(ih)
atom res = IupGetDouble(NULL, "SCREENDPI")/25.4
cdCanvas cddbuffer = cdCreateCanvas(CD_GL, "10x10 %g", {res})
IupSetAttributePtr(ih,"DBUFFER",cddbuffer)
cdCanvasSetBackground(cddbuffer, CD_PARCHMENT)
return IUP_DEFAULT
end function
function canvas_resize_cb(Ihandle canvas)
cdCanvas cddbuffer = IupGetAttributePtr(canvas,"DBUFFER")
integer {canvas_width, canvas_height} = IupGetIntInt(canvas, "DRAWSIZE")
atom res = IupGetDouble(NULL, "SCREENDPI")/25.4
cdCanvasSetAttribute(cddbuffer, "SIZE", "%dx%d %g", {canvas_width, canvas_height, res})
return IUP_DEFAULT
end function
procedure redraw_all()
IupUpdate({game_canvas,colour_canvas})
end procedure
procedure undo_move()
-- Called from button_cb and from K_DEL, but latter may be invalid.
if length(guesses[$])!=0 then
guesses[$] = guesses[$][1..$-1]
redraw_all()
end if
end procedure
procedure add_move(integer i)
if i!=0 then
guesses[$] &= i
end if
if length(guesses[$])=ncodelen then
sequence guest = guesses[$],
score = get_score(guest,secret)
scores = append(scores,score)
if score!={ncodelen,0} -- (not all black==game over)
and length(guesses)<nmaxgoes then
for i=excluded-1 to 1 by -1 do
sequence isi = initial_set[i]
if get_score(guest,isi)!=score then
excluded -= 1
if excluded!=i then
initial_set[i] = initial_set[excluded]
initial_set[excluded] = isi -- (swap)
end if
end if
end for
guesses = append(guesses,{})
hint = {}
IupSetAttribute(progress,"TITLE","-")
IupSetInt(usehint,"ACTIVE",false)
start_idle()
end if
end if
redraw_all()
end procedure
function usehint_cb(Ihandle /*usehint*/)
guesses[$] = hint
add_move(0)
return IUP_DEFAULT
end function
function button_cb(Ihandle canvas, integer button, pressed, x, y, atom /*pStatus*/)
Ihandle frame = IupGetParent(canvas)
string title = IupGetAttribute(frame,"TITLE")
if not find(title,{"Game","Colours"}) then ?9/0 end if
if button=IUP_BUTTON1 and not pressed then -- (left button released)
{sequence centres, integer r2} = iff(title="Game"?{last_guess,guess_r2}
:{colour_centres,colour_r2})
for i=1 to length(centres) do
integer {cx,cy} = sq_sub(centres[i],{x,y})
if (cx*cx+cy*cy)<=r2 then
if title="Game" then
undo_move()
else
add_move(i)
end if
exit
end if
end for
end if
return IUP_CONTINUE
end function
function new_game_cb(Ihandle /*ih*/)
new_game()
redraw_all()
return IUP_DEFAULT
end function
function exit_cb(Ihandle /*ih*/)
return IUP_CLOSE
end function
constant cb_exit = Icallback("exit_cb")
function help_cb(Ihandln /*ih*/)
IupMessage("Mastermind",help_text)
return IUP_DEFAULT
end function
function key_cb(Ihandle /*dlg*/, atom c)
if c=K_ESC then return IUP_CLOSE end if
if c=K_F1 then return help_cb(NULL) end if
if find(c,{K_DEL,K_BS}) then undo_move() end if
return IUP_CONTINUE
end function
function valuechanged_cb(Ihandle ih)
ncolours = IupGetInt(colours,"VALUE")
ncodelen = IupGetInt(codelen,"VALUE")
nmaxgoes = IupGetInt(maxgoes,"VALUE")
IupSetInt(repeats,"ACTIVE",ncodelen<=ncolours)
if ncodelen>ncolours then
IupSetInt(repeats,"VALUE",true)
end if
brepeats = IupGetInt(repeats,"VALUE")
if ih!=maxgoes
or length(scores)=length(guesses) then -- (game over)
new_game()
elsif nmaxgoes<=length(scores) then
-- (signal/force game over state)
guesses = guesses[1..length(scores)]
end if
redraw_all()
return IUP_DEFAULT
end function
constant cb_valuechanged = Icallback("valuechanged_cb")
procedure main()
IupOpen()
colours = IupText("SPIN=Yes, SPINMIN=1, SPINMAX=20, VALUE=6, RASTERSIZE=34x")
codelen = IupText("SPIN=Yes, SPINMIN=1, SPINMAX=10, VALUE=4, RASTERSIZE=34x")
maxgoes = IupText("SPIN=Yes, SPINMIN=1, SPINMAX=20, VALUE=7, RASTERSIZE=34x")
repeats = IupToggle("Repeatable?","VALUE=YES, RIGHTBUTTON=YES, PADDING=5x4")
progress = IupLabel("-","EXPAND=HORIZONTAL, PADDING=5x4")
usehint = IupButton("Use",Icallback("usehint_cb"),"PADDING=5x4, ACTIVE=NO")
game_canvas = IupGLCanvas("RASTERSIZE=200x")
colour_canvas = IupGLCanvas("RASTERSIZE=x200")
Ihandle newgame = IupButton("New Game",Icallback("new_game_cb"),"PADDING=5x4"),
help = IupButton("Help (F1)",Icallback("help_cb"),"PADDING=5x4"),
quit = IupButton("E&xit",Icallback("exit_cb"),"PADDING=5x4"),
vbox = IupVbox({IupHbox({IupLabel("Colours (1-20)","PADDING=5x4"),colours}),
IupHbox({IupLabel("Code Length (1-10)","PADDING=5x4"),codelen}),
IupHbox({IupLabel("Guesses (1-20)","PADDING=5x4"),maxgoes}),
IupHbox({repeats},"MARGIN=10x5"),
IupHbox({progress}),
IupHbox({usehint,newgame,help,quit})},"MARGIN=5x5"),
game_frame = IupFrame(IupHbox({game_canvas},"MARGIN=3x3"),"TITLE=Game"),
option_frame = IupFrame(vbox,"TITLE=Options"),
colour_frame = IupFrame(colour_canvas,"TITLE=Colours"),
full = IupHbox({game_frame,IupVbox({option_frame,colour_frame})})
IupSetCallbacks({colours,codelen,maxgoes,repeats}, {"VALUECHANGED_CB", cb_valuechanged})
IupSetCallbacks({game_canvas,colour_canvas}, {"ACTION", Icallback("redraw_cb"),
"MAP_CB", Icallback("map_cb"),
"RESIZE_CB", Icallback("canvas_resize_cb"),
"BUTTON_CB", Icallback("button_cb")})
dlg = IupDialog(IupHbox({full},"MARGIN=3x3"),"TITLE=Mastermind")
IupSetCallback(dlg, "K_ANY", Icallback("key_cb"))
IupSetAttributeHandle(dlg,"DEFAULTENTER", usehint)
new_game()
IupShowXY(dlg,IUP_CENTER,IUP_CENTER)
IupSetAttribute(dlg, "RASTERSIZE", NULL)
IupSetStrAttribute(dlg, "MINSIZE", IupGetAttribute(dlg,"RASTERSIZE"))
IupMainLoop()
IupClose()
end procedure
main()