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