Jump to content

Morpion solitaire: Difference between revisions

→‎{{header|REXX}}: added the REXX language. -- ~~~~
m (tweak task text - other editors - please review task description it should be ready)
(→‎{{header|REXX}}: added the REXX language. -- ~~~~)
Line 286:
See [[Morpion_solitaire/Unicon]]
 
=={{header|REXX}}==
This REXX program is an attempt to play (badly, and with random moves) the game of Morpion solitaire by a computer.
<br>The program also allows a carbon-based life form (er, that is, a human) to play.
<br>This is a work in progress and currently doesn't log the moves in the manner asked for by this task.
<br>The moves are marked by ''' 0123456789ABC...XYZabc...xyz()[]{}<>«» ''' and thereafter by a plus sign (+) on the board which is shown in 2D.
<br>This allows 63 unique moves to be shown on the board (or grid), but all moves are also logged to a file.
<br>Currently, the computer tries to start the game (with sixteen moves) by the assumptions I made, which clearly aren't worth a tinker's dam.
<br>This program allows the <tt> D </tt> or <tt> T </tt> forms of the game, and allows any board size (grid size) of three or higher.
<br>The default board size is <tt> 5T </tt>
 
<lang rexx>/*REXX program to play Morpion solitaire, the default is the 5T version.*/
signal on syntax; signal on novalue /*handle REXX program errors. */
quiet=0; oFID='MORPION'
arg game player . /*see if a person wants to play. */
if game=='' | game==',' then game='5T' /*Not specified? Then use default*/
prompt= /*null string is used for ERR ret*/
TorD='T (touching) ───or─── D (disjoint).' /*valid games types (T | D).*/
gT=right(game,1) /*T = touching ─or─ D = disjoint.*/
if \datatype(gT,'U') | verify(gT,gT)\==0 then call err 'game gT not' gT
gS=left(game,length(game)-1) /*gS=Game Size (line len for win)*/
if \datatype(gS,'W') then call err "game size isn't numeric:" gS
gS=gS/1
if gS<3 then call err "grid size is too small:" gS
empty='fa'x /*the empty grid point symbol. */
@.=empty /*field (grid) is infinite. */
point='f'x /*character used for Greek cross.*/
CBLF=player\=='' /*carbon-based lifeform ? */
if CBLF then oFID=player /*oFID is used for the game log. */
oFID=oFID'.LOG' /*fulltype for the LOG's filename*/
prompt='enter X,Y point and an optional character for placing on board',
'(or Quit):'; prompt=right(prompt,79,'─') /*right justify it.*/
@abc='abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU; @digS=0123456789
@chars=@digS||@abcU||@abc'()[]{}<>«»' /*can't contain "empty", ?, blank*/
call GreekCross
jshots=Gshots
 
do turns=1 for 1000
if CBLF then do
call t prompt; pull stuff; stuff=translate(stuff,,',')
parse var stuff px py p
_=px; upper _; if abbrev('QUIT',_,1) then exit
if stuff=='' then do; call display; iterate; end
call mark px,py
end /*if CBLF*/
else do; quiet=1
shot=translate(word(Gshots,turn),,',')
if shot=='' then do 50
xr=loX-1+random(0,hiX-loX+2)
yr=loY-1+random(0,hiY-loY+2)
if @.xr.yr\==empty then iterate
if \neighbor(xr,yr) then iterate
shot=xr yr
end
call mark word(shot,1),word(shot,2)
end
end /*forever*/
 
call t '* number of wins =' wins
exit wins
/*───────────────────────────────error handling subroutines and others.─*/
err: if \quiet then do; call t; call t
call t center(' error! ',max(40,linesize()%2),"*"); call t
do j=1 for arg(); call t arg(j); call t; end; call t
end
if prompt=='' then exit 13; return
 
novalue: syntax: prompt=; quiet=0
call err 'REXX program' condition('C') "error",,
condition('D'),'REXX source statement (line' sigl"):",,
sourceline(sigl)
 
t: say arg(1); call lineout oFID,arg(1); return
Gshot: Gshots=Gshots arg(1)','arg(2); return
/*─────────────────────────────────────GREEKCROSS subroutine────────────*/
GreekCross: wins=0; loX=1e85; hiX=0; LB=gS-1 /*Low Bar*/
turn=1; loY=loX; hiY=0; ht=4+3*(LB-2) /*─ ─ */
Gshots=; nook=gS-2; Hnook=ht-nook+1; TB=ht-LB+1 /*Top Bar*/
/*─ ─ */
do y=1 for ht
select
when y==1 |y==ht then do x=1 for LB; call place x+LB-1,y,point; end
when y==LB|y==TB then do x=1 for ht; if x>LB & x<TB then iterate; call place x,y,point; end
when y>LB & y<TB then do x=1 by ht-1 for 2; call place x,y,point; end
otherwise do x=LB by TB-LB for 2; call place x,y,point; end
end /*select*/
end /*y*/
 
call display
call Gshot nook , nook ; call Gshot nook , Hnook
call Gshot Hnook , nook ; call Gshot Hnook , Hnook
call Gshot gS , LB ; call Gshot gS , TB
call Gshot ht-LB , LB ; call Gshot ht-LB , TB
call Gshot LB , gS ; call Gshot TB , gS
call Gshot LB , TB-1 ; call Gshot TB , TB-1
call Gshot 1 , TB+1 ; call Gshot ht , TB+1
call Gshot TB+1 , 1 ; call Gshot TB+1 , ht
return
/*─────────────────────────────────────DISPLAY subroutine───────────────*/
display: call t; do y=hiY to loY by -1; aLine= /*start at a high Y.*/
do x=loX to hiX /*build an "X" line.*/
aLine=aLine||@.x.y
end /*x*/
call t aLine /*...and display it.*/
end /*y*/
 
if wins\==0 then call t right('count of (above) wins =' wins,79,'═')
return
/*─────────────────────────────────────PLACE subroutine─────────────────*/
place: parse arg xxp,yyp /*place a marker (point) on grid.*/
loX=min(loX,xxp); hiX=max(hiX,xxp)
loY=min(loY,yyp); hiY=max(hiY,yyp); @.xxp.yyp=arg(3)
return
/*─────────────────────────────────────MARK subroutine──────────────────*/
mark: parse arg xx,yy,pointChar /*place marker, check for errors.*/
if pointChar=='' then pointChar=word(substr(@chars,turn,1) '+',1)
xxcyy=xx','yy; _.1=xx; _.2=yy
 
do j=1 for 2; XorY=substr('XY',j,1) /*make sure X and Y are integers.*/
if _.j=='' then do; call err XorY "wasn't specified." ; return 0; end
if \datatype(_.j,'N') then do; call err XorY "isn't numeric:" _.j ; return 0; end
if \datatype(_.j,'W') then do; call err XorY "isn't an integer:" _.j; return 0; end
end
 
xx=xx/1; yy=yy/1 /*normalize integers: + 7 or 5.0*/
 
if pointChar==empty |,
pointChar=='?' then do; call err 'illegal point character:' pointChar; return 0; end
if @.xx.yy\==empty then do; call err 'point' xxcyy 'is already occupied.'; return 0; end
if \neighbor(xx,yy) then do; call err "point" xxcyy "is a bad move." ; return 0; end
call place xx,yy,'?'
newWins=countWins()
if newWins==0 then do; call err "point" xxcyy "isn't a good move."
@.xx.yy=empty
return 0
end
call t 'move' turn left('',9) xx','yy left('',9) pointChar
wins=wins+newWins; @.xx.yy=pointChar; call display; turn=turn+1
return 1
/*─────────────────────────────────────NEIGHBOR subroutine──────────────*/
neighbor: parse arg a,b; am=a-1; ap=a+1
bm=b-1; bp=b+1
return @.am.b \== empty | @.am.bm \== empty |,
@.ap.b \== empty | @.am.bp \== empty |,
@.a.bm \== empty | @.ap.bm \== empty |,
@.a.bp \== empty | @.ap.bp \== empty
/*─────────────────────────────────────COUNTALINE subroutine────────────*/
countAline: arg z ; L=length(z)
 
if L>gS then do; if gT=='D' then return 0 /*longlines ¬ kosker for D*/
parse var z z1 '?' z2 /*could be xxxxx?xxxx */
return length(z1)==4 | length(z2)==4
end
return L==gS
/*─────────────────────────────────────COUNTWINS subroutine─────────────*/
countWins: eureka=0; y=yy /*count horizontal/vertical/diagonal wins.*/
z=@.xx.yy
do x=xx+1; if @.x.y==empty then leave; z=z||@.x.y; end
do x=xx-1 by -1; if @.x.y==empty then leave; z=@.x.y||z; end
eureka=eureka+countAline(z) /*─────────count wins in horizontal line. */
 
x=xx
z=@.xx.yy
do y=yy+1; if @.x.y==empty then leave; z=z||@.x.y; end
do y=yy-1 by -1; if @.x.y==empty then leave; z=@.x.y||z; end
eureka=eureka+countAline(z) /*─────────count wins in vertical line. */
 
x=xx
z=@.xx.yy
do y=yy+1; x=x+1; if @.x.y==empty then leave; z=z||@.x.y; end
x=xx
do y=yy-1 by -1; x=x-1; if @.x.y==empty then leave; z=@.x.y||z; end
eureka=eureka+countAline(z) /*───────count diag wins: up&>, down&< */
 
x=xx
z=@.xx.yy
do y=yy+1; x=x-1; if @.x.y==empty then leave; z=z||@.x.y; end
x=xx
do y=yy-1 by -1; x=x+1; if @.x.y==empty then leave; z=z||@.x.y; end
return eureka+countAline(z) /*───────count diag wins: up&<, down&> */</lang>
'''output''' when running 1,000 trials, the highest win was a meager 44 (three games, all different), and
one of them is shown below.
<pre style="height:95ex;overflow:scroll">
···☼☼☼☼···
···☼··☼···
···☼··☼···
☼☼☼☼··☼☼☼☼
☼········☼
☼········☼
☼☼☼☼··☼☼☼☼
···☼··☼···
···☼··☼···
···☼☼☼☼··· ... previous 43 moves elided ... above is the initial board (grid) ...
--- the next line says: 44th move, position=9,2 marked with an "h" ---
move 44 9,2 h
 
·············
······X······
····☼☼☼☼F····
····☼TZ☼I····
·C·1☼gR☼3WD··
·☼☼☼☼57☼☼☼☼··
·☼aeAfMBHN☼··
·☼·Q8GK9Sb☼··
·☼☼☼☼46☼☼☼☼O·
···0☼UJ☼2·V··
···c☼YL☼·h···
····☼☼☼☼E····
····P··d·····
·············
═════════════════════════════════════════════════════count of (above) wins = 44
* number of wins = 44
</pre>
Cookies help us deliver our services. By using our services, you agree to our use of cookies.