home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / snobol / aisnobol / kalah.spt < prev    next >
Text File  |  1987-11-15  |  31KB  |  893 lines
  1. *  KALAH.SPT - SPITBOL version
  2. *
  3. *    KALAH in SNOBOL4
  4. *
  5. *
  6. *    The program follows a LISP program which appeared in
  7. *     Shapiro, S.C., Techniques of Artificial Intelligence,
  8. *      New York: Van Nostrand, 1979, pp. 31-55.
  9. *
  10. *    The comments are from Shapiro's LISP program.
  11. *
  12. *    To run:
  13. *    spitbol kalah.spt
  14. *
  15. *    If you want to keep a game log to file "shadow", type:
  16. *    spitbol -u "shadow" kalah.spt
  17. *
  18. *    Try it with 4 stones per pot, and a search depth of 3.
  19. *
  20. *    This is one of the many variations of Mancala games.  Mancala games
  21. *    are popular in Africa and India.  It is a very old game; boards have
  22. *    been found in Ancient Egyptian ruins.  Some of the names of
  23. *    different versions are:  Mankala'h, Pallanguli, Wari, Awari, and Ba-Awa.
  24. *    We do not know the precise name of the version present here.
  25. *
  26. *    The board consists of two rows of six depressions, called 'pits' or
  27. *    'pots'.  A larger pit at each end holds captured pieces.
  28. *
  29. *    The board is as follows: (integers are pot numbers, 'P' is the
  30. *    program, 'O' is the opponent (you).
  31. *
  32. *        P6  P5  P4  P3  P2  P1
  33. *    PKALAH            OKALAH
  34. *        O1  O2  O3  O4  O5  O6
  35. *
  36. *    The move path is counter-clockwise.
  37. *     For the computer: P1-P6-PKALAH-O1-O6-P1,
  38. *     and for the user, O1-O6-OKALAH-P1-P6-O1.
  39. *
  40. *    Initially, P1-P6 and O1-O6 are filled with the desired number of stones.
  41. *    A move is made by taking all the stones from a numbered pot on your
  42. *    side, and sowing them one-by-one into succeeding pots along your
  43. *    path.  If your last stone went into the KALAH, you get another turn.
  44. *    If the last stone went into a numbered pot ON YOUR SIDE that was empty,
  45. *    and if the opponent's pot directly across from it is not empty, then
  46. *    all the stones in these two pots are "captured" and placed in the
  47. *    moving side's KALAH.  The game ends when one side has a majority
  48. *    of the stones in their KALAH.  If it is your turn and all of your
  49. *    are empty (you have no play), then all the stones in the other side's
  50. *    pots go into that side's KALAH, the game is over, and the one with the
  51. *    most stones wins.
  52. *
  53. *
  54. *---------------------------------------------------------------------------
  55. * Keyword settings
  56. *
  57.     &ANCHOR    = 0
  58.     &DUMP    = 0
  59.     &FTRACE    = 0
  60.     &STLIMIT = -1
  61.     &TRACE    = 0
  62.     &TRIM    = 1
  63. *
  64. *---------------------------------------------------------------------------
  65. * I/O Associations.
  66. *
  67.     (DIFFER(HOST(0)) OUTPUT(.SHADOW,1,HOST(0)))
  68. *
  69. *---------------------------------------------------------------------------
  70. * Defined datatypes
  71. *
  72. * The data structure describing each pot will contain these items:
  73. *  ONWER - the owner (P or O)
  74. *  NUM - the number of the pot (1-6, 0=kalah)
  75. *  KVALUE - stack of number of stones in the pot.  Top value is current.
  76. *  OPP - The pot number opposite this pot on the board
  77. *  PPATH, OPATH - Name of next pot along the program or opponent's path
  78. *
  79.     DATA( 'POT(OWNER,NUM,KVALUE,OPP,PPATH,OPATH)' )
  80. *
  81. * A node will contain three elements.  When a node is first generated, the
  82. * first element will be the player who is to move, the second element will
  83. * be the pot whose stones are to be taken, and the third element will be
  84. * the player who will move next.
  85. *
  86.     DATA( 'NODE(PLAYER,MOVEOF,NEXT_PLAYER)' )
  87. *
  88. * A simple stack consisting of a top-of-stack value, and a pointer to
  89. * the rest of stack.
  90. *
  91.     DATA( 'STACK(TOP,REST)' )
  92. *
  93. *---------------------------------------------------------------------------
  94. * Global constants
  95. *
  96.     UPPERS = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  97.     LOWERS = 'abcdefghijklmnopqrstuvwxyz'
  98.     null = ''
  99.     nil = STACK(null,null)
  100.     TOP(nil) = nil
  101.     REST(nil) = nil
  102.     t = COPY(nil)
  103.     TOP(t) = t
  104.     REST(t) = t
  105.     nilpot = POT(null,0,nil,null,null,null)
  106.     OPP(nilpot) = nilpot
  107.     PPATH(nilpot) = nilpot
  108.     OPATH(nilpot) = nilpot
  109. *
  110. *---------------------------------------------------------------------------
  111. * Utility patterns
  112. *
  113.     LEFT_END = POS(0)
  114.     RIGHT_END = RPOS(0)
  115.     TO_NEXT_BLANK = BREAK(' ')
  116.     SKIP_BLANKS = SPAN(' ')
  117. *
  118. *---------------------------------------------------------------------------
  119. * Utility functions
  120. *
  121. * DEF - Define other functions
  122.     DEFINE( 'DEF(NAME,ARGS,LOCALS,BODY,RTN)', 'DEF1')
  123. +        :(DEF_END)
  124. DEF1    ARGS ' ' = ','                :S(DEF1)
  125. DEF2    LOCALS ' ' = ','            :S(DEF2)
  126. *
  127. * Build body with proper return
  128.     BODY = IDENT( RTN, null) BODY ' :(RETURN)'
  129. +      :S(DEF3)
  130.     BODY = IDENT( RTN, 'S') BODY ' :S(RETURN)F(FRETURN)'
  131. +      :S(DEF3)
  132.     BODY = IDENT( RTN, 'F') BODY ' :F(RETURN)S(FRETURN)'
  133. +      :S(DEF3)
  134.     BODY = IDENT( RTN, 'N') BODY ' :(NRETURN)'
  135. DEF3    CODE(NAME ' ' BODY)
  136. * Define new function
  137.     DEFINE( NAME '(' ARGS ')' LOCALS )    :(RETURN)
  138. DEF_END
  139. *
  140. *---------------------------------------------------------------------------
  141. *
  142. * APPEND3 - Makes one stack out of three stacks.
  143. *
  144.     DEFINE( 'APPEND3(S1,S2,S3)' )    :(APPEND3_END)
  145. APPEND3
  146.     APPEND3 = ( NULL(S1) NULL(S2) NULL(S3)) nil    :S(RETURN)
  147.     APPEND3 = ( NULL(S1) NULL(S2))
  148. +       STACK( TOP(S3), APPEND3( S1, S2, REST(S3)))
  149. +        :S(RETURN)
  150.     APPEND3 = NULL(S1)
  151. +       STACK( TOP(S2), APPEND3( S1, REST(S2), S3))
  152. +        :S(RETURN)
  153.     APPEND3 =
  154. +       STACK( TOP(S1), APPEND3( REST(S1), S2, S3))
  155. +       :(RETURN)
  156. APPEND3_END
  157. *
  158. *---------------------------------------------------------------------------
  159. * NULL - Succeed if stack empty
  160.     DEF( 'NULL', 'X',, 'IDENT(X,nil)', 'S')
  161. *
  162. *---------------------------------------------------------------------------
  163. * TRUE - Succeed if stack not empty
  164.     DEF( 'TRUE', 'X',, 'DIFFER(X,nil)', 'S')
  165. *
  166. *---------------------------------------------------------------------------
  167. * MAX - Maximum of two values
  168.     DEF( 'MAX', 'N1 N2',, 'MAX = N1 ; MAX = GT(N2,N1) N2')
  169. *
  170. *---------------------------------------------------------------------------
  171. * MIN - Minimum of two values
  172.     DEF( 'MIN', 'N1 N2',, 'MIN = N1 ; MIN = LT(N2,N1) N2')
  173. *
  174. *---------------------------------------------------------------------------
  175. * CNTR - Center string in field
  176.     DEFINE( 'CNTR(N,V)X' )            :(CNTR_END)
  177. CNTR
  178.     X = CONVERT( (N - SIZE(V)) / 2, 'INTEGER')
  179.     CNTR = LPAD(RPAD(V, N - X), N)        :(RETURN)
  180. CNTR_END
  181. *
  182. *---------------------------------------------------------------------------
  183. * PRT - String to OUTPUT and SHADOW
  184.     PRT_PAT = LEFT_END REM $ OUTPUT $ SHADOW
  185.     DEF( 'PRT', 'X',, 'X PRT_PAT' )
  186. -EJECT
  187. *
  188. ***************************************************************************
  189. * CORE FUNCTIONS FOR SEARCHING A GAME TREE WITH THE ALPHA-BETA ALGORITHMS *
  190. ***************************************************************************
  191. *
  192. * We will assume the existance of some data structure called a NODE, which
  193. * will contain information about a state of the game space.  Since the
  194. * depth limit of the search might be changed in various runs of a game-
  195. * playing program, we assume the level of the root of the tree will be the
  196. * current depth bound and each node will have a level equal to 1 less than
  197. * that of its parent.
  198. *
  199. *---------------------------------------------------------------------------
  200. * Searches the node NODE that is at LEVEL and has alpha value ALPHA and
  201. * beta value BETA.  Returns the value of NODE as determined by the search.
  202. *
  203.     DEFINE( 'SEARCH(NODE,LEVEL,ALPHA,BETA)' )    :(SEARCH_END)
  204. SEARCH
  205.     NODE = START(NODE)
  206.     SEARCH = DEAD(NODE,LEVEL) STATIC(NODE)        :S(SEARCH_A)
  207.     SEARCH =
  208. +      SEARCH1( MAXER(NODE), (LEVEL - 1), ALPHA, BETA, EXPAND(NODE))
  209. SEARCH_A
  210.     NEND(NODE)                    :(RETURN)
  211. SEARCH_END
  212. *
  213. *---------------------------------------------------------------------------
  214. * Initializes the search of the successors of some node.  MAXR is T or NIL
  215. * depending on whether the parent node is a maximizer or a minimizer.  ALPHA
  216. * and BETA are the alpha and beta values of the parent node.  NL is a list
  217. * of the successor nodes, and LVL is their level.
  218. *
  219.     DEFINE( 'SEARCH1(MAXR,LVL,ALPHA,BETA,NL)' )    :(SEARCH1_END)
  220. SEARCH1
  221.     SEARCH1 =
  222. +      SEARCH2( MAXR, LVL, ALPHA, BETA, REST(NL),
  223. +           SEARCH( TOP(NL), LVL, ALPHA, BETA))    :(RETURN)
  224. SEARCH1_END
  225. *
  226. *---------------------------------------------------------------------------
  227. * Searches the successors of some node, returning its final backed up value.
  228. * MAXR, LVL, ALPHA, and BETA are as in SEARCH1.  PBV is the provisional
  229. * backed-up value of the parent node.  NL is a list of the still to be
  230. * searched successor nodes.
  231. *
  232.     DEFINE( 'SEARCH2(MAXR,LVL,ALPHA,BETA,NL,PBV)' )    :(SEARCH2_END)
  233. SEARCH2
  234.     SEARCH2 = NULL(NL) PBV                :S(RETURN)
  235.     SEARCH2 = CUTOFF( MAXR, PBV, ALPHA, BETA ) PBV
  236. +      :S(RETURN)
  237.     SEARCH2 = TRUE(MAXR)
  238. +      SEARCH2( MAXR, LVL, ALPHA, BETA, REST(NL),
  239. +         MAX( PBV, SEARCH( TOP(NL), LVL, MAX(ALPHA,PBV), BETA)))
  240. +           :S(RETURN)
  241.     SEARCH2 =
  242. +      SEARCH2( MAXR, LVL, ALPHA, BETA, REST(NL),
  243. +         MIN( PBV, SEARCH( TOP(NL), LVL, ALPHA, MIN(BETA,PBV))))
  244. +           :(RETURN)
  245. SEARCH2_END
  246. *
  247. *---------------------------------------------------------------------------
  248. * PBV, ALPHA, and BETA are, respectively, the provisional backed up value,
  249. * alpha value, and beta value of some node.  MAXR is T or NIL depending on
  250. * whether the node is a maximizing or minimizing node.  CUTOFF returns T if
  251. * searching below then node should be terminated and PBV returned as the
  252. * final backed up value, and returns NIL otherwise.
  253. *
  254.     DEFINE( 'CUTOFF(MAXR,PBV,ALPHA,BETA)' )    :(CUTOFF_END)
  255. CUTOFF
  256.     TRUE(MAXR)                :F(CUTOFF1)
  257.     GE( PBV, BETA)                :S(RETURN)F(FRETURN)
  258. CUTOFF1
  259.     LE( PBV, ALPHA)                :S(RETURN)F(FRETURN)
  260. CUTOFF_END
  261. -EJECT
  262. *
  263. *******************************************************
  264. * FUNCTIONS DEFINING THE REPRESENTATIONS OF THE BOARD *
  265. *******************************************************
  266. *
  267. * Assuming that PL represents one player, OTHER returns the atom
  268. * representing the other player.  We use P to represent the program and
  269. * O to represent the opponent.
  270. *
  271.     OTHERP = 'O' ; OTHERO = 'P'
  272.     DEF( 'OTHER', 'PL',, 'OTHER = $( "OTHER" PL)' )
  273. *
  274. *---------------------------------------------------------------------------
  275. * Returns the atom representing player PL's Nth pot.
  276. *
  277. * The program's pots are P1, P2, P3, P4, P5, and P6.  The opponent's pots are
  278. * O1, O2, O3, O4, O5, and O6.
  279. *
  280.     DEF( 'POTR', 'PL N',, 'POTR = $( PL N)' )
  281. *
  282. *---------------------------------------------------------------------------
  283. * Returns the atom representing player PL' kalah.
  284. *
  285. * The program's kalah is represented by PKALAH, the opponents's by OKALAH.
  286. *
  287.     DEF( 'KALAHR', 'PL',, 'KALAHR = $( PL "KALAH" )' )
  288. *
  289. *---------------------------------------------------------------------------
  290. * Returns the number of stones in the pot POT.
  291. *
  292.     DEF( 'VALUE', 'POT',, 'VALUE = TOP(KVALUE(POT))' )
  293. *
  294. *---------------------------------------------------------------------------
  295. * Stacks VAL as the current number of stones in the pot POT.  Previous
  296. * values are maintained further down in the stack.
  297. *
  298.     DEF( 'PUSHVAL', 'POT VAL',, 'KVALUE(POT) = STACK(VAL,KVALUE(POT))' )
  299. *
  300. *---------------------------------------------------------------------------
  301. * Pops the stack used to maintain the value of pot POT, restoring the
  302. * previous value.
  303. *
  304.     DEF( 'POPVAL', 'POT',, 'KVALUE(POT) = REST(KVALUE(POT))' )
  305. *
  306. *---------------------------------------------------------------------------
  307. * Changes the current value of the POT to VAL, destroying the previous
  308. * current value.
  309. *
  310.     DEF( 'CHANGEVAL', 'POT VAL',, 'TOP(KVALUE(POT)) = VAL' )
  311. *
  312. *---------------------------------------------------------------------------
  313. * Succeeds if pot POT is empty.
  314. *
  315.     DEF( 'EMPTY', 'POT',, 'EQ(VALUE(POT), 0)', 'S')
  316. *
  317. *---------------------------------------------------------------------------
  318. * Returns the name of one of the two circular paths connecting the pots
  319. * and kalahs:  PPATH is the path the program uses to drop its stones,
  320. *           OPATH is the path the opponent uses to drop its stones.
  321. *
  322.     DEF( 'PATHR', 'PL',, 'PATHR = PL "PATH" ' )
  323. *
  324. *---------------------------------------------------------------------------
  325. * Returns a list of all the pots on player PL' side of the board.
  326. *
  327.     PSIDE = 'P1 P2 P3 P4 P5 P6 '
  328.     OSIDE = 'O1 O2 O3 O4 O5 O6 '
  329.     DEF( 'SIDER', 'PL',, 'SIDER = $( PL "SIDE" )' )
  330. *
  331. *---------------------------------------------------------------------------
  332. * Joins each atom in the list LAT to the next one via the path P.
  333. *
  334.     DEFINE( 'SETPATH(P,LAT)' )
  335.     SETPATH_PAT = LEFT_END ( TO_NEXT_BLANK $ A )
  336. +             SKIP_BLANKS
  337. +             (( ( TO_NEXT_BLANK $ B) REM) $ C)
  338. +            :(SETPATH_END)
  339. SETPATH
  340.     LAT SETPATH_PAT = C            :F(RETURN)
  341. * xPATH(pot) = pot
  342.     :<CODE(' ' P '(' A ') = ' B ' :(SETPATH)')>
  343. SETPATH_END
  344. *
  345. *---------------------------------------------------------------------------
  346. * Joins pairs of atoms in list L to each other symmetrically via the path P.
  347. *
  348.     SETSYM_PAT = FENCE ( TO_NEXT_BLANK $ A)
  349. +          SKIP_BLANKS ( TO_NEXT_BLANK $ B)
  350. +          SKIP_BLANKS *SETSYM1()
  351. +          *SETSYM_PAT
  352.     DEF( 'SETSYM', 'P L',, 'L SETSYM_PAT')
  353. *
  354. *---------------------------------------------------------------------------
  355. * SETSYM1 - Helper for SETSYM
  356. *
  357.     DEFINE( 'SETSYM1()' )            :(SETSYM1_END)
  358. *
  359. * Returns the pot oppostive 
  360. SETSYM1
  361.     :<CODE(' ' P '(' A ') = ' B ' ; '
  362. +      P '(' B ') = ' A ' :(RETURN)')>
  363. SETSYM1_END
  364. -EJECT
  365. *
  366. ***************************************
  367. * FUNCTIONS TO DEFINE THE LEGAL MOVES *
  368. ***************************************
  369. *
  370. * Makes the move, representing player PL moving the stones in pot POT,
  371. * and changes the global board representation accordingly.  It returns
  372. * success if player PL gets to go again, otherwise fails.
  373. *
  374.     DEFINE( 'MOVE(PL,POT)' )        :(MOVE_END)
  375. MOVE
  376.     MOVE1(PL,POT,TAKE(POT),PATHR(PL),KALAHR(PL))    :S(RETURN)F(FRETURN)
  377. MOVE_END
  378. *
  379. *---------------------------------------------------------------------------
  380. * Player PL moves STONES number of stones taken from pot POT along the
  381. * path PATH.  KALAH is PL's kalah.  It succeeds if PL gets to go again,
  382. * fails otherwise.
  383. *
  384.     DEFINE( 'MOVE1(PL,POT,STONES,PATH,KALAH)' )    :(MOVE1_END)
  385. *
  386. * Distribute all stones
  387. MOVE1
  388.     EQ(STONES,0)                    :S(MOVE1A)
  389. *
  390. * Next pot along path
  391.     POT = APPLY(PATH,POT)
  392. *
  393. * Put a stone in it
  394.     DROP(1,POT)
  395. *
  396. * One less stone
  397.     STONES = STONES - 1                :(MOVE1)
  398. *
  399. * Check capture
  400. MOVE1A
  401.     CHECKCAP( POT, PL, KALAH, OPP(POT))
  402. *
  403. * Check for empty side
  404.     CHECKMT()
  405. *
  406. * Ck last stone land in Kalah?
  407.     IDENT( POT, KALAH)            :S(RETURN)F(FRETURN)
  408. MOVE1_END
  409. *
  410. *---------------------------------------------------------------------------
  411. * Player PL, whose kalah is KALAH, has just moved, the last stone landing
  412. * in the pot POT.  OPPOT is the pot opposite POT.  CHECKCAP checks to see
  413. * if this move was a capture move, and, if so, makes the capture.
  414. *
  415. * A capture occurs if:
  416. *  there is 1 stone in the landing pot,
  417. *   and it is a pot on the player's side,
  418. *    and it is not the nalah,
  419. *     and the opponent's opposite pot is not empty.
  420. * If so, then:
  421. *  transfer stones from player's pot to the Kalah and
  422. *   transfer stones from opponent's pot to the Kalah.
  423. *
  424.     DEFINE( 'CHECKCAP(POT,PL,KALAH,OPPOT)' )    :(CHECKCAP_END)
  425. CHECKCAP
  426.      ( EQ(VALUE(POT), 1)
  427. +       IDENT(OWNER(POT),PL)
  428. +        DIFFER(POT,KALAH)
  429. +         ~EMPTY(OPPOT)
  430. +          DROP(TAKE(POT), KALAH)
  431. +           DROP(TAKE(OPPOT), KALAH) )        :(RETURN)
  432. CHECKCAP_END
  433. *
  434. *---------------------------------------------------------------------------
  435. * If all the pots on either side are empty, all the pots on the other
  436. * side are emptied into that side's kalah.
  437. *
  438.     DEFINE( 'CHECKMT()' )                :(CHECKMT_END)
  439. CHECKMT
  440.     ( MTSIDEP(PSIDE) MTSIDE(OSIDE,OKALAH) )    :S(RETURN)
  441.     ( MTSIDEP(OSIDE) MTSIDE(PSIDE,PKALAH) )    :S(RETURN)F(FRETURN)
  442. CHECKMT_END
  443. *
  444. * Use recursive pattern to loop scan
  445.     MTSIDEP_PAT = FENCE
  446. +          TO_NEXT_BLANK $ P  *EMPTY($P)
  447. +          SKIP_BLANKS (RIGHT_END | *MTSIDEP_PAT)
  448. *
  449. *---------------------------------------------------------------------------
  450. * Scan side for all empty
  451. *
  452.     DEF( 'MTSIDEP', 'SIDE',, 'SIDE MTSIDEP_PAT', 'S')
  453. *
  454. * Use recursive pattern to loop calls
  455.     MTSIDE_PAT = FENCE
  456. +          TO_NEXT_BLANK $ P *DROP(TAKE($P),KALAH)
  457. +          SKIP_BLANKS *MTSIDE_PAT
  458. *
  459. *---------------------------------------------------------------------------
  460. * Removes the stones from all pots in the list SIDE and puts them in KALAH.
  461. *
  462.     DEF( 'MTSIDE', 'SIDE KALAH',, 'SIDE MTSIDE_PAT' )
  463. *
  464. *---------------------------------------------------------------------------
  465. * Removes all the stones from pot POT and returns the number of stones removed.
  466. *
  467.     DEF( 'TAKE', 'POT',, 'TAKE = VALUE(POT) ; CHANGEVAL(POT,0)' )
  468. *
  469. *---------------------------------------------------------------------------
  470. * Adds N stones to pot POT.
  471. *
  472.     DEF( 'DROP', 'N POT',, 'CHANGEVAL(POT, (N + VALUE(POT)))' )
  473. *
  474. *---------------------------------------------------------------------------
  475. * A node represents a multiple move if the player who is to move is the
  476. * same as the player who will move next.
  477. *
  478. * MULT
  479.     DEF( 'MULT', 'NODE',, 'IDENT(PLAYER(NODE),NEXT_PLAYER(NODE))', 'S')
  480. -EJECT
  481. *
  482. **************************************************
  483. * FUNCTIONS REQUIRED FOR SEARCHING THE GAME TREE *
  484. **************************************************
  485. *
  486. * When we start to search the node NODE, we must stack the current contents
  487. * of the board, make the move represented by NODE, and return the reverse
  488. * of NODE as mentioned above.
  489. *
  490.     DEFINE( 'START(NODE)' )
  491.     START_PAT = FENCE
  492. +          TO_NEXT_BLANK $ P *PUSHVAL($P,VALUE($P))
  493. +          SKIP_BLANKS *START_PAT            :(START_END)
  494. START
  495.     (PSIDE 'PKALAH ' OSIDE 'OKALAH ') START_PAT
  496.     MOVE( PLAYER(NODE), MOVEOF(NODE))
  497.     START =
  498. +     NODE( NEXT_PLAYER(NODE), MOVEOF(NODE), PLAYER(NODE))    :(RETURN)
  499. START_END
  500. *
  501. *---------------------------------------------------------------------------
  502. * The only thing that need be done when we have finished evaluating a node
  503. * is to restore the board to its previous condition by popping the values of
  504. * the pots and kalahs.
  505. *
  506.     NEND_PAT = FENCE
  507. +     TO_NEXT_BLANK $ P *POPVAL($P)
  508. +     SKIP_BLANKS *NEND_PAT
  509. *
  510.     DEF( 'NEND', 'NODE',, '(PSIDE "PKALAH " OSIDE "OKALAH ") NEND_PAT' )
  511. *
  512. *---------------------------------------------------------------------------
  513. * Succeeds if NODE is to be a terminal node of the search tree.  LEVEL will
  514. * be greater than 0 if the depth bound has not yet been reached.
  515. * This will be a terminal node if we have reached the level bound and we
  516. * are not in the midst of a multiple move, or if the game is over.
  517. *
  518.     DEFINE( 'DEAD(NODE,LEVEL)' )            :(DEAD_END)
  519. DEAD
  520.     ( LE(LEVEL,0) ~MULT(NODE) )            :S(RETURN)
  521.     GT( VALUE(PKALAH), HALFSTONES)            :S(RETURN)
  522.     GT( VALUE(OKALAH), HALFSTONES)            :S(RETURN)
  523.     ( EQ( VALUE(PKALAH), HALFSTONES)
  524. +     EQ( VALUE(OKALAH), HALFSTONES) )        :S(RETURN)F(FRETURN)
  525. DEAD_END
  526. *
  527. *---------------------------------------------------------------------------
  528. * Returns the static value of NODE.  The static value will just be the
  529. * difference in kalahs, unless the game is won or lost.  TNODES is
  530. * used to keep count of the number of terminal nodes evaluated, so
  531. * that statistics can be printed.
  532. *
  533.     DEFINE( 'STATIC(NODE)' )            :(STATIC_END)
  534. STATIC
  535.     TNODES = TNODES + 1
  536.     STATIC = GT( VALUE(PKALAH), HALFSTONES) INFINITY    :S(RETURN)
  537.     STATIC = GT( VALUE(OKALAH), HALFSTONES) -INFINITY    :S(RETURN)
  538.     STATIC = VALUE(PKALAH) - VALUE(OKALAH)            :(RETURN)
  539. STATIC_END
  540. *
  541. *---------------------------------------------------------------------------
  542. * Returns T if the node is a maximizing node, NIL otherwise.
  543. *
  544.     DEFINE( 'MAXER(NODE)' )            :(MAXER_END)
  545. MAXER
  546.     MAXER = nil
  547.     MAXER = IDENT( PLAYER(NODE), 'P') t    :(RETURN)
  548. MAXER_END
  549. *
  550. *---------------------------------------------------------------------------
  551. * Returns a list of the successor nodes of NODE.
  552. * BNODES is used to keep count of the number of nodes expanded.
  553. *
  554.     DEFINE( 'EXPAND(NODE)' )        :(EXPAND_END)
  555. EXPAND
  556.     BNODES = BNODES + 1
  557.     EXPAND = EXPAND1( PLAYER(NODE), SIDER(PLAYER(NODE)))    :(RETURN)
  558. EXPAND_END
  559. *
  560. *---------------------------------------------------------------------------
  561. * Returns a list of nodes representing the moves player PL can make from
  562. * the current state of the board.  SIDE is a list of PL's pots.
  563. *
  564. * Moves can only made from nonempty pots.  The list of possible moves is
  565. * ordered: multiple moves, capture moves, others.  This is done to try to
  566. * play a strong game and to try to maximize cutoffs.
  567. *
  568.     DEFINE( 'EXPAND1(PL,SIDE)LMULT,LCAP,LREG')
  569.     EXPAND1_PAT = FENCE
  570. +          TO_NEXT_BLANK $ P  *EXPAND2(PL,$P)
  571. +          SKIP_BLANKS  *EXPAND1_PAT            :(EXPAND1_END)
  572. EXPAND1
  573.     LMULT = nil ; LCAP = nil ; LREG = nil
  574.     SIDE EXPAND1_PAT
  575.     EXPAND1 = APPEND3( LMULT, LCAP, LREG)        :(RETURN)
  576. EXPAND1_END
  577. *
  578. * EXPAND2
  579.     DEFINE( 'EXPAND2(PL,POT)' )            :(EXPAND2_END)
  580. EXPAND2
  581.     EMPTY(POT)                    :S(RETURN)
  582.     LMULT = MULTMOVE(POT)
  583. +     STACK( NODE(PL,POT,PL), LMULT)            :S(RETURN)
  584.     LCAP = CAPMOVE(PL,POT)
  585. +     STACK( NODE(PL,POT,OTHER(PL)), LCAP)        :S(RETURN)
  586.     LREG =
  587. +     STACK( NODE(PL,POT,OTHER(PL)), LREG)        :(RETURN)
  588. EXPAND2_END
  589. *
  590. *---------------------------------------------------------------------------
  591. * Succeeds if a move from pot POT will result in the player making the
  592. * move getting another turn, fails otherwise.
  593. *
  594. * If s is the number of stones in the player's nth pot, the last stone will
  595. * land in the player's kalah if and only if:  s mod 13 = 7 - n
  596. *
  597.     DEF( 'MULTMOVE', 'POT',,
  598. +      'EQ(REMDR(VALUE(POT),13), 7 - NUM(POT))', 'S')
  599. *
  600. * Succeeds if player PL's move from pot POT will result in a capture
  601. * of some stones.
  602. *
  603.     DEF( 'CAPMOVE', 'PL POT',,
  604. +     'CAPMOVE1(PL,POT,VALUE(POT),NUM(POT))', 'S')
  605. *
  606. * Returns T if PL's move from POT will result in a capture, NIL otherwise.
  607. * POT is PL's Nth pot and it has V stones in it.
  608. *
  609. * If V=13, the last stone will land in POT, and the opposite pot must have
  610. * at least one stone in it, since one will be dropped into it on this move.
  611. * If V<(7-N), the last stone will land in PL's pot number N+V.  We must
  612. * check that it is empty and that the pot opposite it is not.
  613. * If (13-N)<V<13, the last stone will land in PL's pot number N+V+13, and we
  614. * must check that it is now empty, but PL will drop a stone into all the
  615. * opponent's pots, so none of them will be empty.  In all other cases, a
  616. * capture will not occur.
  617. *
  618.     DEFINE( 'CAPMOVE1(PL,POT,V,N)' )        :(CAPMOVE1_END)
  619. CAPMOVE1
  620.     EQ(V,13)                    :S(RETURN)
  621.     ( LT(V, (7 - N))
  622. +     EMPTY( POTR( PL, (N + V)))
  623. +     ~EMPTY( OPP( POTR( PL, (N + V)))) )        :S(RETURN)
  624.     ( GT(V, (13 - N))
  625. +     LT(V, 13)
  626. +     EMPTY( POTR( PL, (N - 13 + V))) )        :S(RETURN)F(FRETURN)
  627. CAPMOVE1_END
  628. -EJECT
  629. *
  630. *************************************************
  631. * FUNCTIONS FOR CONTROLLING AN INTERACTIVE GAME *
  632. *************************************************
  633. *
  634. * This function is used to begin a game with the program.  N is the
  635. * number of stones in each pot at the beginning of the game.  DEPTH
  636. * is the depth bound on the search.
  637. *
  638.     DEFINE( 'KALAH(N,DEPTH)' )            :(KALAH_END)
  639. KALAH
  640.     ( INITBRD(N)
  641. +     PRINTBRD()
  642. +     ALTMOVE(MEFIRST()) )
  643.       KALAH = 'Thanks.'                :(RETURN)
  644. KALAH_END
  645. *
  646. *---------------------------------------------------------------------------
  647. * Initializes the board by putting VAL stones in each pot and emptying
  648. * the two kalahs.  Also, it initializes the global variable HALFSTONES.
  649. *
  650.     DEFINE( 'INITBRD(VAL)' )
  651.     INITBRD_PAT = FENCE
  652. +     TO_NEXT_BLANK $ P  *INITBRD1(P)
  653. +     SKIP_BLANKS  *INITBRD_PAT
  654.     INITBRD1_PAT = LEFT_END
  655. +          ( (LEN(1) $ O) (LEN(1) $ N) )
  656.     :(INITBRD_END)
  657. INITBRD
  658.     INFINITY = 100
  659.     TNODES = 0
  660.     BNODES = 0
  661.     HALFSTONES = 6 * VAL
  662.     (PSIDE OSIDE) INITBRD_PAT
  663.     PKALAH = POT('P',0,STACK(0,nil),null,null,null)
  664.     OKALAH = POT('O',0,STACK(0,nil),null,null,null)
  665.     SETSYM('OPP','P1 O6 P2 O5 P3 O4 P4 O3 P5 O2 P6 O1 ')
  666.     SETPATH('PPATH',
  667. +      'P1 P2 P3 P4 P5 P6 PKALAH O1 O2 O3 O4 O5 O6 P1 ')
  668.     SETPATH('OPATH',
  669. +      'O1 O2 O3 O4 O5 O6 OKALAH P1 P2 P3 P4 P5 P6 O1 ')
  670.             :(RETURN)
  671. INITBRD_END
  672. *
  673. * INITBRD1
  674.     DEFINE( 'INITBRD1(PNAME)' )            :(INITBRD1_END)
  675. INITBRD1
  676.     PNAME INITBRD1_PAT
  677.     $PNAME = POT(O,N,STACK(VAL,nil),null,null,null)    :(RETURN)
  678. INITBRD1_END
  679. *
  680. *---------------------------------------------------------------------------
  681. * Does a formatted print of the current state of the board.
  682. *
  683.     DEFINE( 'PRINTBRD()' )            :(PRINTBRD_END)
  684. PRINTBRD
  685.     PRT( DUPL(' ',7)
  686. +        CNTR(7,VALUE(P6))
  687. +        CNTR(7,VALUE(P5))
  688. +        CNTR(7,VALUE(P4))
  689. +        CNTR(7,VALUE(P3))
  690. +        CNTR(7,VALUE(P2))
  691. +        CNTR(7,VALUE(P1)) )
  692.     PRT( CNTR(7,VALUE(PKALAH))
  693. +        DUPL(' ',42)
  694. +        CNTR(7,VALUE(OKALAH)) )
  695.     PRT( DUPL(' ',7)
  696. +        CNTR(7,VALUE(O1))
  697. +        CNTR(7,VALUE(O2))
  698. +        CNTR(7,VALUE(O3))
  699. +        CNTR(7,VALUE(O4))
  700. +        CNTR(7,VALUE(O5))
  701. +        CNTR(7,VALUE(O6)) )
  702.            :(RETURN)
  703. PRINTBRD_END
  704. *
  705. *---------------------------------------------------------------------------
  706. * Asks if the opponent wants to go first.  Returns YES or NO.
  707. *
  708.     DEFINE( 'MEFIRST()' )                :(MEFIRST_END)
  709. MEFIRST
  710.     PRT( 'Do you want to go first?')
  711.     MEFIRST = REPLACE(INPUT,LOWERS,UPPERS)        :F(END)
  712.     SHADOW = DUPL(' ',10) 'Answer: ' MEFIRST
  713.     MEFIRST (LEFT_END ('YES' | 'NO') RIGHT_END)    :S(RETURN)
  714.     PRT( 'Please answer YES or NO.')        :(MEFIRST)
  715. MEFIRST_END
  716. *
  717. *---------------------------------------------------------------------------
  718. * Alternates moves between the program and the opponent until the
  719. * game is over.
  720. *
  721.     DEFINE( 'ALTMOVE(YN)' )            :(ALTMOVE_END)
  722. ALTMOVE
  723.     IDENT(YN,'NO')                :F(ALTMOVE2)
  724. ALTMOVE1
  725. *
  726. * Computer, then user
  727.     ( PMOVE() OMOVE() )            :S(ALTMOVE1)F(RETURN)
  728. *
  729. * User, then computer
  730. ALTMOVE2
  731.     ( OMOVE() PMOVE() )            :S(ALTMOVE2)F(RETURN)
  732. ALTMOVE_END
  733. *
  734. *---------------------------------------------------------------------------
  735. * Gets the opponent's move, makes it, and prints the resulting board
  736. * until either it is no longer the opponent's move or the game is over.
  737. * If returns failing if the game is over, succeeds if it is now
  738. * the program's move.  In the latter case, the game might or might not
  739. * be over.
  740. *
  741.     DEFINE( 'OMOVE()' )            :(OMOVE_END)
  742. * Check for end of game
  743. OMOVE
  744.     ENDGAME()                :S(FRETURN)
  745. *
  746. * Get and make move
  747.     MOVE( 'O', GETMOVE() )            :F(OMOVE1)
  748. *
  749. * Landed on kalah
  750.     PRINTBRD()
  751.     PRT( 'You go again.' )            :(OMOVE)
  752. *
  753. * Did not land on Kalah
  754. OMOVE1
  755.     PRINTBRD()                :(RETURN)
  756. OMOVE_END
  757. *
  758. *---------------------------------------------------------------------------
  759. * Interacts with the opponent, returning the pot the opponent chooses
  760. * to move, making sure it is a legal move.
  761. *
  762.     DEFINE( 'GETMOVE()N' )            :(GETMOVE_END)
  763. GETMOVE
  764.     PRT( "What's your move?" )
  765.     N = INPUT                :F(END)
  766.     SHADOW = DUPL(' ',10) 'Answer: ' N
  767.     GETMOVE =
  768. +      ( INTEGER(N) GT(N,0) LT(N,7) ~EMPTY(POTR('O',N)) )
  769. +     POTR('O',N)                :S(RETURN)
  770.     PRT( "That's illegal.")            :(GETMOVE)
  771. GETMOVE_END
  772. *
  773. *---------------------------------------------------------------------------
  774. * If the game is over, this function prints an appropriate message
  775. * and returns succeeding.  Otherwise it fails.
  776. *
  777.     DEFINE( 'ENDGAME()' )            :(ENDGAME_END)
  778. ENDGAME
  779.     ( GT(VALUE(PKALAH),HALFSTONES) PRT( 'I win.') )        :S(RETURN)
  780.     ( GT(VALUE(OKALAH),HALFSTONES) PRT( 'You win.') )    :S(RETURN)
  781.     ( EQ(VALUE(PKALAH),HALFSTONES)
  782. +       EQ(VALUE(OKALAH),HALFSTONES)
  783. +     PRT( "It's a tie.") )                    :S(RETURN)
  784.            :(FRETURN)
  785. ENDGAME_END
  786. *
  787. *---------------------------------------------------------------------------
  788. * Causes the program to make moves until either it isthe opponent's turn
  789. * of the game ends.  It returns failing if the game is over, succeeds
  790. * if it now the opponent's move.  In the latter case, the game might or
  791. * might not be over.
  792. *
  793.     DEFINE( 'PMOVE()' )            :(PMOVE_END)
  794. PMOVE
  795.     PRT( 'I go.' )
  796. PMOVE1
  797.     ENDGAME()                :S(FRETURN)
  798.     PRT( 'Hmmm....' )
  799.     COLLECT()
  800.     PLAY(-INFINITY,INFINITY,0,0,TIME())    :F(RETURN)
  801. *
  802. * If computer landed on PKALAH
  803.     PRT( 'I go again.' )            :(PMOVE1)
  804. PMOVE_END
  805. *
  806. *---------------------------------------------------------------------------
  807. * Makes a move for the program.  BNODES is the number of nodes expanded
  808. * so far.  TNODES is thenumber of terminal nodes evaluated.  SECS is the
  809. * nmber of CPU milliseconds used so far by the program.  This function
  810. * succeeds if the program gets another move.
  811. *
  812.     DEFINE( 'PLAY(ALPHA,BETA,BNODES,TNODES,SECS)' )    :(PLAY_END)
  813. PLAY
  814.     PLAY1(EXPAND(NODE('P',nilpot,'O')))        :S(RETURN)F(FRETURN)
  815. PLAY_END
  816. *
  817. *---------------------------------------------------------------------------
  818. * LNODES is a list of possible moves.  PLAY1 chooses one of them and makes it,
  819. * succeeding if the program gets another move.
  820. *
  821.     DEFINE( 'PLAY1(LNODES)' )            :(PLAY1_END)
  822. PLAY1
  823.     NULL(REST(LNODES))                :F(PLAY1A)
  824.     CHOOSE(REST(LNODES),TOP(LNODES),"not calculated") :S(RETURN)F(FRETURN)
  825. PLAY1A
  826.     CHOOSE(REST(LNODES),TOP(LNODES),
  827. +     SEARCH(TOP(LNODES),DEPTH,ALPHA,BETA))        :S(RETURN)F(FRETURN)
  828. PLAY1_END
  829. *
  830. *---------------------------------------------------------------------------
  831. * Chooses and makes the best possible move.  BEST is the best move found
  832. * so far, V is its value.  LNODES is a list of alternate moves.  It
  833. * returns succeeding if the program gets another move.
  834. *
  835.     DEFINE( 'CHOOSE(LNODES,BEST,V)NV' )        :(CHOOSE_END)
  836. CHOOSE
  837.     NULL(LNODES)                    :S(CHOOSE2)
  838.     EQ(V,INFINITY)                    :S(CHOOSE2)
  839.     NV = SEARCH(TOP(LNODES),DEPTH,V,BETA)
  840.     LE(NV,V)                    :S(CHOOSE1)
  841.     V = NV
  842.     BEST = TOP(LNODES)
  843. CHOOSE1
  844.     LNODES = REST(LNODES)                :(CHOOSE)
  845. CHOOSE2
  846.     MAKE(BEST,V)                    :S(RETURN)F(FRETURN)
  847. CHOOSE_END
  848. *
  849. *---------------------------------------------------------------------------
  850. * Makes the move CHOSEN, whose valueis VAL, reports to the opponent and
  851. * prints the board.  It returns success if the program gets another move.
  852. *
  853.     DEFINE( 'MAKE(CHOSEN,VAL)' )            :(MAKE_END)
  854. MAKE
  855.     REPORT(NUM(MOVEOF(CHOSEN)),
  856. +     VAL, BNODES, TNODES, TIME() - SECS )
  857.     MOVE(PLAYER(CHOSEN),MOVEOF(CHOSEN))        :F(MAKE1)
  858.     PRINTBRD()                    :(RETURN)
  859. MAKE1
  860.     PRINTBRD()                    :(FRETURN)
  861. MAKE_END
  862. *
  863. *---------------------------------------------------------------------------
  864. * Reports to the opponent that move M was chosen, it had calculated a
  865. * value of V, B nodes were expanded, T terminal nodes were evaluated,
  866. * and S CPU msec were used to make the decision.
  867. *
  868.     DEFINE( 'REPORT(M,V,B,T,S)' )            :(REPORT_END)
  869. REPORT
  870.     PRT("I pick pot " M ".  Value " V)
  871.     PRT(B " nodes expanded, " T " evaluated")
  872.     PRT(S " milliseconds used")            :(RETURN)
  873. REPORT_END
  874.  
  875. -EJECT
  876. *
  877. ****************************
  878. * MAIN PROGRAM STARTS HERE *
  879. ****************************
  880. *
  881. GET_NUMBER_OF_STONES
  882.     PRT( 'Enter number of stones per pot' )
  883.     N = INPUT                    :F(END)
  884.     SHADOW = DUPL(' ',10) 'Answer: ' N
  885.     ( INTEGER(N) GT(N,0) )            :F(GET_NUMBER_OF_STONES)
  886. GET_SEARCH_DEPTH
  887.     PRT( 'Enter maximum search depth' )
  888.     D = INPUT
  889.     SHADOW = DUPL(' ',10) 'Answer: ' D
  890.     ( INTEGER(D) GT(D,0) )            :F(GET_SEARCH_DEPTH)
  891.     OUTPUT = KALAH(N,D)            :S(GET_NUMBER_OF_STONES)
  892. END
  893.