├── LICENSE ├── README.md ├── bind ├── C-library │ ├── ANSI.red │ ├── ANSI.reds │ ├── COPYRIGHT.txt │ └── input-output.red └── common │ ├── COPYRIGHT.txt │ ├── FPU-configuration.reds │ ├── common.red │ └── common.reds └── xiangqi ├── docs ├── Theory │ └── THE MOST COMMON XIANGQI OPENINGS.docx ├── Xiangqi-foundations.txt ├── Xiangqi-hash.txt └── Xiangqi-moves.txt ├── extend ├── xiangqi-influence.red ├── xiangqi-pins.red ├── xiangqi-pvs.red └── xiangqi-validate.red ├── images ├── Xiangqi_Advisor_TB.png ├── Xiangqi_Advisor_TR.png ├── Xiangqi_Advisor_WB.png ├── Xiangqi_Advisor_WR.png ├── Xiangqi_Cannon_TB.png ├── Xiangqi_Cannon_TR.png ├── Xiangqi_Cannon_WB.png ├── Xiangqi_Cannon_WR.png ├── Xiangqi_Chariot_TB.png ├── Xiangqi_Chariot_TR.png ├── Xiangqi_Chariot_WB.png ├── Xiangqi_Chariot_WR.png ├── Xiangqi_Elephant_TB.png ├── Xiangqi_Elephant_TR.png ├── Xiangqi_Elephant_WB.png ├── Xiangqi_Elephant_WR.png ├── Xiangqi_General_TB.png ├── Xiangqi_General_TR.png ├── Xiangqi_General_WB.png ├── Xiangqi_General_WR.png ├── Xiangqi_Horse_TB.png ├── Xiangqi_Horse_TR.png ├── Xiangqi_Horse_WB.png ├── Xiangqi_Horse_WR.png ├── Xiangqi_Soldier_TB.png ├── Xiangqi_Soldier_TR.png ├── Xiangqi_Soldier_WB.png └── Xiangqi_Soldier_WR.png ├── test ├── xiangqi-best-move-test.red ├── xiangqi-choose-move-test.red ├── xiangqi-convertions-test.red ├── xiangqi-evaluate-test.red ├── xiangqi-hash-test.red ├── xiangqi-move-display-test.red └── xiangqi-moves-test.red ├── utils ├── red-element-in-collection.red ├── red-found.red ├── red-multi-switch.red ├── red-power.red ├── red-rejoin.red └── xiangqi-helper-functions.red ├── xiangqi-best-move.red ├── xiangqi-board.red ├── xiangqi-common.red ├── xiangqi-console.red ├── xiangqi-convertions.red ├── xiangqi-debug-log.red ├── xiangqi-evaluate.red ├── xiangqi-hash.red ├── xiangqi-move-common.red ├── xiangqi-moves.red └── xiangqi-open.red /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, iArnold 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | * Neither the name of Xiangqi nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 19 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Xiangqi 2 | 3 | Xiangqi in Red (Version 0.6.0!) 4 | ------------------------------- 5 | 6 | The game of Xiangqi programmed using the programming language Red. 7 | The program is reported not to work with the new version of Red, version 0.6.1. 8 | I updated the bindings to the most recent available (05-06-2016) but this is no guaranty it will work now. 9 | At the moment I have no intention to update for every upgrade of Red, for that takes too much of my time. 10 | 11 | What is the Red programming language? 12 | ------------------------------------- 13 | 14 | Red is a new programming language ( http://www.red-lang.org ) 15 | heavily inspired by REBOL ( http://www.rebol.com ). 16 | 17 | Why use Red as programming language? 18 | ------------------------------------ 19 | 20 | Because code written in Red means that the source of this program will be very readable, 21 | unlike similar open sourced chess programs that use C or C++ and contain functions with 22 | cryptic short names like 'D' and 'S'. Generally the existing chess programs if they are 23 | open sourced at all, are hard to follow because of their effective use of the internal 24 | computer memory and there will be a lot of binary calculations happening. Not only will 25 | all these calculations mean very little to people trying to understand what is going on in 26 | certain parts of the program, the sources are also often sparsely, if at all, commented. 27 | 28 | The Red program for Xiangqi will make use of a human understandable representation of the 29 | chessboard and the code that works on it will be better understandable as a consequence. 30 | 31 | But ultimately because programming using Red is programming with FUN. 32 | 33 | Note 34 | ---- 35 | Please be aware of the fact that Red is still in PRE-alpha stage (version 0.6.0) at time 36 | of writing this code. Above that, my code is not always the best way of writing Red code. 37 | The code could be improved for speed, readability, structure, be more Red (REBOL like), 38 | my main concern here has been to create a working program that is human readable. 39 | 40 | Documentation 41 | ------------- 42 | 43 | Documentation explains how the internal representation of the board, the pieces and the 44 | moves came to be as they are. 45 | 46 | Red version 47 | ----------- 48 | 49 | The console program was made using the 0.5.4 version of the Red programming language. 50 | Therefore also the bindings by Kaj de Vos, included here in the bind folder, are the 51 | corresponding files for this Red version also. When updating to a next version of Red, 52 | the bindings should be upgraded as well. The original bindings by Kaj de Vos can be 53 | found here 54 | 55 | http://red.esperconsultancy.nl/Red-test 56 | 57 | The GUI version of the program, xiangqi-board.red, is made with the development version 58 | of Red 0.6.0. 59 | Bad news, good news follows now. The GUI is only for Windows. The good news is Red 60 | language is also aiming to target all kinds of other platforms too in a native way. 61 | If you want to help get Red have a GUI on your favorite platform, please feel free to 62 | do so. 63 | 64 | Compiling this program 65 | ---------------------- 66 | 67 | To compile this program, you will need the sourcecode, a Rebol (View) program for your 68 | computer and the Red sources. Because the GUI branch has been merged into the master 69 | branch you can now use the sources from the master branch. 70 | You can find very specific information how to compile Red programs on the Github site of 71 | Red here: 72 | 73 | https://github.com/red/red 74 | 75 | In short it is start your Rebol View program, go to the console and change directory 76 | to the Red source folder 77 | 78 | cd red 79 | 80 | and do 81 | 82 | do %red.r 83 | rc %../xiangqi/xiangqi/xiangqi-console.red 84 | 85 | Note that I have renamed the folder Xiangqi-master you get when unpacking the 86 | Xiangqi-master.zip file you downloaded to Xiangqi, I also like to rename Red-master folder 87 | to just Red folder. 88 | And now the Red compiler will create your program in the Red folder. 89 | 90 | Compiling the GUI version is done by 91 | 92 | rc %../xiangqi/xiangqi/xiangqi-board.red 93 | 94 | You will notice this opens a command window as well. This is handy for trying out 95 | improvements, it will show all print and probe debugging helper commands you have put 96 | inside your changed code. 97 | If you do not want such a command window to appear you compile using 98 | 99 | do/args %red.r "-c -t Windows %../xiangqi/xiangqi/xiangqi-console.red" 100 | 101 | Because the program needs to load the images for the pieces you must make sure the folder 102 | the program is in contains the images folder and images. (Or you copy the program from the 103 | Red folder over to the Xiangqi/xiangqi folder 104 | 105 | Testprograms 106 | ------------ 107 | 108 | The program comes including some small testprograms that can be compiled using Red too. 109 | 110 | What is there to be done? 111 | ------------------------- 112 | 113 | A lot! 114 | 115 | 116 | The program needs much more testing than I have already done. 117 | Add list for played moves. 118 | Undo functionality for moves. 119 | Show the best variant considered. 120 | Making use of computed hashes for each position to save time on computing a position 121 | that was already done, when a different order of moves was played. 122 | This can make a HUGE improvement in speed! 123 | Better evaluation by making use of influence data and pins. 124 | Making use of different fail hard and fail soft mechanisms. 125 | Improve quiescence routine to include moves that give check. 126 | Include rules for draw when repetitive moves are made by the players. 127 | Make program compatible to compete against other chess programs. 128 | Create a version for the next release of Red. 129 | Make more use of faster Red/System routines. 130 | Make use of general move databases. 131 | Check and improve the hash used. I have the idea that the hash code can be shortened, 132 | but I am not 100% sure about that. (Only partly possible.) 133 | Add file I/O to export played games and import new positions. (Wait for Red I/O). 134 | 135 | I never played an actual game of Xiangqi in my life, yet I made this program. If you like 136 | Xiangqi, know just a bit of programming, or like this project, please let me know and 137 | join in making this program better. 138 | 139 | License 140 | ------------------------- 141 | See license document. The binding files by Kaj de Vos have their own license, included as 142 | well. In short you use the provided software as is, at your own risk. 143 | -------------------------------------------------------------------------------- /bind/C-library/ANSI.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "ANSI C Library Binding" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011-2016 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red >= 0.6 28 | %ANSI.reds 29 | %common/common.red 30 | } 31 | Tabs: 4 32 | ] 33 | 34 | 35 | ;#system-global [#include %ANSI.reds] 36 | #include %../common/common.red 37 | 38 | 39 | ; Parsing 40 | 41 | load-integer: routine ["Return integer parsed from string." 42 | string [string!] 43 | ; return: [integer! none!] 44 | /local text 45 | ][ 46 | text: to-UTF8 string 47 | 48 | either none? text [ 49 | RETURN_NONE 50 | ][ 51 | integer/box to-integer text 52 | free-any text 53 | ] 54 | ] 55 | load-hex: routine ["Return integer parsed from hexadecimal string." 56 | string [string!] 57 | ; return: [integer! none!] 58 | /local text result ok? 59 | ][ 60 | text: to-UTF8 string 61 | 62 | either none? text [ ; Needed? 63 | RETURN_NONE 64 | ][ 65 | result: 0 66 | ok?: parse-hex text :result 67 | free-any text 68 | 69 | either ok? [ 70 | integer/box result 71 | ][ 72 | RETURN_NONE 73 | ] 74 | ] 75 | ] 76 | load-octal: routine ["Return integer parsed from octal string." 77 | string [string!] 78 | ; return: [integer! none!] 79 | /local text result ok? 80 | ][ 81 | text: to-UTF8 string 82 | 83 | either none? text [ ; Needed? 84 | RETURN_NONE 85 | ][ 86 | result: 0 87 | ok?: parse-octal text :result 88 | free-any text 89 | 90 | either ok? [ 91 | integer/box result 92 | ][ 93 | RETURN_NONE 94 | ] 95 | ] 96 | ] 97 | 98 | 99 | ; Conversion 100 | 101 | char-to-integer: routine ["Return integer (Unicode codepoint) value of character." 102 | character [char!] 103 | return: [integer!] 104 | ][ 105 | character/value 106 | ] 107 | to-integer: func ["Return integer converted from other types." 108 | value [char! string!] 109 | return: [integer! none!] 110 | ][ 111 | either char? value [ 112 | char-to-integer value 113 | ][ 114 | load-integer value 115 | ] 116 | ] 117 | 118 | 119 | comment { 120 | 121 | ; Formatting 122 | 123 | to-hex-size: routine ["Return integer formatted as hexadecimal string." 124 | number [integer!] 125 | length [integer!] "Number of digits" 126 | ; return: [string! none!] 127 | /local text 128 | ][ 129 | text: form-hex number length 130 | 131 | either none? text [ 132 | RETURN_NONE 133 | ][ 134 | SET_RETURN ((string/load text length? text UTF-8)) 135 | ; free-any text 136 | ] 137 | ] 138 | to-hex: func ["Return integer formatted as hexadecimal string." 139 | number [integer! char!] 140 | /size 141 | length [integer!] "Number of digits" 142 | return: [string! none!] 143 | ][ 144 | to-hex-size number any [length 8] 145 | ] 146 | 147 | } 148 | 149 | 150 | ; Input/output 151 | 152 | input*: routine ["Return a line read from standard input." 153 | ; return: [string! none!] 154 | /local line 155 | ][ 156 | line: input 157 | 158 | either none? line [ 159 | RETURN_NONE ; FIXME: report error 160 | ][ 161 | SET_RETURN ((string/load line length? line UTF-8)) 162 | ; free-any line 163 | ] 164 | ] 165 | ask*: function ["Prompt for input, then return a line read from standard input." 166 | question [string!] 167 | return: [string! none!] 168 | ][ 169 | prin question 170 | input* 171 | ] 172 | 173 | 174 | ; Dates and time 175 | 176 | date-with: routine ["Return date or time component." 177 | time [integer!] "time!" 178 | utc? [logic!] 179 | zone? [logic!] 180 | date? [logic!] 181 | time? [logic!] 182 | year? [logic!] 183 | month? [logic!] 184 | day? [logic!] 185 | hour? [logic!] 186 | minute? [logic!] 187 | second? [logic!] 188 | weekday? [logic!] 189 | yearday? [logic!] 190 | ; return: [string! integer! none!] 191 | /local date minutes zone sign day text 192 | ][ 193 | date: to-date :time 194 | 195 | either none? date [ 196 | RETURN_NONE 197 | ][ 198 | minutes: date/hour * 60 + date/minute 199 | 200 | date: to-local-date :time 201 | zone: date/hour * 60 + date/minute - minutes 202 | 203 | if utc? [date: to-date :time] 204 | 205 | case [ 206 | second? [integer/box date/second] 207 | minute? [integer/box date/minute] 208 | hour? [integer/box date/hour] 209 | day? [integer/box date/day] 210 | month? [integer/box date/month + 1] 211 | year? [integer/box date/year + 1900] 212 | yearday? [integer/box date/yearday + 1] 213 | weekday? [ 214 | day: date/weekday 215 | 216 | ; REBOL has a wrong world view 217 | integer/box either as-logic day [day] [7] ; Sunday 218 | ] 219 | yes [ 220 | text: make-c-string 27 221 | 222 | either none? text [ 223 | RETURN_NONE ; FIXME: report error 224 | ][ 225 | either zone > 720 [ ; 12 hours 226 | zone: zone - 1440 ; 24 hours 227 | ][ 228 | if zone <= -720 [zone: zone + 1440] 229 | ] 230 | sign: either negative? zone [ 231 | zone: negate zone 232 | #"-" 233 | ][ 234 | #"+" 235 | ] 236 | case [ 237 | zone? [ 238 | either 5 <= format-any [text "%c%i:%02i" sign zone / 60 zone // 60] [ 239 | SET_RETURN ((string/load text length? text UTF-8)) 240 | ][ ; FIXME: report error 241 | RETURN_NONE 242 | ] 243 | ] 244 | date? [ 245 | either format-date text 27 "%d-%b-%Y" date [ 246 | SET_RETURN ((string/load text length? text UTF-8)) 247 | ][ ; FIXME: report error 248 | RETURN_NONE 249 | ] 250 | ] 251 | time? [ 252 | either format-date text 27 "%H:%M:%S" date [ 253 | SET_RETURN ((string/load text length? text UTF-8)) 254 | ][ ; FIXME: report error 255 | RETURN_NONE 256 | ] 257 | ] 258 | yes [ 259 | either format-date text 27 "%d-%b-%Y/%H:%M:%S" date [ 260 | either any [utc? 25 <= format-any [text "%s%c%i:%02i" text sign zone / 60 zone // 60]] [ 261 | SET_RETURN ((string/load text length? text UTF-8)) 262 | ][ ; FIXME: report error 263 | RETURN_NONE 264 | ] 265 | ][ ; FIXME: report error 266 | RETURN_NONE 267 | ] 268 | ] 269 | ] 270 | free-any text 271 | ] 272 | ] 273 | ] 274 | ] 275 | ] 276 | date: function ["Return date or time component." 277 | value [integer!] "time!" 278 | /precise 279 | /utc /zone 280 | /date /time 281 | /year /month /day 282 | /hour /minute /second 283 | /weekday /yearday 284 | return: [string! integer! none!] 285 | ][ 286 | unless value = -1 [ 287 | either precise [ 288 | value 289 | ][ 290 | date-with 291 | value 292 | utc zone 293 | date time 294 | year month day 295 | hour minute second 296 | weekday yearday 297 | ] 298 | ] 299 | ] 300 | now-time: routine ["Return current time." 301 | return: [integer!] "time!" 302 | ][ 303 | system/words/now-time null 304 | ] 305 | now*: function ["Return current time." 306 | /precise 307 | /utc /zone 308 | /date /time 309 | /year /month /day 310 | /hour /minute /second 311 | /weekday /yearday 312 | return: [string! integer! none!] 313 | ][ 314 | unless -1 = value: now-time [ 315 | either precise [ 316 | value 317 | ][ 318 | date-with 319 | value 320 | utc zone 321 | date time 322 | year month day 323 | hour minute second 324 | weekday yearday 325 | ] 326 | ] 327 | ] 328 | 329 | subtract-time: routine ["Return time difference in seconds: time-1 - time-2" 330 | time-1 [integer!] "time!" 331 | time-2 [integer!] "time!" 332 | ; return: [float!] "Seconds" ; Red FIXME 333 | ][ 334 | float/box system/words/subtract-time time-1 time-2 335 | ] 336 | 337 | clocks-per-second: routine ["Return clock ticks per second" 338 | return: [integer!] 339 | ][ 340 | clocks-per-second 341 | ] 342 | get-process-time: routine ["Return CPU time used by process; wall-clock time on Windows!" 343 | return: [integer!] "-1: unknown" 344 | ][ 345 | system/words/get-process-time 346 | ] 347 | get-process-seconds: function ["Return CPU time used by process in seconds; wall-clock time on Windows!" 348 | return: [float! none!] "Seconds" 349 | /local time 350 | ][ 351 | unless -1 = time: get-process-time [ 352 | time / to float! clocks-per-second ; TODO: optimise 353 | ] 354 | ] 355 | 356 | 357 | comment { 358 | 359 | ; Random numbers 360 | 361 | random-with: routine ["Return pseudo-random number from 1 thru NUMBER." 362 | number [integer!] 363 | seed? [logic!] "Restart the sequence with new seed NUMBER (initially 1)?" 364 | secure? [logic!] "Use time-based seed?" 365 | ; return: [integer! unset!] 366 | ][ 367 | either seed? [ 368 | either secure? [random-seed-secure] [random-seed number] 369 | RETURN_UNSET 370 | ][ 371 | integer/box random number 372 | ] 373 | ] 374 | random: function ["Return pseudo-random number from 1 thru NUMBER." 375 | number [integer!] 376 | /seed "Restart the sequence with new seed NUMBER (initially 1)." 377 | /secure "Use time-based seed." 378 | return: [integer! unset!] 379 | ][ 380 | random-with number seed secure 381 | ] 382 | 383 | } 384 | 385 | 386 | ; System interfacing 387 | 388 | get-environment: routine ["Return system environment variable." 389 | name [string!] 390 | ; return: [string! none!] 391 | /local text value 392 | ][ 393 | text: to-UTF8 name 394 | value: system/words/get-environment text 395 | free-any text 396 | 397 | either none? value [ 398 | RETURN_NONE 399 | ][ 400 | SET_RETURN ((string/load value length? value UTF-8)) 401 | ; free-any value ; ? 402 | ] 403 | ] 404 | 405 | call-system*: routine ["Execute external system command." 406 | command [string!] 407 | return: [integer!] 408 | /local text status 409 | ][ 410 | text: to-UTF8 command 411 | status: call text 412 | free-any text 413 | status 414 | ] 415 | call-system: function ["Execute external system command." 416 | command [string!] 417 | /wait "Await command's return." 418 | return: [integer!] 419 | ][ 420 | ; TODO: no-wait on Windows 421 | call-system* either any [wait Windows?] [command] [append copy command " &"] 422 | ] 423 | -------------------------------------------------------------------------------- /bind/C-library/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | C Library Binding for Red 2 | 3 | Copyright (c) 2011-2016 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /bind/C-library/input-output.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Local file Input/Output" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2013-2016 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: { 27 | Red >= 0.6 28 | %common/common.red 29 | } 30 | Tabs: 4 31 | ] 32 | 33 | 34 | #include %../common/common.red 35 | 36 | 37 | context [ ; Red FIXME 38 | 39 | read-string: routine ["Read and return a UTF-8 text file." 40 | name [integer!] "c-string!" ; [file! url!] 41 | ; return: [string! none!] 42 | /local file text length 43 | ][ 44 | length: 0 45 | file: as-c-string name 46 | 47 | if zero? compare-string-part file "file:" 5 [file: file + 5] 48 | 49 | text: read-file file :length 50 | 51 | either none? text [ 52 | RETURN_NONE 53 | ][ 54 | SET_RETURN ((string/load text length UTF-8)) 55 | free-any text 56 | ] 57 | ] 58 | read-string-binary: routine ["Read a text file, return it as binary." 59 | name [integer!] "c-string!" ; [file! url!] 60 | ; return: [integer! none!] 61 | /local file array text length 62 | ][ 63 | length: 0 64 | file: as-c-string name 65 | 66 | if zero? compare-string-part file "file:" 5 [file: file + 5] 67 | 68 | text: read-file file :length 69 | 70 | either none? text [ 71 | RETURN_NONE 72 | ][ 73 | array: as array1! allocate size? array1! 74 | 75 | either none? array [ 76 | free-any text 77 | RETURN_NONE 78 | ][ 79 | array/data: as-binary text 80 | array/size: length ; Excluding null tail marker 81 | integer/box as-integer array 82 | ] 83 | ] 84 | ] 85 | read-binary: routine ["Read and return a binary file." 86 | name [integer!] "c-string!" ; [file! url!] 87 | ; return: [integer! none!] 88 | /local file array data size 89 | ][ 90 | size: 0 91 | file: as-c-string name 92 | 93 | if zero? compare-string-part file "file:" 5 [file: file + 5] 94 | 95 | data: read-file-binary file :size 96 | 97 | either none? data [ 98 | RETURN_NONE 99 | ][ 100 | array: as array1! allocate size? array1! 101 | 102 | either none? array [ 103 | free data 104 | RETURN_NONE 105 | ][ 106 | array/data: data 107 | array/size: size 108 | integer/box as-integer array 109 | ] 110 | ] 111 | ] 112 | set 'read* function [ "Read and return a file." 113 | name [file! url! string! integer!] 114 | /binary "Return file as binary." 115 | /string "Read file as text." 116 | /lines "Return block of text lines." 117 | return: [string! block! integer! none!] 118 | ][ 119 | if name*: either integer? name [name] [to-local-file name] [ 120 | ok: either binary [ 121 | either string [read-string-binary name*] [read-binary name*] 122 | ][ 123 | if file: read-string name* [ 124 | either lines [split*/only file newline] [file] 125 | ] 126 | ] 127 | unless integer? name [free-any name*] 128 | 129 | ok 130 | ] 131 | ] 132 | 133 | write-string: routine ["Write UTF-8 text file." 134 | name [integer!] "c-string!" ; [file! url!] 135 | text [string!] 136 | return: [logic!] 137 | /local file out ok? 138 | ][ 139 | file: as-c-string name 140 | 141 | if zero? compare-string-part file "file:" 5 [file: file + 5] 142 | 143 | out: to-UTF8 text 144 | ok?: write-file file out 145 | free-any out 146 | ok? 147 | ] 148 | write-binary-part: routine ["Write binary file." 149 | name [integer!] "c-string!" ; [file! url!] 150 | data [integer!] "binary!" 151 | size [integer!] 152 | return: [logic!] 153 | /local file 154 | ][ 155 | file: as-c-string name 156 | 157 | if zero? compare-string-part file "file:" 5 [file: file + 5] 158 | 159 | write-file-binary file as-binary data size 160 | ] 161 | write-binary: routine ["Write binary file." 162 | name [integer!] "c-string!" ; [file! url!] 163 | data [integer!] "array1!" 164 | return: [logic!] 165 | /local array 166 | ][ 167 | either zero? data [ 168 | no 169 | ][ 170 | array: as array1! data 171 | write-binary-part name as-integer array/data array/size 172 | ] 173 | ] 174 | set 'write* function [ "Write file." 175 | name [file! url! string! integer!] 176 | data [string! integer!] 177 | /part "Write (part of) binary DATA." 178 | size [integer!] 179 | return: [logic! none!] 180 | ][ 181 | all [ 182 | name*: either integer? name [name] [to-local-file name] 183 | ( 184 | ok?: either string? data [ 185 | write-string name* data 186 | ][ 187 | either part [ 188 | write-binary-part name* data size 189 | ][ 190 | write-binary name* data 191 | ] 192 | ] 193 | unless integer? name [free-any name*] 194 | 195 | ok? 196 | ) 197 | ] 198 | ] 199 | 200 | 201 | comment { 202 | 203 | load**: :load 204 | 205 | load: function ["Return a value or block of values by loading a source." 206 | source [string! file! url!] 207 | /all "Always return a block." 208 | /into "Insert result into existing block." 209 | out [block!] "Result buffer" 210 | ][ 211 | if any [file? source url? source] [source: read source] 212 | 213 | all [ 214 | source 215 | either all [ 216 | either into [ 217 | do [load**/all/into source out] 218 | ][ 219 | do [load**/all source] 220 | ] 221 | ][ 222 | either into [ 223 | do [load**/into source out] 224 | ][ 225 | do [load** source] 226 | ] 227 | ] 228 | ] 229 | ] 230 | 231 | do*: :do 232 | result: make block! 1 ; WARN: not thread safe 233 | 234 | set 'do function ["Execute code from a source." 235 | source 236 | ][ 237 | if any [file? source url? source] [source: read source] 238 | 239 | first head reduce/into dummy: [do* source] clear result ; Force use of interpreter 240 | ] 241 | 242 | } 243 | 244 | ] 245 | -------------------------------------------------------------------------------- /bind/common/COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | Common Definitions for Red 2 | 3 | Copyright (c) 2011-2016 Kaj de Vos 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 15 | -------------------------------------------------------------------------------- /bind/common/FPU-configuration.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "FPU configuration for C functions" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2012,2013 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Needs: %common/common.reds 27 | Tabs: 4 28 | ] 29 | 30 | ; FPU configuration 31 | ; All exceptions need to be disabled when entering C functions 32 | 33 | #if target = 'IA-32 [ 34 | system/fpu/mask/overflow: on 35 | system/fpu/mask/underflow: on 36 | system/fpu/mask/zero-divide: on 37 | system/fpu/mask/invalid-op: on 38 | system/fpu/update 39 | ] 40 | 41 | #include %common.reds 42 | -------------------------------------------------------------------------------- /bind/common/common.reds: -------------------------------------------------------------------------------- 1 | Red/System [ 2 | Title: "Common Definitions" 3 | Author: "Kaj de Vos" 4 | Rights: "Copyright (c) 2011,2012,2015 Kaj de Vos. All rights reserved." 5 | License: { 6 | Redistribution and use in source and binary forms, with or without modification, 7 | are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, 10 | this list of conditions and the following disclaimer. 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | } 26 | Tabs: 4 27 | ] 28 | 29 | 30 | #define integer32! integer! 31 | 32 | ; FIXME: 33 | #define unsigned32! integer! 34 | #define integer16! integer! 35 | #define unsigned16! integer! 36 | #define integer64! float! 37 | 38 | integer16-reference!: alias struct! [ 39 | low [byte!] ; FIXME: reversed for big-endian 40 | high [byte!] 41 | ] 42 | integer64-reference!: alias struct! [ 43 | low [unsigned32!] ; FIXME: reversed for big-endian 44 | high [integer32!] 45 | ] 46 | 47 | #define variant! integer! 48 | #define opaque! [struct! [dummy [variant!]]] 49 | handle!: alias opaque! 50 | #define as-handle [as handle! ] 51 | #define binary! [pointer! [byte!]] 52 | #define as-binary [as binary! ] 53 | 54 | handle-reference!: alias struct! [value [handle!]] 55 | binary-reference!: alias struct! [value [binary!]] 56 | string-reference!: alias struct! [value [c-string!]] 57 | 58 | 59 | #define none? [null = ] 60 | 61 | #define free-any [free as-binary ] 62 | 63 | 64 | ; C types 65 | 66 | #define unsigned! integer! 67 | #define long! integer! 68 | #define unsigned-long! integer! 69 | #define enum! integer! 70 | #define double! float! 71 | 72 | #define size! integer! 73 | file!: alias opaque! 74 | 75 | argument-list!: alias struct! [item [integer!]] 76 | 77 | 78 | ; Limits for GNU (Syllable, Linux) 79 | ; TODO: check for other systems 80 | 81 | ; 32 bits 82 | #define min-long -2147483648 ; LONG_MIN 83 | #define max-long 7FFFFFFFh ; 2147483647, LONG_MAX 84 | #define max-unsigned-long FFFFFFFFh ; 4294967295, ULONG_MAX 85 | 86 | ; 64 bits 87 | ;#define min-long -9223372036854775808 ; LONG_MIN 88 | ;#define max-long 9223372036854775807 ; 7FFFFFFFFFFFFFFFh, LONG_MAX 89 | ;#define max-unsigned-long 18446744073709551615 ; FFFFFFFFFFFFFFFFh, ULONG_MAX 90 | 91 | 92 | ; Array 93 | 94 | array1!: alias struct! [ 95 | data [binary!] 96 | size [size!] 97 | ] 98 | -------------------------------------------------------------------------------- /xiangqi/docs/Theory/THE MOST COMMON XIANGQI OPENINGS.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/docs/Theory/THE MOST COMMON XIANGQI OPENINGS.docx -------------------------------------------------------------------------------- /xiangqi/docs/Xiangqi-foundations.txt: -------------------------------------------------------------------------------- 1 | Xiangqi programmed in Red documentation. 2 | ======================================== 3 | 4 | ================================================================== 5 | This document explains the choices made and background information 6 | for the internal working of the program. 7 | 8 | The main purpose of this exercise is to create a program that 9 | people can read and understand and improve if they want, giving 10 | ideas and handles to lift computer play of chess up to higher 11 | levels. 12 | 13 | A lot of information about Xiangqi can be found on the internet. 14 | One very helpful document is the ELP document 15 | http://www.csie.ndhu.edu.tw/~sjyen/Papers/2004CCC.pdf 16 | ================================================================== 17 | 18 | Board 19 | ===== 20 | As always it is best to start at the beginning, the board. 21 | The mental picture we use is the Xiangqi-board from the white/red 22 | player perspective and choose a numbering for the fields: 23 | 10 20 30 40 50 60 70 80 90 24 | 9 19 29 39 49 59 69 79 89 25 | 8 18 28 38 48 58 68 78 88 26 | 7 17 27 37 47 57 67 77 87 27 | 6 16 26 36 46 56 66 76 86 28 | 5 15 25 35 45 55 65 75 85 29 | 4 14 24 34 44 54 64 74 84 30 | 3 13 23 33 43 53 63 73 83 31 | 2 12 22 32 42 52 62 72 82 32 | 1 11 21 31 41 51 61 71 81 33 | in practice we can just use a block with 90 fields to represent a board. 34 | 35 | Perhaps it would have been easier to have numbered the fields a little different like 36 | 19 29 39 49 59 69 79 89 99 37 | 18 28 38 48 58 68 78 88 98 38 | 17 27 37 47 57 67 77 87 97 39 | 16 26 36 46 56 66 76 86 96 40 | 15 25 35 45 55 65 75 85 95 41 | 14 24 34 44 54 64 74 84 94 42 | 13 23 33 43 53 63 73 83 93 43 | 12 22 32 42 52 62 72 82 92 44 | 11 21 31 41 51 61 71 81 91 45 | 10 20 30 40 50 60 70 80 90 46 | with this numbering helping in quickly seeing if pieces are on the same line or same row. 47 | (We can use +9 and then compute the multiples of 10 for line and the units for the rows) 48 | 49 | In binary this could translate to a similar numbering 50 | 19 0001 1001 29 0010 1001 ... 99 1001 1001 51 | 18 0001 1000 ... 52 | 17 0001 0111 ... 53 | 16 0001 0110 ... 54 | 15 0001 0101 ... 55 | 14 0001 0100 ... 56 | 13 0001 0011 ... 57 | 12 0001 0010 ... 58 | 11 0001 0001 ... 59 | 10 0001 0000 20 0010 0000 ... 90 1001 0000 60 | Well maybe the program could be rewritten for that, but as the main purpose of this 61 | exercise is to create a program people can understand and read, let's stay on course 62 | for now. 63 | 64 | Pieces 65 | ====== 66 | The players have differently colored pieces. 67 | The color representing red/white is 0 black/blue is 1 68 | 69 | The pieces: 70 | 1 general/king red: swei or shuai black: jiang or tjiang 71 | 2 advisors/guard shi or hse 72 | 2 elephants xiang or hsiang 73 | 2 horses/knights ma 74 | 2 chariots ju or gue 75 | 2 canons pao or pau (red: canon black: catapult) 76 | 5 pawns red: bing black: zu or tsoe 77 | in English notation sometimes S for Soldier is used for a Pawn. 78 | 79 | Representation of the pieces on the board 80 | value name as binary 81 | 2 3 P/S pawn 00000010 00000011 82 | 4 5 C canon 00000100 00000101 83 | 8 9 R chariot/rook 00001000 00001001 84 | 16 17 N/H horse/knight 00010000 00010001 85 | 32 33 E elephant 00100000 00100001 86 | 64 65 G/A advisor 01000000 01000001 87 | 128 129 K king 10000000 10000001 88 | 89 | An empty board is represented by a block of 90 times a 0. 90 | And we now have that the starting position of the game is represented by 91 | 92 | start-board: [ 93 | 8 0 0 2 0 0 3 0 0 9 94 | 16 0 4 0 0 0 0 5 0 17 95 | 32 0 0 2 0 0 3 0 0 33 96 | 64 0 0 0 0 0 0 0 0 65 97 | 128 0 0 2 0 0 3 0 0 129 98 | 64 0 0 0 0 0 0 0 0 65 99 | 32 0 0 2 0 0 3 0 0 33 100 | 16 0 4 0 0 0 0 5 0 17 101 | 8 0 0 2 0 0 3 0 0 9 102 | ] 103 | 104 | Determining the best move 105 | ========================= 106 | The routine to determine the best move will be built after the Negascout algorithm. 107 | Negascout is also termed Principal Variation Search (PVS) 108 | (Also look up the documents for theory about this subject) 109 | 110 | PVS always returns 1 move, even though more moves could have the same calculated value. 111 | Perhaps in Red it is possible or easy to list all of these moves and then we could 112 | select a move randomly from this list of best scoring moves. 113 | 114 | To seed random in Red we need 115 | random/seed now/precise 116 | 117 | iterative-deepening-search searches one ply deeper each time until: 118 | - depth is reached or 119 | - winning moves are found or 120 | - all moves lose 121 | - only one (1) playable move is left 122 | - time is up 123 | lookup-opening-book looks up the information in the opening book 124 | quiescence-search searches on after the last move made within the search depth, 125 | it checks all following capturemoves from both sides to make sure pieces are 126 | not captured back on the next move or pieces are not put on squares where they are 127 | just given away. So the validation does not count a quick win but forgets 128 | the piece is won back. It should be able to handle check moves also. It should not 129 | be possible to have an endless streak of check and capture moves between red and black. 130 | One note is that not every capture move itself will be worthwhile. When this search 131 | is done like that, the program will be forced to make bad captures and conclude that 132 | in the end the total exchange value will be negative. So this will be one improvement for 133 | the todo list. 134 | 135 | More information 136 | ================ 137 | More documentation will be added later or you will find 138 | in the documents for the specific modules of the program. 139 | 140 | ==End== -------------------------------------------------------------------------------- /xiangqi/docs/Xiangqi-hash.txt: -------------------------------------------------------------------------------- 1 | Xiangqi programmed in Red documentation. 2 | ======================================== 3 | 4 | The Hash function 5 | ================= 6 | 7 | We could have made a program like existing programs in C more or less copying 8 | everything, translating to Red or Red/System. We also could have used the commonly 9 | used hash function using the bitboards other programs use. 10 | 11 | But where is the fun in that? 12 | Besides this program doesn't have any bitboard to be used, so here I made a function 13 | according to a different insight. 14 | 15 | Looking at the board, we notice it could be divided into 6 equal parts like this. 16 | 17 | 10 20 30 40 50 60 70 80 90 18 | 9 19 29 39 49 59 69 79 89 19 | 8 18 28 38 48 58 68 78 88 20 | 7 17 27 37 47 57 67 77 87 21 | 6 16 26 36 46 56 66 76 86 22 | 23 | 5 15 25 35 45 55 65 75 85 24 | 4 14 24 34 44 54 64 74 84 25 | 3 13 23 33 43 53 63 73 83 26 | 2 12 22 32 42 52 62 72 82 27 | 1 11 21 31 41 51 61 71 81 28 | 29 | Now we number these sextants 30 | 4 5 6 31 | 1 2 3 32 | 33 | The sextant function. The idea is when a move is done the hash-value should be recalculated 34 | but the way we do this is only for the one or 2 sextants the move is affecting. 35 | } 36 | The idea is we can compute unique numbers for each sextant representing the parts of the board by 37 | multiplying the fieldnumber with the piece on it, and adding these values together for each sextant. 38 | 39 | Because multiplying bigger number takes longer than small ones, it certainly does if I do it manually ;-), 40 | and because we want to profit from some symmetry I came up with the first multiplication-table: 41 | 42 | [ 43 | 1 2 3 4 5 5 4 3 2 1 44 | 11 12 13 14 15 15 14 13 12 11 45 | 21 22 23 24 25 25 24 23 22 21 46 | 47 | 11 12 13 14 15 15 14 13 12 11 48 | 1 2 3 4 5 5 4 3 2 1 49 | 21 22 23 24 25 25 24 23 22 21 50 | 51 | 21 22 23 24 25 25 24 23 22 21 52 | 11 12 13 14 15 15 14 13 12 11 53 | 1 2 3 4 5 5 4 3 2 1 54 | ] 55 | 56 | It is simpler, and probably faster too, to lookup the multiplication factor than computing the value from the 57 | given fieldnumber. 58 | 59 | But it is easily seen that for our red pieces on the board differ by a factor 2, we get problems for 60 | switched pieces on the fields with numbers 1, 2, 4, 12, 24 so I multiplied the rows with a factor of 61 | respectively 1, 3, 5, 7 and 11 to make it more unique. 62 | [ 63 | 1 6 15 28 55 55 28 15 6 1 64 | 11 36 65 98 165 165 98 65 36 11 65 | 21 66 115 168 275 275 168 115 66 21 66 | 67 | 11 36 65 98 165 165 98 65 36 11 68 | 1 6 15 28 55 55 28 15 6 1 69 | 21 66 115 168 275 275 168 115 66 21 70 | 71 | 21 66 115 168 275 275 168 115 66 21 72 | 11 36 65 98 165 165 98 65 36 11 73 | 1 6 15 28 55 55 28 15 6 1 74 | ] 75 | 76 | But now the values are still getting pretty large 77 | (up to 144609 (< 2^18) though in practise the values will be much smaller (< 40272)) 78 | 79 | So we step over to the idea to use the first 15 prime numbers > 5 as multiplication factors. 80 | Now the multiplication factors give unique values for each piece on any place on the board. 81 | Collisions can still occur, I did not check for that. 82 | 83 | Suppose there are all black kings on the squares the maximum value per sextant rises 84 | to 63855 (< 2^17). In practise these values will be much smaller (< 15000) thus fitting 85 | within 16 bits. 86 | 87 | We are now ready to calculate some hash values! 88 | 89 | To shrink the hash code to a smaller unique value a conversion to a 64 base string 90 | is performed. 91 | Personally I think I would have chosen the conversion string to be just 92 | "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/" 93 | but the used one is the 'official' one. 94 | 1 2 3 4 5 6 95 | 0123456789012345678901234567890123456789012345678901234567890123 96 | "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" 97 | 98 | TODO list: Code is needed to store and compare the computed hash values. 99 | -------------------------------------------------------------------------------- /xiangqi/docs/Xiangqi-moves.txt: -------------------------------------------------------------------------------- 1 | Xiangqi programmed in Red documentation. 2 | ======================================== 3 | 4 | The Move generating function 5 | ============================ 6 | 7 | Generating the moves differs from calculating influence of pieces. 8 | A pinned piece can have influence on a field it cannot move to because it is pinned, but the opponent 9 | cannot move their King on a field a pinned piece can see. 10 | 11 | How does the algoritm work? 12 | 13 | for all fields with a piece of color to play 14 | for all moves of the piece 15 | move piece 16 | test position using valid-move? 17 | if valid then 18 | set indicator to mark if enemy king is in check 19 | set indicator position validated or set value 20 | add to move list 21 | undo move piece 22 | next move of this piece until all moves done 23 | next field till end of board 24 | 25 | About testing and adding valid moves to the list. 26 | The function to test and add moves (hence tam) to the list used to be part of the make-move-list function, 27 | but that did not yet compile in Red 0.5.0 Hopefully one day soon this will be possible and the code can be cleaned. 28 | This introduces the declaration of extra variables so this information does not have to be passed 31 times. 29 | Also the call now does not need to be adapted for these extra parameters, so that is a bit of lazy coding here. 30 | 31 | Move formats 32 | ============ 33 | 34 | Perhaps it is of value to have different formats for the moves in the move list? 35 | The standard no is [piece-value m n captured giving-check board-change-value] 36 | Alternatives could be i.e. [m n] or [piece-value m n hash-value-resulting-position] 37 | 38 | Move tables 39 | =========== 40 | Computing a move value largely depends on piece value of pieces on the board. 41 | A piece can have more influence in the game if it is on a better spot. The move tables 42 | provide a rough idea of where generally the pieces have more value to the team. 43 | The tables for this program have been provided by the document 44 | 45 | ELP document 46 | http://www.csie.ndhu.edu.tw/~sjyen/Papers/2004CCC.pdf 47 | -------------------------------------------------------------------------------- /xiangqi/extend/xiangqi-influence.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Computing the influence on the board of Xiangqi aka Chinese Chess" 3 | filename: %xiangqi-influence.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "09-Feb-2015" 7 | ] 8 | ; Needs from moves 9 | red-palace: [31 32 33 41 42 43 51 52 53] 10 | black-palace: [38 39 40 48 49 50 58 59 60] 11 | 12 | get-field-king: function [ 13 | "Find the red(0) or black(1) king on this board" 14 | in-board [block!] 15 | color [integer!] 16 | return: [integer!] 17 | /local field [integer!] 18 | ][ 19 | field: 0 20 | either color = RED [ ; find the red king in his palace 21 | foreach i red-palace [ 22 | if 128 = in-board/:i [ 23 | field: i 24 | return field 25 | ] 26 | ] 27 | ][ ; find the black king in his palace 28 | foreach i black-palace [ 29 | if 129 = in-board/:i [ 30 | field: i 31 | return field 32 | ] 33 | ] 34 | ] 35 | field 36 | ] 37 | piece-color: function [ 38 | piece-value [integer!] 39 | return: [integer!] 40 | ][ 41 | piece-value and 1 42 | ] 43 | ; end needs from moves 44 | ;******************* 45 | ; influence routines 46 | ;******************* 47 | ; influence makes clear where the pieces can go, what pieces and fields are attacked, which pieces and fields are protected and how many times. 48 | ; a king can only move to a place that is not under attack. Because the kings may not see each other it is tempting to have this influence here too, 49 | ; but because the king cannot move out of his own palace this would give a wrong balance in exchanging series, 50 | ; so this restriction will be tested independent in king-sees-king. 51 | ; To have a valid view, also pins need to be taken into account. a pinned piece may not be able to defend another piece or field. 52 | ; influence table and pin information must be analysed together. 53 | ;******************* 54 | influence-board: copy empty-board 55 | 56 | init-influence: does [ 57 | influence-board: copy empty-board 58 | ] 59 | 60 | influence-list: copy [] 61 | 62 | influence-board-red: copy empty-board 63 | influence-board-black: copy empty-board 64 | 65 | init-influence-list: does [ 66 | repeat i 90 [ 67 | append influence-list reduce [i copy []] 68 | ] 69 | influence-board-red: copy empty-board 70 | influence-board-black: copy empty-board 71 | ] 72 | 73 | get-total-influence-value: function [ 74 | return: [integer!] 75 | /local total-influence-value [integer!] 76 | ][ 77 | total-influence-value: 0 78 | repeat i 90 [ 79 | total-influence-value: total-influence-value + influence-board/:i 80 | ] 81 | total-influence-value 82 | ] 83 | 84 | add-influence: func [ 85 | "Add an influence point to the influence board at the given field" 86 | field [integer!] 87 | piece-value [integer!] 88 | from-field-value [integer!] 89 | influence-list? [logic!] 90 | /local pieces [block!] 91 | ][ 92 | influence-board/:field: influence-board/:field + 1 93 | if influence-list? [ 94 | pieces: select influence-list field 95 | append/only pieces reduce [piece-value from-field-value] 96 | ] 97 | ] 98 | 99 | ;********************************** 100 | ; Pin routine done within influence 101 | ;********************************** 102 | DIRECTION-UP: 1 103 | DIRECTION-DOWN: negate 1 104 | DIRECTION-LEFT: negate 10 105 | DIRECTION-RIGHT: 10 106 | 107 | pin-list: copy [] 108 | 109 | init-pin-list: does [ 110 | pin-list: copy [] 111 | ] 112 | 113 | add-pin: function [ 114 | pin-info [block!] 115 | ][ 116 | append/only pin-list pin-info 117 | ] 118 | 119 | ;*********************************** 120 | ; make the influence board per color 121 | ;*********************************** 122 | influence-of-color: function [ 123 | "Compute the influence of the (enemy) pieces" 124 | in-board [block!] 125 | color [integer!] 126 | influence-list? [logic!] 127 | return: [integer!] 128 | /local i [integer!] j [integer!] k [integer!] 129 | piece-value [integer!] piece-moves [block!] over-field [integer!] to-field [integer!] 130 | line [integer!] row [integer!] field-enemy-king [integer!] line-king [integer!] row-king [integer!] 131 | loaded [logic!] done [logic!] pin-direction [integer!] possible-pins [block!] pin-string [string!] 132 | ][ 133 | init-influence 134 | field-enemy-king: get-field-king in-board 1 - color 135 | line-king: ((field-enemy-king - 1) / 10) ; 0 to 8 only to compare same line 136 | row-king: remainder (field-enemy-king - 1) 10 ; not + 1 for only to compare for pin same row 137 | 138 | repeat i 90 [ 139 | piece-value: in-board/:i 140 | if all [0 < piece-value 141 | color = piece-color piece-value ][ 142 | multi-switch piece-value [ 143 | 2 [ ; red-pawn, done separately from the black one because they move opposite way 144 | if 10 > remainder i 10 [ 145 | j: i + 1 146 | add-influence j piece-value i influence-list? 147 | ] 148 | if 5 < remainder i 10 [ 149 | if i > 10 [ j: i - 10 150 | add-influence j piece-value i influence-list?] 151 | if i < 81 [ j: i + 10 152 | add-influence j piece-value i influence-list?] 153 | ] 154 | ] 155 | 3 [ ; black-pawn, done separately from the red one because they move opposite way 156 | if 1 < remainder i 10 [ 157 | j: i - 1 158 | add-influence j piece-value i influence-list? 159 | ] 160 | if 6 > remainder i 10 [ 161 | if i > 10 [ j: i - 10 162 | add-influence j piece-value i influence-list?] 163 | if i < 81 [ j: i + 10 164 | add-influence j piece-value i influence-list?] 165 | ] 166 | ] 167 | 168 | 4 5 [ ; canon, can also (double) pin pieces 169 | ; pin can be if on same line or row as enemy king and the test is only needed in this line 170 | ; canon can jump over own and enemy pieces 171 | line: (i - 1) / 10 ; need for pin and same line for not extending your move onto prev/next line 172 | row: remainder (i - 1) 10 ; only to compare with row-king for pin 173 | pin-direction: 0 174 | if line-king = line [ 175 | either row < row-king [ 176 | pin-direction: DIRECTION-UP 177 | ][ 178 | pin-direction: DIRECTION-DOWN 179 | ] 180 | ] 181 | if row-king = row [ 182 | either line < line-king [ 183 | pin-direction: DIRECTION-RIGHT 184 | ][ 185 | pin-direction: DIRECTION-LEFT 186 | ] 187 | ] 188 | ; left 189 | loaded: done: false 190 | j: i - 10 191 | while [all [j > 0 192 | not done]][ 193 | if loaded [ 194 | add-influence j piece-value i influence-list? 195 | if 0 < in-board/:j [ 196 | done: true 197 | ] 198 | ] 199 | if 0 < in-board/:j [loaded: true] 200 | j: j - 10 201 | ] 202 | ; right 203 | loaded: done: false 204 | j: i + 10 205 | while [all [j < 91 206 | not done]][ 207 | if loaded [ 208 | add-influence j piece-value i influence-list? 209 | if 0 < in-board/:j [ 210 | done: true 211 | ] 212 | ] 213 | if 0 < in-board/:j [loaded: true] 214 | j: j + 10 215 | ] 216 | ; up 217 | loaded: done: false 218 | j: i + 1 219 | line: (i - 1) / 10 220 | while [all [j < 91 221 | not done 222 | line = ((j - 1) / 10)]][ 223 | if loaded [ 224 | add-influence j piece-value i influence-list? 225 | if 0 < in-board/:j [ 226 | done: true 227 | ] 228 | ] 229 | if 0 < in-board/:j [loaded: true] 230 | j: j + 1 231 | ] 232 | ; down 233 | loaded: done: false 234 | j: i - 1 235 | line: (i - 1) / 10 236 | while [all [j > 0 237 | not done 238 | line = ((j - 1) / 10)]][ 239 | if loaded [ 240 | add-influence j piece-value i influence-list? 241 | if 0 < in-board/:j [ 242 | done: true 243 | ] 244 | ] 245 | if 0 < in-board/:j [loaded: true] 246 | j: j - 1 247 | ] 248 | ; If possible then check the pins for canon 249 | if pin-direction <> 0 [ 250 | possible-pins: copy [] 251 | pin-string: copy "" 252 | j: i + pin-direction 253 | while [j <> field-enemy-king][ 254 | if 0 < in-board/:j [ 255 | either color = (BLACK and in-board/:j) [ 256 | append pin-string "o" 257 | ][ 258 | append pin-string "x" 259 | append/only possible-pins reduce [in-board/:j j piece-value i] 260 | ] 261 | ] 262 | j: j + pin-direction 263 | ] 264 | ; canon an enemy piece is pinned if exactly two pieces are between canon and king 265 | if all [2 = length? pin-string 266 | 0 < length? possible-pins][ 267 | foreach pin possible-pins [ 268 | add-pin pin 269 | ] 270 | ] 271 | ] 272 | ] 273 | 274 | 8 9 [ ; chariot, rook, can also pin pieces 275 | ; pin can be if on same line or row as enemy king and the test is only needed in this line 276 | ; rook cannot jump over own pieces like canon 277 | line: (i - 1) / 10 ; need for pin and same line for not extending your move onto prev/next line 278 | row: remainder (i - 1) 10 ; only to compare with row-king for pin 279 | pin-direction: 0 280 | if line-king = line [ 281 | either row < row-king [ 282 | pin-direction: DIRECTION-UP 283 | ][ 284 | pin-direction: DIRECTION-DOWN 285 | ] 286 | ] 287 | if row-king = row [ 288 | either line < line-king [ 289 | pin-direction: DIRECTION-RIGHT 290 | ][ 291 | pin-direction: DIRECTION-LEFT 292 | ] 293 | ] 294 | ; left 295 | j: i - 10 296 | while [j > 0][ 297 | add-influence j piece-value i influence-list? 298 | if 0 < in-board/:j [ 299 | if piece-value <> in-board/:j [ ; continue through own chariot, else stop 300 | j: 0 301 | ] 302 | ] 303 | j: j - 10 304 | ] 305 | ; right 306 | j: i + 10 307 | while [j < 91][ 308 | add-influence j piece-value i influence-list? 309 | if 0 < in-board/:j [ 310 | if piece-value <> in-board/:j [ ; continue through own chariot, else stop 311 | j: 91 312 | ] 313 | ] 314 | j: j + 10 315 | ] 316 | ; up 317 | j: i + 1 318 | ;line: (i - 1) / 10 319 | while [all [line = ((j - 1) / 10) 320 | j < 91 ]][ 321 | add-influence j piece-value i influence-list? 322 | if 0 < in-board/:j [ 323 | if piece-value <> in-board/:j [ ; continue through own chariot, else stop 324 | j: j + 10 325 | ] 326 | ] 327 | j: j + 1 328 | ] 329 | ; down 330 | j: i - 1 331 | ;line: (i - 1) / 10 332 | while [all [line = ((j - 1) / 10) 333 | j > 0 ]][ 334 | add-influence j piece-value i influence-list? 335 | if 0 < in-board/:j [ 336 | if piece-value <> in-board/:j [ ; continue through own chariot, else stop 337 | j: j - 10 338 | ] 339 | ] 340 | j: j - 1 341 | ] 342 | ; If possible then check the pins for chariot, rook 343 | if pin-direction <> 0 [ 344 | ; the special check if we stay on the same line is not needed her because we already know 345 | possible-pins: copy [] 346 | pin-string: copy "" 347 | j: i + pin-direction 348 | while [j <> field-enemy-king][ 349 | if 0 < in-board/:j [ 350 | either color = (BLACK and in-board/:j) [ 351 | append pin-string "o" 352 | ][ 353 | append pin-string "x" 354 | append/only possible-pins reduce [in-board/:j j piece-value i] 355 | ] 356 | ] 357 | j: j + pin-direction 358 | ] 359 | ;rook if own pieces present in pin-string, no pins else if only 1 x then add pin 360 | if pin-string = "x" [ 361 | add-pin possible-pins/1 362 | ] 363 | ] 364 | ] 365 | 366 | 16 17 [ ; knight, can also pin pieces(!) 367 | line: 1 + ((i - 1) / 10) 368 | row: 1 + remainder (i - 1) 10 369 | ; left -10 (-10 +/- 1) 370 | if line > 2 [ ; else too close to the border to go that way 371 | j: i - 10 372 | either 0 = in-board/:j [ ; not blocked 373 | if row > 1 [ 374 | j: i - 21 375 | add-influence j piece-value i influence-list? 376 | ] 377 | if row < 10 [ 378 | j: i - 19 379 | add-influence j piece-value i influence-list? 380 | ] 381 | ][ ; check if the knight pins the blocking piece 382 | if any [i - 21 = field-enemy-king 383 | i - 19 = field-enemy-king][ 384 | add-pin reduce [in-board/:j j piece-value i] 385 | ] 386 | ] 387 | ] 388 | ; right 389 | if line < 8 [ ; else too close to the border to go that way 390 | j: i + 10 391 | either 0 = in-board/:j [ ; not blocked 392 | if row > 1 [ 393 | j: i + 19 394 | add-influence j piece-value i influence-list? 395 | ] 396 | if row < 10 [ 397 | j: i + 21 398 | add-influence j piece-value i influence-list? 399 | ] 400 | ][ ; check if the knight pins the blocking piece 401 | if any [i + 21 = field-enemy-king 402 | i + 19 = field-enemy-king][ 403 | add-pin reduce [in-board/:j j piece-value i] 404 | ] 405 | ] 406 | ] 407 | ; up 408 | if row < 9 [ 409 | j: i + 1 410 | either 0 = in-board/:j [ ; not blocked 411 | if line > 1 [ 412 | j: i - 8 413 | add-influence j piece-value i influence-list? 414 | ] 415 | if line < 9 [ 416 | j: i + 12 417 | add-influence j piece-value i influence-list? 418 | ] 419 | ][ ; check if the knight pins the blocking piece 420 | if any [i - 8 = field-enemy-king 421 | i + 12 = field-enemy-king][ 422 | add-pin reduce [in-board/:j j piece-value i] 423 | ] 424 | ] 425 | ] 426 | ; down 427 | if row > 2 [ 428 | j: i - 1 429 | either 0 = in-board/:j [ ; not blocked 430 | if line > 1 [ 431 | j: i - 12 432 | add-influence j piece-value i influence-list? 433 | ] 434 | if line < 9 [ 435 | j: i + 8 436 | add-influence j piece-value i influence-list? 437 | ] 438 | ][ ; check if the knight pins the blocking piece 439 | if any [i - 12 = field-enemy-king 440 | i + 8 = field-enemy-king][ 441 | add-pin reduce [in-board/:j j piece-value i] 442 | ] 443 | ] 444 | ] 445 | ] 446 | 447 | 32 33 [ ; elephant, has no direct influence on giving check, but general influence also considered here 448 | if element-in-collection i elephant-moves [ 449 | piece-moves: select elephant-moves i 450 | foreach move piece-moves [ 451 | over-field: move/1 452 | to-field: move/2 453 | if 0 = in-board/:over-field [ 454 | add-influence to-field piece-value i influence-list? 455 | ] 456 | ] 457 | ] 458 | ] 459 | 460 | 64 65 [ ; advisor, just add the influence 461 | if element-in-collection i advisor-moves [ 462 | piece-moves: select advisor-moves i 463 | foreach move piece-moves [ 464 | add-influence move piece-value i influence-list? 465 | ] 466 | ] 467 | ] 468 | 469 | 128 129 [ ; king, just add the influence 470 | if element-in-collection i king-moves [ 471 | piece-moves: select king-moves i 472 | foreach move piece-moves [ 473 | add-influence move piece-value i influence-list? 474 | ] ] ] ] ] ] 475 | 476 | ;return the total influence computed 477 | get-total-influence-value 478 | ] 479 | 480 | analyse-influence: function [ 481 | "Make influence boards and a list of pieces that can go to the fields" 482 | board [block!] 483 | ][ 484 | init-influence-list 485 | influence-of-color board 1 true 486 | influence-board-red: copy influence-board 487 | influence-of-color board 0 true 488 | influence-board-black: copy influence-board 489 | ; remember that the pieces still may be pinned and 490 | ; are not actually defending or attacking other positions! 491 | ; also moving one piece may pin the next 492 | ] 493 | -------------------------------------------------------------------------------- /xiangqi/extend/xiangqi-pins.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Get information on pinned pieces on the board of Xiangqi aka Chinese Chess" 3 | filename: %xiangqi-pins.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "09-Feb-2015" 7 | ] 8 | 9 | ;****************************** 10 | ; Get the pinned pieces 11 | ;****************************** 12 | horse-from-king: [ 13 | 31 [21 [12] 32 [23 43] 41 [52]] 14 | 32 [22 [11 13] 33 [24 44] 42 [51 53]] 15 | 33 [23 [12 14] 34 [25 45] 42 [51 53] 32 [21 41]] 16 | 41 [31 [22] 42 [33 53] 51 [62]] 17 | 42 [32 [21 23] 43 [34 54] 52 [61 63]] 18 | 43 [33 [22 24] 44 [35 55] 53 [62 64] 42 [31 51]] 19 | 51 [41 [32] 52 [43 63] 61 [72]] 20 | 52 [42 [31 33] 53 [44 64] 62 [71 73]] 21 | 53 [43 [32 34] 54 [45 65] 63 [72 74] 52 [41 61]] 22 | 38 [28 [17 19] 37 [26 46] 48 [57 59] 39 [30 50]] 23 | 39 [29 [18 20] 38 [27 47] 49 [58 60]] 24 | 40 [30 [19] 39 [28 48] 50 [59]] 25 | 48 [38 [27 29] 47 [36 56] 58 [67 69] 49 [40 60]] 26 | 49 [39 [28 30] 48 [37 57] 59 [68 70]] 27 | 50 [40 [29] 49 [38 58] 60 [69]] 28 | 58 [48 [37 39] 57 [46 66] 68 [77 79] 59 [50 70]] 29 | 59 [49 [38 40] 58 [37 67] 69 [78 80]] 30 | 60 [50 [39] 59 [48 68] 70 [79]] 31 | ] 32 | 33 | pin-list: copy [] 34 | 35 | clear-pin-list: does [ 36 | pin-list: copy [] 37 | ] 38 | 39 | get-pins: function [ 40 | in-board [block!] 41 | color [integer!] 42 | return: [integer!] 43 | /full ; Also get 'pinned' enemy pieces, these are enemy pieces that can be moved to set a check by the pinning enemy piece of. 44 | /local own-king-pos [integer!] 45 | other-king-pos [integer!] 46 | kings-row [integer!] 47 | field [integer!] 48 | field-value [integer!] 49 | steps [block!] 50 | down-limit [integer!] 51 | up-limit [integer!] 52 | own-color [logic!] 53 | ][ 54 | clear-pin-list 55 | own-king-pos: get-field-king in-board color 56 | other-king-pos: get-field-king in-board 1 - color 57 | 58 | ; pawn, elephant, advisor cannot pin other pieces. 59 | ; check horse 60 | horse-fields: select horse-from-king own-king-pos 61 | ; now we have possible blocks 62 | foreach [jump-over from-fields] horse-fields [ 63 | if 0 < in-board/:jump-over [ ; a piece that can be pinned by a horse 64 | own-color: not (BLACK = (color xor (BLACK and field-value))) 65 | foreach field from-fields [ 66 | field-value: in-board/:field 67 | if all [KNIGHT = (KNIGHT and field-value) 68 | BLACK = (color xor (BLACK and field-value)) ][ 69 | ; add pin to pin-list 70 | if any [full ; full refinement 71 | own-color ][ ; own colored piece is pinned 72 | append/only pin-list reduce [in-board/:jump-over jump-over field-value field] 73 | ] 74 | ] 75 | ] 76 | ] 77 | ] 78 | 79 | ; check rook 80 | ; to the left, to the right, down and up 81 | steps: [-10 10 -1 1] 82 | foreach step steps [ 83 | switch/default step [ 84 | case -1 1 [ 85 | switch own-king-pos [ 86 | case 31 32 33 38 39 40 [ 87 | down-limit: 30 88 | up-limit: 41 89 | ] 90 | case 41 42 43 48 49 50 [ 91 | down-limit: 40 92 | up-limit: 51 93 | ] 94 | case 51 52 53 58 59 60 [ 95 | down-limit: 50 96 | up-limit: 61 97 | ] 98 | ] 99 | ] 100 | ][ 101 | down-limit: 0 102 | up-limit: 91 103 | ] 104 | field: own-king-pos + step 105 | number-pieces: 0 106 | remember-pins: [0 0 false] 107 | while [ any [field > down-limit 108 | field < up-limit ]] [ 109 | field-value: in-board/:field 110 | if 0 < field-value [ 111 | own-color: not (BLACK = (color xor (BLACK and field-value))) 112 | if all [1 = number-pieces 113 | ROOK = (ROOK and field-value) 114 | BLACK = (color xor (BLACK and field-value)) ][ 115 | if any [full 116 | remember-pins/3][ 117 | append/only pin-list reduce [remember-pins/1 remember-pins/2 field-value field] 118 | ] 119 | ] 120 | remember-pins: reduce [field-value field own-color] 121 | number-pieces: number-pieces + 1 122 | ] 123 | field: field + step 124 | ] 125 | ] 126 | 127 | ; check canon 128 | ; to the left, to the right, down and up 129 | steps: [-10 10 -1 1] 130 | foreach step steps [ 131 | switch/default step [ 132 | case -1 1 [ 133 | switch own-king-pos [ 134 | case 31 32 33 38 39 40 [ 135 | down-limit: 30 136 | up-limit: 41 137 | ] 138 | case 41 42 43 48 49 50 [ 139 | down-limit: 40 140 | up-limit: 51 141 | ] 142 | case 51 52 53 58 59 60 [ 143 | down-limit: 50 144 | up-limit: 61 145 | ] 146 | ] 147 | ] 148 | ][ 149 | down-limit: 0 150 | up-limit: 91 151 | ] 152 | field: own-king-pos + step 153 | number-pieces: 0 154 | remember-pins: [0 0 false] 155 | while [ any [field > down-limit 156 | field < up-limit ]] [ 157 | field-value: in-board/:field 158 | if 0 < field-value [ 159 | if all [2 = number-pieces 160 | CANON = (CANON and field-value) 161 | BLACK = (color xor (BLACK and field-value)) ][ 162 | foreach [fldval fld ownpc] remember-pins [ 163 | if any [full 164 | ownpc][ 165 | append/only pin-list reduce [fldval fld field-value field] 166 | ] 167 | ] 168 | either 0 = remember-pins/1 [ 169 | remember-pins: reduce [field-value field own-color] 170 | ][ 171 | append remember-pins reduce [field-value field own-color] 172 | ] 173 | number-pieces: number-pieces + 1 174 | ] 175 | field: field + step 176 | ] 177 | ] 178 | 179 | ; other king, king can pin other pieces from moving out of the way. 180 | 181 | if any [ all [ found? find [31 32 33 38 39 40] own-king-pos 182 | found? find [31 32 33 38 39 40] other-king-pos] 183 | all [ found? find [41 42 43 48 49 50] own-king-pos 184 | found? find [41 42 43 48 49 50] other-king-pos] 185 | all [ found? find [51 52 53 58 59 60] own-king-pos 186 | found? find [51 52 53 58 59 60] other-king-pos]][ 187 | down-limit: min own-king-pos other-king-pos 188 | up-limit: max own-king-pos other-king-pos 189 | number-pieces: 0 190 | remember-pins: [0 0 false] 191 | field: down-limit + 1 192 | while [field < up-limit][ 193 | field-value: in-board/:field 194 | if 0 < field-value [ 195 | own-color: not (BLACK = (color xor (BLACK and field-value))) 196 | remember-pins: reduce [field-value field own-color] 197 | number-pieces: number-pieces + 1 198 | ] 199 | field: field + 1 200 | ] 201 | if 1 = number-pieces [ 202 | if any [full 203 | own-color][ 204 | append/only pin-list reduce [remember-pins/1 remember-pins/2 KING + color other-king-pos] 205 | ] 206 | ] 207 | ] 208 | return true 209 | ] -------------------------------------------------------------------------------- /xiangqi/extend/xiangqi-pvs.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Principle Variantion Search for Chess Games" 3 | filename: %xiangqi-pvs.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "25-Mar-2015" 7 | needs: "Red 0.5.1" 8 | ] 9 | ;**************************************************************** 10 | ; Routines Principle Variation Search for fail hard and fail soft 11 | ;**************************************************************** 12 | ;principal-variation-search: :principal-variation-search-fail-hard 13 | ;principal-variation-search: :principal-variation-search-fail-soft 14 | ;principal-variation-search: :pvs-fail-hard 15 | ;principal-variation-search: :pvs-fail-soft 16 | 17 | ;**************************************************************** 18 | ; Principle Variation Search for fail hard 19 | ;**************************************************************** 20 | ; Temp put back in best-move so compare with that before using this 21 | principal-variation-search-fail-hard: function [ 22 | in-board [block!] 23 | color [integer!] 24 | alpha [integer!] 25 | beta [integer!] 26 | depth [integer!] 27 | variant [block!] 28 | base [logic!] 29 | return: [integer!] 30 | /local 31 | search-pv [logic!] 32 | i [integer!] 33 | j [integer!] 34 | piece-value [integer!] 35 | captured [integer!] 36 | pvs-move-list [block!] 37 | work-move-list [block!] 38 | move [block!] 39 | move-length [integer!] 40 | quiescence-result [integer!] 41 | idx [integer!] 42 | ][ 43 | if debug [ 44 | print "function: principal-variation-search fail hard" 45 | print ["color:" color] 46 | print ["depth:" depth] 47 | print ["Alpha:" alpha] 48 | print ["Beta :" beta] 49 | ] 50 | 51 | if 0 = depth [ 52 | if logging [ 53 | add-log-data "Quiescence search for variant" 54 | add-log-data form variant 55 | ] 56 | ; Required search depth is reached, 57 | ; so not expanding into more moves by the current player 58 | quiescence-result: quiescence-search in-board color alpha beta 59 | return quiescence-result 60 | ] 61 | 62 | search-pv: true 63 | 64 | either base [ ; Moves made in calling function, we can use a copy now 65 | pvs-move-list: read-ids-move-list 66 | ][ 67 | pvs-move-list: make-move-list in-board color 68 | ] 69 | 70 | if 0 = length? pvs-move-list [ 71 | ; no moves found 72 | return MINUS-INFINITY ; lost 73 | ] 74 | 75 | if 1 = length? pvs-move-list [ 76 | ; one move found, when in base call this will be the only move playable 77 | ; if not this move may be in a better variant than another move so still search options. 78 | if base [ 79 | return 1 ; It is the only move so any value between MINUS-INFINITY and INFINITY would do. 80 | ] 81 | ] 82 | 83 | idx: 0 84 | forall pvs-move-list [ 85 | idx: idx + 1 86 | ; First get some information on the move 87 | move: first pvs-move-list 88 | move-length: length? move 89 | move-value: move/:move-length 90 | 91 | ; Only do work on moves that do not have a losing score yet. 92 | either MINUS-INFINITY < move-value [ 93 | 94 | ; Play the move 95 | i: move/2 96 | j: move/3 97 | piece-value: in-board/:i 98 | in-board/:i: 0 99 | captured: in-board/:j 100 | in-board/:j: piece-value 101 | variant: append/only variant move 102 | 103 | either search-pv [ 104 | if debug [print "search-pv"] 105 | score: negate principal-variation-search-fail-hard in-board 1 - color negate beta negate alpha depth - 1 variant false 106 | ][ 107 | if debug [print "not search-pv"] 108 | score: negate principal-variation-search-fail-hard in-board 1 - color negate (alpha - 1) negate alpha depth - 1 variant false 109 | if score > alpha [ ; in fail-soft ... && score < beta is common practise 110 | print "score > alpha" 111 | score: negate principal-variation-search-fail-hard in-board 1 - color negate beta negate alpha depth - 1 variant false ; re-search 112 | ] 113 | ] 114 | 115 | ; Undo the move 116 | in-board/:i: piece-value 117 | in-board/:j: captured 118 | 119 | ; variant: head clear last variant 120 | if base [ 121 | move: append copy move score 122 | change-ids-move-list idx move 123 | ] 124 | ; forall does not need a next to loop thru all possible values 125 | ; test score 126 | if score >= beta [ 127 | if logging [ 128 | add-log-data "Fail hard Beta-cut-off" 129 | add-log-data form variant 130 | add-log-data form reduce ["Beta: " beta "Score: " score] 131 | ] 132 | variant: head clear last variant 133 | return beta ; fail-hard beta-cutoff 134 | ] 135 | if score > alpha [ ; Perhaps this should read if score >= alpha 136 | if logging [ 137 | add-log-data "Improved score found" 138 | add-log-data form variant 139 | add-log-data form reduce ["Alpha: " alpha "Score: " score] 140 | ] 141 | alpha: score ; alpha acts like max in MiniMax 142 | search-pv: false ; it is recommend to set search-pv outside the score > alpha condition. 143 | ] 144 | variant: head clear last variant 145 | ][ 146 | ; score is another MINUS-INFINITY 147 | append move MINUS-INFINITY 148 | change-ids-move-list idx move 149 | ] 150 | ] 151 | return alpha ; fail-hard 152 | ] 153 | 154 | ;**************************************************************** 155 | ; Principle Variation Search for fail soft 156 | ;**************************************************************** 157 | ;Call from root: 158 | ; 159 | ;rootscore: principal-variation-search-fail-soft MINUS-INFINITY INFINITY depth 160 | 161 | principal-variation-search-fail-soft: function [ 162 | in-board [block!] 163 | color [integer!] 164 | alpha [integer!] 165 | beta [integer!] 166 | depth [integer!] 167 | return: [integer!] 168 | /local 169 | score [integer!] 170 | bestscore [integer!] 171 | ][ 172 | if debug [ 173 | print "function: principal-variation-search fail soft" 174 | print ["color:" color] 175 | print ["depth:" depth] 176 | print ["Alpha:" alpha] 177 | print ["Beta :" beta] 178 | ] 179 | 180 | if depth <= 0 [ 181 | ; Search depth is reached, so not expanding into more moves by the current player 182 | return quiescence-search in-board color alpha beta 183 | ] 184 | 185 | ; using fail soft with negamax: 186 | ; Play first move 187 | 188 | bestscore: negate principal-variation-search-fail-soft in-board 1 - color negate beta negate alpha depth - 1 189 | ; Undo first move 190 | 191 | if bestscore > alpha [ 192 | if bestscore >= beta [ 193 | return bestscore 194 | ] 195 | alfa: bestscore 196 | ] 197 | 198 | forall remaining moves [ 199 | make move 200 | ; Here call the alpha-beta or zero-window-search function 201 | score: negate principal-variation-search-fail-soft in-board 1 - color negate (alpha + 1) negate alpha depth - 1 202 | if all [score > alfa 203 | score < beta ][ 204 | ; research with window [alfa beta] 205 | score: negate principal-variation-search-fail-soft in-board 1 - color negate beta negate alpha depth - 1 206 | if score > alfa [ 207 | alfa: score 208 | ] 209 | ] 210 | unmake move 211 | if score > bestscore [ 212 | if score >= beta [ 213 | return score 214 | ] 215 | bestscore: score 216 | ] 217 | ] 218 | 219 | return bestscore 220 | ] -------------------------------------------------------------------------------- /xiangqi/extend/xiangqi-validate.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Validate input for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-validate.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.2 6 | date: "19-Feb-2015" 7 | testfile: "Using file %test/xiangqi-validate-test.red" 8 | functions-description: { 9 | functions to be called: 10 | - validate-board 11 | input: board 12 | output: boolean 13 | } 14 | red-version: "Needs Red 0.5.0" 15 | needs: "%xiangqi-common.red #include via main program or testprogram" 16 | ] 17 | 18 | comment { 19 | Known issue: at the moment *Compiled* Red does not handle multiple choices in a switch correctly 20 | This was not an issue while testing in the interpreter. 21 | 22 | Until this will be fixed this is solved by using my own multi-switch and the function 23 | element-in-collection. 24 | } 25 | 26 | ;*********************** 27 | ; Validation of position 28 | ;*********************** 29 | validate-board: func [ 30 | "Determine if the position of pieces on the board is legitimate" 31 | board [block!] 32 | return: [logic!] 33 | /local red-king [integer!] black-king [integer!] 34 | red-king-line [integer!] black-king-line [integer!] red-king-row [integer!] black-king-row [integer!] 35 | red-king-field [integer!] black-king-field [integer!] 36 | red-advisor [integer!] red-elephant [integer!] red-canon [integer!] red-knight [integer!] red-pawn [integer!] red-chariot [integer!] 37 | black-advisor [integer!] black-elephant [integer!] black-canon [integer!] black-knight [integer!] black-pawn [integer!] black-chariot [integer!] 38 | j [integer!] sum [integer!] share-info [logic!] 39 | ][ 40 | share-info: any [ debug 41 | report-info ] 42 | if 90 <> length? board [ 43 | if share-info [ 44 | info-area/code: 1 45 | info-area/description: reduce ["Board has wrong number of fields: " length? board] 46 | ] 47 | return false 48 | ] 49 | red-king: red-advisor: red-chariot: red-elephant: red-knight: red-canon: red-pawn: 0 50 | black-king: black-advisor: black-chariot: black-elephant: black-knight: black-canon: black-pawn: 0 51 | repeat i 90 [ 52 | either element-in-collection board/:i [0 2 3 4 5 8 9 16 17 32 33 64 65 128 129] [ 53 | switch board/:i [ 54 | 0 [ ] 55 | 2 [ red-pawn: red-pawn + 1 56 | ; Red pawns must be on other side of the board or on start position or one field advanced from the start 57 | if element-in-collection i [ 58 | 1 2 3 59 | 11 12 13 14 15 60 | 21 22 23 61 | 31 32 33 34 35 62 | 41 42 43 63 | 51 52 53 54 55 64 | 61 62 63 65 | 71 72 73 74 75 66 | 81 82 83 ][ 67 | if share-info [ 68 | info-area/code: 2 69 | info-area/description: reduce ["Red Pawn found on faulty position: " i] 70 | ] 71 | return false 72 | ] 73 | ] 74 | 3 [ black-pawn: black-pawn + 1 75 | ; Black pawns must be on other side of the board or on start position or one field advanced from the start 76 | if element-in-collection i [ 77 | 8 9 10 78 | 16 17 18 19 20 79 | 28 29 30 80 | 36 37 38 39 40 81 | 48 49 50 82 | 56 57 58 59 60 83 | 68 69 70 84 | 76 77 78 79 80 85 | 88 89 90 ][ 86 | if share-info [ 87 | info-area/code: 3 88 | info-area/description: reduce ["Black Pawn found on faulty position: " i] 89 | ] 90 | return false 91 | ] 92 | ] 93 | 4 [ red-canon: red-canon + 1 ] 94 | 5 [ black-canon: black-canon + 1 ] 95 | 8 [ red-chariot: red-chariot + 1 ] 96 | 9 [ black-chariot: black-chariot + 1 ] 97 | 16 [ red-knight: red-knight + 1 ] 98 | 17 [ black-knight: black-knight + 1 ] 99 | 32 [ red-elephant: red-elephant + 1 100 | ; Elephant can only be on 7 fields 101 | if not element-in-collection i [3 21 25 43 61 65 83][ 102 | if share-info [ 103 | info-area/code: 4 104 | info-area/description: reduce ["Red Elephant found on faulty position: " i] 105 | ] 106 | return false 107 | ] 108 | ] 109 | 33 [ black-elephant: black-elephant + 1 110 | ; Elephant can only be on 7 fields 111 | if not element-in-collection i [8 26 30 48 66 70 88][ 112 | if share-info [ 113 | info-area/code: 5 114 | info-area/description: reduce ["Black Elephant found on faulty position: " i] 115 | ] 116 | return false 117 | ] 118 | ] 119 | 64 [ red-advisor: red-advisor + 1 120 | ; Advisor in palace on allowed fields 121 | if not element-in-collection i [31 33 42 51 53][ 122 | if share-info [ 123 | info-area/code: 6 124 | info-area/description: reduce ["Red Advisor found on faulty position: " i] 125 | ] 126 | return false 127 | ] 128 | ] 129 | 65 [ black-advisor: black-advisor + 1 130 | ; Advisor in palace on allowed fields 131 | if not element-in-collection i [38 40 49 58 60][ 132 | if share-info [ 133 | info-area/code: 7 134 | info-area/description: reduce ["Black Advisor found on faulty position: " i] 135 | ] 136 | return false 137 | ] 138 | ] 139 | 128 [ red-king-field: i 140 | red-king: red-king + 1 141 | red-king-line: 1 + ((i - 1) / 10) 142 | red-king-row: 1 + remainder (i - 1) 10 143 | ; King in his palace 144 | if not element-in-collection i [31 32 33 41 42 43 51 52 53][ 145 | if share-info [ 146 | info-area/code: 8 147 | info-area/description: reduce ["Red King found on faulty position: " i] 148 | ] 149 | return false 150 | ] 151 | ] 152 | 129 [ black-king-field: i 153 | black-king: black-king + 1 154 | black-king-line: 1 + ((i - 1) / 10) 155 | black-king-row: 1 + remainder (i - 1) 10 156 | ; King in his palace 157 | if not element-in-collection i [38 39 40 48 49 50 58 59 60][ 158 | if share-info [ 159 | info-area/code: 9 160 | info-area/description: reduce ["Black King found on faulty position: " i] 161 | ] 162 | return false 163 | ] 164 | ] 165 | ] 166 | ] [ ; Former switch/default, unknown piece on the board 167 | if share-info [ 168 | info-area/code: 10 169 | info-area/description: reduce ["Unknown piece " board/:i " found on field: " i] 170 | ] 171 | return false 172 | ] 173 | ] 174 | 175 | if any [ red-king <> 1 176 | black-king <> 1 177 | red-king-line > 6 178 | red-king-line < 4 179 | black-king-line > 6 180 | black-king-line < 4 181 | red-king-row > 3 182 | black-king-row < 8 183 | red-advisor > 2 184 | black-advisor > 2 185 | red-elephant > 2 186 | black-elephant > 2 187 | red-knight > 2 188 | black-knight > 2 189 | red-chariot > 2 190 | black-chariot > 2 191 | red-canon > 2 192 | black-canon > 2 193 | red-pawn > 5 194 | black-pawn > 5 195 | ][ 196 | if share-info [ 197 | info-area/code: 11 198 | info-area/description: reduce ["Incorrect number of pieces found"] 199 | ] 200 | return false 201 | ] 202 | ; red pawn maximum of 1 pawn in [4 5], [24 25], [44 45], [64 65], [84 85] 203 | if 1 < red-pawn [ ; no use of testing for doubles if only 1 red pawn present 204 | if any [ all [ 2 = board/4 205 | 2 = board/5 ] 206 | all [ 2 = board/24 207 | 2 = board/25 ] 208 | all [ 2 = board/44 209 | 2 = board/45 ] 210 | all [ 2 = board/64 211 | 2 = board/65 ] 212 | all [ 2 = board/84 213 | 2 = board/85 ] ] [ 214 | if share-info [ 215 | info-area/code: 12 216 | info-area/description: reduce ["Doubled red pawn found where not allowed"] 217 | ] 218 | return false 219 | ] 220 | ] 221 | ; black pawn maximum of 1 pawn in [6 7], [26 27], [46 47], [66 67], [86 87] 222 | if 1 < black-pawn [ ; no use of testing for doubles if only 1 black pawn present 223 | if any [ all [ 3 = board/6 224 | 3 = board/7 ] 225 | all [ 3 = board/26 226 | 3 = board/27 ] 227 | all [ 3 = board/46 228 | 3 = board/47 ] 229 | all [ 3 = board/66 230 | 3 = board/67 ] 231 | all [ 3 = board/86 232 | 3 = board/87 ] ] [ 233 | if share-info [ 234 | info-area/code: 13 235 | info-area/description: reduce ["Doubled black pawn found where not allowed"] 236 | ] 237 | return false 238 | ] 239 | ] 240 | 241 | if red-king-line = black-king-line [ 242 | sum: 0 243 | j: red-king-field + 1 244 | while [ all [ sum = 0 245 | j <> black-king-field]][ 246 | sum: sum + board/:j 247 | j: j + 1 248 | ] 249 | if sum = 0 [ 250 | if share-info [ 251 | info-area/code: 14 252 | info-area/description: reduce ["The two Kings can see each other."] 253 | ] 254 | return false 255 | ] 256 | ] 257 | true 258 | ] -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Advisor_TB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Advisor_TB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Advisor_TR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Advisor_TR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Advisor_WB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Advisor_WB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Advisor_WR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Advisor_WR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Cannon_TB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Cannon_TB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Cannon_TR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Cannon_TR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Cannon_WB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Cannon_WB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Cannon_WR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Cannon_WR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Chariot_TB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Chariot_TB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Chariot_TR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Chariot_TR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Chariot_WB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Chariot_WB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Chariot_WR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Chariot_WR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Elephant_TB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Elephant_TB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Elephant_TR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Elephant_TR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Elephant_WB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Elephant_WB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Elephant_WR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Elephant_WR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_General_TB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_General_TB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_General_TR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_General_TR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_General_WB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_General_WB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_General_WR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_General_WR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Horse_TB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Horse_TB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Horse_TR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Horse_TR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Horse_WB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Horse_WB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Horse_WR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Horse_WR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Soldier_TB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Soldier_TB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Soldier_TR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Soldier_TR.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Soldier_WB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Soldier_WB.png -------------------------------------------------------------------------------- /xiangqi/images/Xiangqi_Soldier_WR.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/iArnold/Xiangqi/a16d46878e8a354583be0524055c0f1b09698e29/xiangqi/images/Xiangqi_Soldier_WR.png -------------------------------------------------------------------------------- /xiangqi/test/xiangqi-best-move-test.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Test iterative deepening search for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-best-move-test.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "19-Mrt-2015" 7 | red-version: "Needs Red 0.5.0" 8 | ] 9 | 10 | #include %../utils/xiangqi-helper-functions.red 11 | #include %../xiangqi-common.red 12 | #include %../xiangqi-debug-log.red 13 | #include %../xiangqi-move-common.red 14 | #include %../xiangqi-evaluate.red 15 | #include %../xiangqi-moves.red 16 | #include %../xiangqi-best-move.red 17 | #include %../xiangqi-open.red 18 | #include %../xiangqi-hash.red 19 | #include %../xiangqi-convertions.red 20 | #include %../../bind/C-library/input-output.red 21 | 22 | set-logging-values true 23 | set-logging-values/list true 24 | set-logging-values/board true 25 | set-logging-values/moves true 26 | 27 | ;play-board: copy start-board 28 | ;play-board: [ 29 | ; 0 0 0 0 0 0 0 0 0 0 30 | ; 0 0 0 0 0 0 0 0 0 0 31 | ; 0 0 0 0 0 0 0 0 0 0 32 | ; 8 0 0 0 0 0 0 0 0 0 33 | ;128 0 0 0 0 0 0 0 0 0 34 | ; 0 0 0 0 0 0 0 0 0 129 35 | ; 8 0 0 2 0 0 0 0 0 0 36 | ; 0 0 0 0 0 0 0 0 0 0 37 | ; 0 0 0 0 0 0 0 0 0 0 38 | ;] 39 | ;best-move-is: iterative-deepening-search play-board 0 2 40 | 41 | play-board: [ 42 | 0 0 0 0 0 0 0 0 0 0 43 | 0 0 0 0 0 0 0 0 0 0 44 | 0 0 0 0 0 0 0 0 0 0 45 | 8 0 0 0 0 0 0 0 0 0 46 | 128 0 0 0 0 0 0 0 65 0 47 | 0 0 0 0 0 0 0 0 0 129 48 | 8 0 0 2 0 0 0 0 0 0 49 | 0 0 0 0 0 0 0 0 0 0 50 | 0 0 0 0 0 0 0 0 0 0 51 | ] 52 | 53 | probe play-board 54 | print "Call IDS:" 55 | ;best-move-is: iterative-deepening-search play-board 0 1 56 | best-move-is: iterative-deepening-search play-board 1 3 57 | ;principal-variation-search in-board color alpha beta depth variant true 58 | ;principal-variation-search play-board 1 MINUS-INFINITY INFINITY 2 (copy []) true 59 | ;best-move-is: iterative-deepening-search play-board 0 3 60 | 61 | print "ids-move-list:" 62 | probe ids-move-list 63 | print "best found move is" 64 | print best-move-is 65 | print "Log-data:" 66 | 67 | reversed-play-board: [ 68 | 0 0 0 0 0 0 0 0 0 0 69 | 0 0 0 0 0 0 0 0 0 0 70 | 0 0 0 0 0 0 0 0 0 0 71 | 0 0 0 0 0 0 0 0 0 9 72 | 0 64 0 0 0 0 0 0 0 129 73 | 128 0 0 0 0 0 0 0 0 0 74 | 0 0 0 0 0 0 3 0 0 9 75 | 0 0 0 0 0 0 0 0 0 0 76 | 0 0 0 0 0 0 0 0 0 0 77 | ] 78 | print "reversed values white to play" 79 | append log-data newline 80 | append log-data "*******************************" 81 | append log-data newline 82 | append log-data "*reversed values white to play*" 83 | append log-data newline 84 | append log-data "*******************************" 85 | append log-data newline 86 | 87 | best-move-is: iterative-deepening-search reversed-play-board 0 3 88 | 89 | print "ids-move-list:" 90 | probe ids-move-list 91 | print "best found move is" 92 | print best-move-is 93 | 94 | write %xiangqi-log.log log-data 95 | 96 | print "End of testprogram xiangqi-best-move-test.red" -------------------------------------------------------------------------------- /xiangqi/test/xiangqi-choose-move-test.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Test iterative deepening search for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-choose-move-test.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "20-Mrt-2015" 7 | red-version: "Needs Red 0.5.0" 8 | ] 9 | 10 | #include %../utils/xiangqi-helper-functions.red 11 | #include %../xiangqi-common.red 12 | #include %../xiangqi-move-common.red 13 | #include %../xiangqi-evaluate.red 14 | #include %../xiangqi-moves.red 15 | #include %../xiangqi-best-move.red 16 | #include %../xiangqi-open.red 17 | ;#include %../xiangqi-hash.red 18 | 19 | comment { ; test of the functions 20 | choose-move: function [ 21 | "Choose moves from the openingbook, or other similar sources" 22 | found-moves [block!] 23 | return: [block!] 24 | 25 | choose-move-from-list: function [ 26 | "Choose moves from result of iterative deepening search" 27 | move-list [block!] 28 | depth [integer!] 29 | return: [block!] 30 | 31 | } 32 | 33 | cm-moves-1: [[ 1 2] 33 [ 3 4] 33 [ 5 6] 34] 34 | cm-result: choose-move cm-moves-1 35 | probe cm-result 36 | 37 | cmfl-moves-1: [] 38 | cmfl-result: choose-move-from-list cmfl-moves-1 39 | probe cmfl-result 40 | 41 | cmfl-moves-2: [[8 12 14 0 false 99][16 12 14 0 false 99][32 12 14 0 false 99][8 12 14 0 false -99999]] 42 | cmfl-result: choose-move-from-list cmfl-moves-2 43 | probe cmfl-result 44 | 45 | cmfl-moves-2: [[8 12 14 0 false 99 -99999][16 12 14 0 false 99 -99999][32 12 14 0 false -99999 -99999][8 12 14 0 false -99999 -99999]] 46 | cmfl-result: choose-move-from-list cmfl-moves-2 47 | probe cmfl-result 48 | 49 | print "End of testprogram xiangqi-choose-move-test.red" -------------------------------------------------------------------------------- /xiangqi/test/xiangqi-convertions-test.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Test convertion for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-convertion-test.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "21-Feb-2015" 7 | red-version: "Needs Red 0.5.0" 8 | ] 9 | 10 | #include %../xiangqi-common.red 11 | #include %../xiangqi-convertions.red 12 | 13 | init-convertions-test: func [] [ 14 | testname: "Convertions" 15 | convertions-test-results: 0 16 | convertions-tests: 0 17 | ] 18 | 19 | convertions-result: func [ 20 | testresult [logic! integer! block!] 21 | ][ 22 | convertions-tests: convertions-tests + 1 23 | 24 | either expected-result = testresult [ 25 | print ["test " convertions-tests " success" expected-result "equals" testresult] 26 | convertions-test-results: convertions-test-results + 1 27 | ][ 28 | print ["test " convertions-tests " failed" expected-result "not equals" testresult] 29 | ] 30 | ] 31 | 32 | conclude-test: function [ 33 | ][ 34 | print ["Test " testname "ended."] 35 | print ["Tests performed:" convertions-tests] 36 | print ["Successes:" convertions-test-results] 37 | print ["Failed tests:" convertions-tests - convertions-test-results ] 38 | 39 | ] 40 | 41 | ; Calling the function to be tested 42 | comment { 43 | field-to-xy: function [ 44 | field [integer!] 45 | return: [block!] 46 | xy-to-field: function [ 47 | x [integer!] 48 | y [integer!] 49 | } 50 | 51 | init-convertions-test 52 | 53 | ;********************* 54 | ; Tests of field-to-xy 55 | ;********************* 56 | comment { 57 | all-fields-as-xy: [ 58 | [1 1] [1 2] [1 3] [1 4] [1 5] [1 6] [1 7] [1 8] [1 9] [1 10] 59 | [2 1] [2 2] [2 3] [2 4] [2 5] [2 6] [2 7] [2 8] [2 9] [2 10] 60 | [3 1] [3 2] [3 3] [3 4] [3 5] [3 6] [3 7] [3 8] [3 9] [3 10] 61 | [4 1] [4 2] [4 3] [4 4] [4 5] [4 6] [4 7] [4 8] [4 9] [4 10] 62 | [5 1] [5 2] [5 3] [5 4] [5 5] [5 6] [5 7] [5 8] [5 9] [5 10] 63 | [6 1] [6 2] [6 3] [6 4] [6 5] [6 6] [6 7] [6 8] [6 9] [6 10] 64 | [7 1] [7 2] [7 3] [7 4] [7 5] [7 6] [7 7] [7 8] [7 9] [7 10] 65 | [8 1] [8 2] [8 3] [8 4] [8 5] [8 6] [8 7] [8 8] [8 9] [8 10] 66 | [9 1] [9 2] [9 3] [9 4] [9 5] [9 6] [9 7] [9 8] [9 9] [9 10] 67 | ] 68 | } 69 | 70 | ; Make sure these have the right value for this test 71 | start-position-h: start-position-v: 80 ; 80 pixels? 72 | field-size: 100 ; 100 pixels? 73 | 74 | all-fields-as-xy: [ 75 | [80 980] [80 880] [80 780] [80 680] [80 580] [80 480] [80 380] [80 280] [80 180] [80 80] 76 | [180 980] [180 880] [180 780] [180 680] [180 580] [180 480] [180 380] [180 280] [180 180] [180 80] 77 | [280 980] [280 880] [280 780] [280 680] [280 580] [280 480] [280 380] [280 280] [280 180] [280 80] 78 | [380 980] [380 880] [380 780] [380 680] [380 580] [380 480] [380 380] [380 280] [380 180] [380 80] 79 | [480 980] [480 880] [480 780] [480 680] [480 580] [480 480] [480 380] [480 280] [480 180] [480 80] 80 | [580 980] [580 880] [580 780] [580 680] [580 580] [580 480] [580 380] [580 280] [580 180] [580 80] 81 | [680 980] [680 880] [680 780] [680 680] [680 580] [680 480] [680 380] [680 280] [680 180] [680 80] 82 | [780 980] [780 880] [780 780] [780 680] [780 580] [780 480] [780 380] [780 280] [780 180] [780 80] 83 | [880 980] [880 880] [880 780] [880 680] [880 580] [880 480] [880 380] [880 280] [880 180] [880 80] 84 | ] 85 | 86 | repeat field 90 [ 87 | expected-result: all-fields-as-xy/:field 88 | convertions-result field-to-xy field 89 | ] 90 | 91 | ;********************* 92 | ; Tests of xy-to-field 93 | ;********************* 94 | repeat field 90 [ 95 | expected-result: field 96 | convertions-result xy-to-field all-fields-as-xy/:field/1 all-fields-as-xy/:field/2 97 | ] 98 | 99 | ;**************************** 100 | ; Tests of display-moves-list 101 | ;**************************** 102 | move-list: [[1 2] [1 3] [2 3] [2 4] [2 5]] 103 | expected-result: [ 1 [2 3] 2 [3 4 5] ] 104 | convertions-result display-moves-list move-list 105 | 106 | ;************************** 107 | ; Print and display a board 108 | ;************************** 109 | print-board start-board 110 | 111 | init-xiangqi-display-set/snmg 112 | 113 | display-board start-board 114 | display-board/numbers start-board 115 | 116 | init-xiangqi-display-set/standard 117 | 118 | display-board start-board 119 | display-board/numbers start-board 120 | 121 | 122 | ;******************************** 123 | ; Add more tests here (181+) 124 | ;******************************** 125 | 126 | 127 | 128 | conclude-test 129 | 130 | comment { 131 | test 1 success 80 980 equals 80 980 132 | test 2 success 80 880 equals 80 880 133 | test 3 success 80 780 equals 80 780 134 | test 4 success 80 680 equals 80 680 135 | test 5 success 80 580 equals 80 580 136 | test 6 success 80 480 equals 80 480 137 | test 7 success 80 380 equals 80 380 138 | test 8 success 80 280 equals 80 280 139 | test 9 success 80 180 equals 80 180 140 | test 10 success 80 80 equals 80 80 141 | test 11 success 180 980 equals 180 980 142 | test 12 success 180 880 equals 180 880 143 | test 13 success 180 780 equals 180 780 144 | test 14 success 180 680 equals 180 680 145 | test 15 success 180 580 equals 180 580 146 | test 16 success 180 480 equals 180 480 147 | test 17 success 180 380 equals 180 380 148 | test 18 success 180 280 equals 180 280 149 | test 19 success 180 180 equals 180 180 150 | test 20 success 180 80 equals 180 80 151 | test 21 success 280 980 equals 280 980 152 | test 22 success 280 880 equals 280 880 153 | test 23 success 280 780 equals 280 780 154 | test 24 success 280 680 equals 280 680 155 | test 25 success 280 580 equals 280 580 156 | test 26 success 280 480 equals 280 480 157 | test 27 success 280 380 equals 280 380 158 | test 28 success 280 280 equals 280 280 159 | test 29 success 280 180 equals 280 180 160 | test 30 success 280 80 equals 280 80 161 | test 31 success 380 980 equals 380 980 162 | test 32 success 380 880 equals 380 880 163 | test 33 success 380 780 equals 380 780 164 | test 34 success 380 680 equals 380 680 165 | test 35 success 380 580 equals 380 580 166 | test 36 success 380 480 equals 380 480 167 | test 37 success 380 380 equals 380 380 168 | test 38 success 380 280 equals 380 280 169 | test 39 success 380 180 equals 380 180 170 | test 40 success 380 80 equals 380 80 171 | test 41 success 480 980 equals 480 980 172 | test 42 success 480 880 equals 480 880 173 | test 43 success 480 780 equals 480 780 174 | test 44 success 480 680 equals 480 680 175 | test 45 success 480 580 equals 480 580 176 | test 46 success 480 480 equals 480 480 177 | test 47 success 480 380 equals 480 380 178 | test 48 success 480 280 equals 480 280 179 | test 49 success 480 180 equals 480 180 180 | test 50 success 480 80 equals 480 80 181 | test 51 success 580 980 equals 580 980 182 | test 52 success 580 880 equals 580 880 183 | test 53 success 580 780 equals 580 780 184 | test 54 success 580 680 equals 580 680 185 | test 55 success 580 580 equals 580 580 186 | test 56 success 580 480 equals 580 480 187 | test 57 success 580 380 equals 580 380 188 | test 58 success 580 280 equals 580 280 189 | test 59 success 580 180 equals 580 180 190 | test 60 success 580 80 equals 580 80 191 | test 61 success 680 980 equals 680 980 192 | test 62 success 680 880 equals 680 880 193 | test 63 success 680 780 equals 680 780 194 | test 64 success 680 680 equals 680 680 195 | test 65 success 680 580 equals 680 580 196 | test 66 success 680 480 equals 680 480 197 | test 67 success 680 380 equals 680 380 198 | test 68 success 680 280 equals 680 280 199 | test 69 success 680 180 equals 680 180 200 | test 70 success 680 80 equals 680 80 201 | test 71 success 780 980 equals 780 980 202 | test 72 success 780 880 equals 780 880 203 | test 73 success 780 780 equals 780 780 204 | test 74 success 780 680 equals 780 680 205 | test 75 success 780 580 equals 780 580 206 | test 76 success 780 480 equals 780 480 207 | test 77 success 780 380 equals 780 380 208 | test 78 success 780 280 equals 780 280 209 | test 79 success 780 180 equals 780 180 210 | test 80 success 780 80 equals 780 80 211 | test 81 success 880 980 equals 880 980 212 | test 82 success 880 880 equals 880 880 213 | test 83 success 880 780 equals 880 780 214 | test 84 success 880 680 equals 880 680 215 | test 85 success 880 580 equals 880 580 216 | test 86 success 880 480 equals 880 480 217 | test 87 success 880 380 equals 880 380 218 | test 88 success 880 280 equals 880 280 219 | test 89 success 880 180 equals 880 180 220 | test 90 success 880 80 equals 880 80 221 | test 91 success 1 equals 1 222 | test 92 success 2 equals 2 223 | test 93 success 3 equals 3 224 | test 94 success 4 equals 4 225 | test 95 success 5 equals 5 226 | test 96 success 6 equals 6 227 | test 97 success 7 equals 7 228 | test 98 success 8 equals 8 229 | test 99 success 9 equals 9 230 | test 100 success 10 equals 10 231 | test 101 success 11 equals 11 232 | test 102 success 12 equals 12 233 | test 103 success 13 equals 13 234 | test 104 success 14 equals 14 235 | test 105 success 15 equals 15 236 | test 106 success 16 equals 16 237 | test 107 success 17 equals 17 238 | test 108 success 18 equals 18 239 | test 109 success 19 equals 19 240 | test 110 success 20 equals 20 241 | test 111 success 21 equals 21 242 | test 112 success 22 equals 22 243 | test 113 success 23 equals 23 244 | test 114 success 24 equals 24 245 | test 115 success 25 equals 25 246 | test 116 success 26 equals 26 247 | test 117 success 27 equals 27 248 | test 118 success 28 equals 28 249 | test 119 success 29 equals 29 250 | test 120 success 30 equals 30 251 | test 121 success 31 equals 31 252 | test 122 success 32 equals 32 253 | test 123 success 33 equals 33 254 | test 124 success 34 equals 34 255 | test 125 success 35 equals 35 256 | test 126 success 36 equals 36 257 | test 127 success 37 equals 37 258 | test 128 success 38 equals 38 259 | test 129 success 39 equals 39 260 | test 130 success 40 equals 40 261 | test 131 success 41 equals 41 262 | test 132 success 42 equals 42 263 | test 133 success 43 equals 43 264 | test 134 success 44 equals 44 265 | test 135 success 45 equals 45 266 | test 136 success 46 equals 46 267 | test 137 success 47 equals 47 268 | test 138 success 48 equals 48 269 | test 139 success 49 equals 49 270 | test 140 success 50 equals 50 271 | test 141 success 51 equals 51 272 | test 142 success 52 equals 52 273 | test 143 success 53 equals 53 274 | test 144 success 54 equals 54 275 | test 145 success 55 equals 55 276 | test 146 success 56 equals 56 277 | test 147 success 57 equals 57 278 | test 148 success 58 equals 58 279 | test 149 success 59 equals 59 280 | test 150 success 60 equals 60 281 | test 151 success 61 equals 61 282 | test 152 success 62 equals 62 283 | test 153 success 63 equals 63 284 | test 154 success 64 equals 64 285 | test 155 success 65 equals 65 286 | test 156 success 66 equals 66 287 | test 157 success 67 equals 67 288 | test 158 success 68 equals 68 289 | test 159 success 69 equals 69 290 | test 160 success 70 equals 70 291 | test 161 success 71 equals 71 292 | test 162 success 72 equals 72 293 | test 163 success 73 equals 73 294 | test 164 success 74 equals 74 295 | test 165 success 75 equals 75 296 | test 166 success 76 equals 76 297 | test 167 success 77 equals 77 298 | test 168 success 78 equals 78 299 | test 169 success 79 equals 79 300 | test 170 success 80 equals 80 301 | test 171 success 81 equals 81 302 | test 172 success 82 equals 82 303 | test 173 success 83 equals 83 304 | test 174 success 84 equals 84 305 | test 175 success 85 equals 85 306 | test 176 success 86 equals 86 307 | test 177 success 87 equals 87 308 | test 178 success 88 equals 88 309 | test 179 success 89 equals 89 310 | test 180 success 90 equals 90 311 | test 180 success 90 equals 90 312 | test 181 success 1 2 3 2 3 4 5 equals 1 2 3 2 3 4 5 313 | 9 17 33 65 129 65 33 17 9 314 | 315 | 0 0 0 0 0 0 0 0 0 316 | 317 | 0 5 0 0 0 0 0 5 0 318 | 319 | 3 0 3 0 3 0 3 0 3 320 | 321 | 0 0 0 0 0 0 0 0 0 322 | 323 | 0 0 0 0 0 0 0 0 0 324 | 325 | 2 0 2 0 2 0 2 0 2 326 | 327 | 0 4 0 0 0 0 0 4 0 328 | 329 | 0 0 0 0 0 0 0 0 0 330 | 331 | 8 16 32 64 128 64 32 16 8 332 | 333 | 1 2 3 4 5 6 7 8 9 334 | ---------------------------- 335 | r h e a k a e h r 336 | . . . . . . . . . 337 | . c . . . . . c . 338 | p . p . p . p . p 339 | . . . . . . . . . 340 | . . . . . . . . . 341 | P . P . P . P . P 342 | . C . . . . . C . 343 | . . . . . . . . . 344 | R H E A K A E H R 345 | ---------------------------- 346 | 9 8 7 6 5 4 3 2 1 347 | 1 2 3 4 5 6 7 8 9 348 | ---------------------------- 349 | r h e a k a e h r 350 | 10 20 30 40 50 60 70 80 90 351 | . . . . . . . . . 352 | 9 19 29 39 49 59 69 79 89 353 | . c . . . . . c . 354 | 8 18 28 38 48 58 68 78 88 355 | p . p . p . p . p 356 | 7 17 27 37 47 57 67 77 87 357 | . . . . . . . . . 358 | 6 16 26 36 46 56 66 76 86 359 | . . . . . . . . . 360 | 5 15 25 35 45 55 65 75 85 361 | P . P . P . P . P 362 | 4 14 24 34 44 54 64 74 84 363 | . C . . . . . C . 364 | 3 13 23 33 43 53 63 73 83 365 | . . . . . . . . . 366 | 2 12 22 32 42 52 62 72 82 367 | R H E A K A E H R 368 | 1 11 21 31 41 51 61 71 81 369 | ---------------------------- 370 | 9 8 7 6 5 4 3 2 1 371 | Test Convertions ended. 372 | Tests performed: 181 373 | Successes: 181 374 | Failed tests: 0 375 | 376 | } -------------------------------------------------------------------------------- /xiangqi/test/xiangqi-evaluate-test.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Test position evaluating for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-evaluate-test.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "21-Feb-2015" 7 | red-version: "Needs Red 0.5.0" 8 | ] 9 | 10 | #include %../xiangqi-common.red 11 | #include %../xiangqi-evaluate.red 12 | 13 | init-evaluate-test: func [] [ 14 | testname: "Evaluate Test" 15 | evaluate-test-results: 0 16 | evaluate-tests: 0 17 | ] 18 | 19 | evaluate-result: func [ 20 | testresult [logic! integer!] 21 | ][ 22 | evaluate-tests: evaluate-tests + 1 23 | 24 | either expected-result = testresult [ 25 | print ["test " evaluate-tests " success" expected-result "equals" testresult] 26 | evaluate-test-results: evaluate-test-results + 1 27 | ][ 28 | print ["test " evaluate-tests " failed" expected-result "not equals" testresult] 29 | ] 30 | ; if all [any [ testresult <> expected-result] 31 | ; any [ debug 32 | ; report-info]][ 33 | ; print ["Reason: " info-area/code " " info-area/description] 34 | ; ] 35 | ; init-info-area 36 | ] 37 | 38 | conclude-test: function [ 39 | ][ 40 | print ["Test " testname "ended."] 41 | print ["Tests performed:" evaluate-tests] 42 | print ["Successes:" evaluate-test-results] 43 | print ["Failed tests:" evaluate-tests - evaluate-test-results ] 44 | 45 | ] 46 | 47 | ; Calling the function to be tested 48 | comment { 49 | evaluate-board: function [ 50 | "Simple evaluation routine for the entire board" 51 | board [block!] 52 | return: [integer!] 53 | } 54 | 55 | init-evaluate-test 56 | 57 | ;******************************** 58 | ; Tests with expected result true 59 | ;******************************** 60 | ; test 1, the start position 61 | play-board: [ 62 | 8 0 0 2 0 0 3 0 0 9 63 | 16 0 4 0 0 0 0 5 0 17 64 | 32 0 0 2 0 0 3 0 0 33 65 | 64 0 0 0 0 0 0 0 0 65 66 | 128 0 0 2 0 0 3 0 0 129 67 | 64 0 0 0 0 0 0 0 0 65 68 | 32 0 0 2 0 0 3 0 0 33 69 | 16 0 4 0 0 0 0 5 0 17 70 | 8 0 0 2 0 0 3 0 0 9 71 | ] 72 | 73 | expected-result: 0 74 | ;print evaluate-board play-board 75 | evaluate-result evaluate-board play-board 76 | play-board: [ 77 | 8 0 0 0 2 0 3 0 0 9 78 | 16 0 4 0 0 0 0 5 0 17 79 | 32 0 0 2 0 0 3 0 0 33 80 | 64 0 0 0 0 0 0 0 0 65 81 | 128 0 0 2 0 0 3 0 0 129 82 | 64 0 0 0 0 0 0 0 0 65 83 | 32 0 0 2 0 0 3 0 0 33 84 | 16 0 4 0 0 0 0 5 0 17 85 | 8 0 0 2 0 0 3 0 0 9 86 | ] 87 | expected-result: 2 88 | ;print evaluate-board play-board 89 | evaluate-result evaluate-board play-board 90 | 91 | ; exchange the canon for the horse 92 | play-board: [ 93 | 8 0 0 2 0 0 3 0 0 0 94 | 16 0 0 0 0 0 0 5 0 9 95 | 32 0 0 2 0 0 3 0 0 33 96 | 64 0 0 0 0 0 0 0 0 65 97 | 128 0 0 2 0 0 3 0 0 129 98 | 64 0 0 0 0 0 0 0 0 65 99 | 32 0 0 2 0 0 3 0 0 33 100 | 16 0 4 0 0 0 0 5 0 17 101 | 8 0 0 2 0 0 3 0 0 9 102 | ] 103 | expected-result: -31 104 | ;print evaluate-board play-board 105 | evaluate-result evaluate-board play-board 106 | 107 | ; 108 | ; Add more tests here (3+) 109 | print "start-board" 110 | print evaluate-board start-board 111 | print "play-board" 112 | print form play-board 113 | print evaluate-board play-board 114 | 115 | print "2 on 39" 116 | play-board: [ 117 | 0 0 0 0 0 0 0 0 0 0 118 | 0 0 0 0 0 0 0 0 0 0 119 | 0 0 0 0 0 0 0 0 0 0 120 | 0 0 0 0 0 0 0 0 2 0 121 | 0 0 0 0 0 0 0 0 0 0 122 | 0 0 0 0 0 0 0 0 0 0 123 | 0 0 0 0 0 0 0 0 0 0 124 | 0 0 0 0 0 0 0 0 0 0 125 | 0 0 0 0 0 0 0 0 0 0 126 | ] 127 | print form play-board 128 | print evaluate-board play-board 129 | 130 | print "3 on 39" 131 | play-board: [ 132 | 0 0 0 0 0 0 0 0 0 0 133 | 0 0 0 0 0 0 0 0 0 0 134 | 0 0 0 0 0 0 0 0 0 0 135 | 0 0 0 0 0 0 0 0 3 0 136 | 0 0 0 0 0 0 0 0 0 0 137 | 0 0 0 0 0 0 0 0 0 0 138 | 0 0 0 0 0 0 0 0 0 0 139 | 0 0 0 0 0 0 0 0 0 0 140 | 0 0 0 0 0 0 0 0 0 0 141 | ] 142 | print form play-board 143 | print evaluate-board play-board 144 | 145 | print "2 on 32" 146 | play-board: [ 147 | 0 0 0 0 0 0 0 0 0 0 148 | 0 0 0 0 0 0 0 0 0 0 149 | 0 0 0 0 0 0 0 0 0 0 150 | 0 2 0 0 0 0 0 0 0 0 151 | 0 0 0 0 0 0 0 0 0 0 152 | 0 0 0 0 0 0 0 0 0 0 153 | 0 0 0 0 0 0 0 0 0 0 154 | 0 0 0 0 0 0 0 0 0 0 155 | 0 0 0 0 0 0 0 0 0 0 156 | ] 157 | print form play-board 158 | print evaluate-board play-board 159 | 160 | print "3 on 32" 161 | play-board: [ 162 | 0 0 0 0 0 0 0 0 0 0 163 | 0 0 0 0 0 0 0 0 0 0 164 | 0 0 0 0 0 0 0 0 0 0 165 | 0 3 0 0 0 0 0 0 0 0 166 | 0 0 0 0 0 0 0 0 0 0 167 | 0 0 0 0 0 0 0 0 0 0 168 | 0 0 0 0 0 0 0 0 0 0 169 | 0 0 0 0 0 0 0 0 0 0 170 | 0 0 0 0 0 0 0 0 0 0 171 | ] 172 | print form play-board 173 | print evaluate-board play-board 174 | 175 | conclude-test 176 | 177 | comment { 178 | Testresults: 179 | 180 | } 181 | -------------------------------------------------------------------------------- /xiangqi/test/xiangqi-hash-test.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Test hash computing for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-hash-test.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "7-Feb-2015" 7 | ] 8 | 9 | #include %../xiangqi-hash.red 10 | 11 | ; tests 12 | key-part: 2514 13 | print integer-to-base64 key-part 14 | 15 | key-part: 2586 16 | print integer-to-base64 key-part 17 | 18 | key-part: 2514 << 18 + 2586 19 | print integer-to-base64 key-part 20 | 21 | ; Expected results test 1 + 2 + 3 22 | ; nS 23 | ; oa 24 | ; nSAoa 25 | 26 | ; test 4 27 | key: [804 2514 804 954 2586 954] 28 | convert-to-base64 key 29 | ; == "AnSAoaAMkAO6AMkAO6" 30 | 31 | ; test 5 32 | key: [884 2514 804 954 2586 954] 33 | convert-to-base64 key 34 | ; == "AnSAoaAN0AO6AMkAO6" 35 | 36 | ; test 6 + 7 37 | play-board: [ 38 | 8 0 0 2 0 0 3 0 0 9 39 | 16 0 4 0 0 0 0 5 0 17 40 | 32 0 0 2 0 0 3 0 0 33 41 | 64 0 0 0 0 0 0 0 0 65 42 | 128 0 0 2 0 0 3 0 0 129 43 | 64 0 0 0 0 0 0 0 0 65 44 | 32 0 0 2 0 0 3 0 0 33 45 | 16 0 4 0 0 0 0 5 0 17 46 | 8 0 0 2 0 0 3 0 0 9 47 | ] 48 | 49 | calculate-hash-code play-board 50 | my-hash: calculate-new-hash-from-move play-board [804 2514 804 954 2586 954] 1 2 51 | probe my-hash 52 | ; Expected result 53 | ; [884 2514 804 954 2586 954] 54 | 55 | print calculate-new-hash-code-from-move play-board [804 2514 804 954 2586 954] 1 2 56 | ; Expected result 57 | ; AnSAoaAN0AO6AMkAO6 58 | 59 | -------------------------------------------------------------------------------- /xiangqi/test/xiangqi-move-display-test.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Test generation of moves for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-move-display-test.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "25-Sep-2015" 7 | red-version: "Needs Red 0.5.0" 8 | ] 9 | move-list: copy [] 10 | #include %../utils/xiangqi-helper-functions.red 11 | #include %../xiangqi-common.red 12 | #include %../xiangqi-move-common.red 13 | #include %../xiangqi-evaluate.red 14 | #include %../xiangqi-hash.red 15 | #include %../xiangqi-moves.red 16 | #include %../xiangqi-convertions.red 17 | 18 | 19 | ;******************************************* 20 | ; Tests with expected result generated moves 21 | ;******************************************* 22 | ; test 1, the start position 23 | play-board: [ 24 | 8 0 0 2 0 0 3 0 0 9 25 | 16 0 4 0 0 0 0 5 0 17 26 | 32 0 0 2 0 0 3 0 0 33 27 | 64 0 0 0 0 0 0 0 0 65 28 | 128 0 0 2 0 0 3 0 0 129 29 | 64 0 0 0 0 0 0 0 0 65 30 | 32 0 0 2 0 0 3 0 0 33 31 | 16 0 4 0 0 0 0 5 0 17 32 | 8 0 0 2 0 0 3 0 0 9 33 | ] 34 | 35 | ; Test 1 36 | white-moves: copy [] 37 | black-moves: copy [] 38 | 39 | white-moves: make-move-list play-board 0 40 | probe white-moves 41 | probe my-display-moves: display-moves-list white-moves 42 | 43 | black-moves: make-move-list play-board 1 44 | probe black-moves 45 | probe my-display-moves: display-moves-list black-moves 46 | -------------------------------------------------------------------------------- /xiangqi/test/xiangqi-moves-test.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Test generation of moves for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-moves-test.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "24-Feb-2015" 7 | red-version: "Needs Red 0.5.0" 8 | ] 9 | move-list: copy [] 10 | #include %../utils/xiangqi-helper-functions.red 11 | #include %../xiangqi-common.red 12 | #include %../xiangqi-move-common.red 13 | #include %../xiangqi-evaluate.red 14 | #include %../xiangqi-hash.red 15 | #include %../xiangqi-moves.red 16 | #include %../xiangqi-convertions.red 17 | 18 | init-debug/stop 19 | 20 | init-moves-test: does [ 21 | testname: "Moves Generating" 22 | moves-test-results: 0 23 | moves-tests: 0 24 | ] 25 | 26 | moves-result: func [ 27 | testresult [block!] 28 | /local blocks-are-equal [logic!] 29 | length-testresult [integer!] 30 | length-expected-result [integer!] 31 | formed-move [string!] 32 | formed-test-move [string!] 33 | ;molded-moves [string!] 34 | ;molded-test-moves [string!] 35 | ][ 36 | moves-tests: moves-tests + 1 37 | blocks-are-equal: true 38 | ; this differs from the original because it is not so simple to compare the generated moves block with the printed / probed version 39 | length-testresult: length? testresult 40 | length-expected-result: length? expected-result 41 | if length-expected-result <> length-testresult [ 42 | blocks-are-equal: false 43 | print ["lengths unequal, expected:" length-expected-result " testresult:" length-testresult] 44 | ] 45 | if blocks-are-equal [ 46 | comment { ; does not work fine with mold or mold/all 47 | molded-test-moves: mold/all testresult 48 | molded-moves: mold/all expected-result 49 | if molded-moves <> molded-test-moves [ 50 | blocks-are-equal: false 51 | print ["move unequal, expected:" molded-moves " testresult:" molded-test-moves] 52 | ] 53 | } 54 | count: 1 55 | foreach move expected-result [ 56 | test-move: first testresult 57 | formed-move: form move 58 | formed-test-move: form test-move 59 | ;if move <> test-move [ 60 | if formed-move <> formed-test-move [ 61 | blocks-are-equal: false 62 | print ["move " count " unequal, expected:" move " testresult:" test-move] 63 | probe move 64 | probe test-move 65 | ] 66 | testresult: next testresult 67 | count: count + 1 68 | ] 69 | ] 70 | testresult: head testresult 71 | ;either expected-result = testresult [ 72 | either blocks-are-equal [ 73 | print ["test " moves-tests " success"] 74 | ;print ["test " moves-tests " success" newline 75 | ; expected-result newline "equals" newline testresult] 76 | moves-test-results: moves-test-results + 1 77 | ][ 78 | print ["test " moves-tests " failed" newline 79 | expected-result newline "not equals" newline testresult] 80 | ] 81 | ] 82 | 83 | conclude-test: function [ 84 | ][ 85 | print ["Test " testname "ended."] 86 | print ["Tests performed:" moves-tests] 87 | print ["Successes:" moves-test-results] 88 | print ["Failed tests:" moves-tests - moves-test-results ] 89 | 90 | ] 91 | ; Calling the function to be tested 92 | comment { 93 | make-move-list: func [ 94 | in-board [block!] 95 | color [integer!] 96 | return: [block!] 97 | } 98 | 99 | init-moves-test 100 | 101 | ;******************************************* 102 | ; Tests with expected result generated moves 103 | ;******************************************* 104 | ; test 1, the start position 105 | play-board: [ 106 | 8 0 0 2 0 0 3 0 0 9 107 | 16 0 4 0 0 0 0 5 0 17 108 | 32 0 0 2 0 0 3 0 0 33 109 | 64 0 0 0 0 0 0 0 0 65 110 | 128 0 0 2 0 0 3 0 0 129 111 | 64 0 0 0 0 0 0 0 0 65 112 | 32 0 0 2 0 0 3 0 0 33 113 | 16 0 4 0 0 0 0 5 0 17 114 | 8 0 0 2 0 0 3 0 0 9 115 | ] 116 | 117 | ; Test 1 118 | expected-result: [[8 1 2 0 false 10][8 1 3 0 false 6][2 4 5 0 false 2][16 11 3 0 false 8][16 11 23 0 false 12][4 13 3 0 false 4][4 13 23 0 false 8][4 13 33 0 false 6][4 13 43 0 false 10][4 13 53 0 false 6][4 13 63 0 false 8][4 13 14 0 false 0][4 13 15 0 false 0][4 13 16 0 false 0][4 13 17 0 false 0][4 13 20 17 false 270][4 13 12 0 false 2][32 21 3 0 false 0][32 21 43 0 false 0][2 24 25 0 false 10][64 31 42 0 false 0][128 41 42 0 false 0][2 44 45 0 false 4][64 51 42 0 false 0][32 61 43 0 false 0][32 61 83 0 false 0][2 64 65 0 false 10][16 71 63 0 false 12][16 71 83 0 false 8][4 73 63 0 false 8][4 73 53 0 false 6][4 73 43 0 false 10][4 73 33 0 false 6][4 73 23 0 false 8][4 73 83 0 false 4][4 73 74 0 false 0][4 73 75 0 false 0][4 73 76 0 false 0][4 73 77 0 false 0][4 73 80 17 false 270][4 73 72 0 false 2][8 81 82 0 false 10][8 81 83 0 false 6][2 84 85 0 false 2]] 119 | ;probe make-move-list play-board 0 120 | moves-result make-move-list play-board 0 121 | 122 | ; Test 2 123 | expected-result: [[3 7 6 0 false 2] [9 10 9 0 false 10] [9 10 8 0 false 6] [5 18 8 0 false 4] [5 18 28 0 false 8] [5 18 38 0 false 6] [5 18 48 0 false 10] [5 18 58 0 false 6] [5 18 68 0 false 8] [5 18 19 0 false 2] [5 18 17 0 false 0] [5 18 16 0 false 0] [5 18 15 0 false 0] [5 18 14 0 false 0] [5 18 11 16 false 270] [17 20 8 0 false 8] [17 20 28 0 false 12] [3 27 26 0 false 10] [33 30 8 0 false 0] [33 30 48 0 false 0] [65 40 49 0 false 0] [3 47 46 0 false 4] [129 50 49 0 false 0] [65 60 49 0 false 0] [3 67 66 0 false 10] [33 70 48 0 false 0] [33 70 88 0 false 0] [5 78 68 0 false 8] [5 78 58 0 false 6] [5 78 48 0 false 10] [5 78 38 0 false 6] [5 78 28 0 false 8] [5 78 88 0 false 4] [5 78 79 0 false 2] [5 78 77 0 false 0] [5 78 76 0 false 0] [5 78 75 0 false 0] [5 78 74 0 false 0] [5 78 71 16 false 270] [17 80 68 0 false 12] [17 80 88 0 false 8] [3 87 86 0 false 2] [9 90 89 0 false 10] [9 90 88 0 false 6]] 124 | ;probe make-move-list play-board 1 125 | moves-result make-move-list play-board 1 126 | 127 | ; Test 3 128 | play-board: [8 0 0 2 0 0 3 0 0 9 16 0 0 0 0 0 0 5 0 4 32 0 0 2 0 0 3 0 0 33 64 0 0 0 0 0 0 0 0 65 128 0 0 2 0 0 3 0 0 129 64 0 0 0 0 0 0 0 0 65 32 0 0 2 0 0 3 0 0 33 8 0 4 0 0 0 0 0 0 17 0 0 0 2 0 0 3 0 0 9] 129 | expected-result: [[3 7 6 0 false 2] [9 10 20 4 false 301] [9 10 9 0 false 10] [9 10 8 0 false 6][5 18 8 0 false 4] [5 18 28 0 false 8] [5 18 38 0 false 6] [5 18 48 0 false 10][5 18 58 0 false 6] [5 18 68 0 false 8] [5 18 78 0 false 0] [5 18 88 0 false 4][5 18 19 0 false 2] [5 18 17 0 false 0] [5 18 16 0 false 0] [5 18 15 0 false 0][5 18 14 0 false 0] [5 18 13 0 false 2] [5 18 12 0 false 2] [3 27 26 0 false 10][3 47 46 0 false 4] [129 50 49 0 false 0] [65 60 49 0 false 0] [3 67 66 0 false 10] [33 70 48 0 false 0] [33 70 88 0 false 0] [17 80 68 0 false 12] [17 80 88 0 false 8] [3 87 86 0 false 2] [9 90 89 0 false 10] [9 90 88 0 false 6]] 130 | ;probe make-move-list play-board 1 131 | moves-result make-move-list/capture play-board 1 132 | 133 | ; Test 4 134 | print "Capturemoves" 135 | ; Same board as Test 3 136 | expected-result: [[9 10 20 4 false 301]] 137 | ;probe make-move-list/capture play-board 1 138 | moves-result make-move-list/capture play-board 1 139 | 140 | ; Add more tests here (5+) 141 | ;expected-result: [ paste the generated moves here ] 142 | ;probe make-move-list play-board 1 143 | ;moves-result make-move-list play-board 1 144 | move-debug: true 145 | play-board: [ 146 | 0 0 0 0 0 0 0 0 0 0 147 | 0 0 0 0 0 0 0 0 0 0 148 | 0 0 0 0 0 0 0 0 0 0 149 | 8 0 0 0 0 0 0 0 0 0 150 | 128 0 0 0 0 0 0 0 0 0 151 | 0 0 0 0 0 0 0 0 0 129 152 | 8 0 0 2 0 0 0 0 0 0 153 | 0 0 0 0 0 0 0 0 0 0 154 | 0 0 0 0 0 0 0 0 0 0 155 | ] 156 | ;expected-result: [[3 7 6 0 false 2] [9 10 20 4 false 301] [9 10 9 0 false 10] [9 10 8 0 false 6][5 18 8 0 false 4] [5 18 28 0 false 8] [5 18 38 0 false 6] [5 18 48 0 false 10][5 18 58 0 false 6] [5 18 68 0 false 8] [5 18 78 0 false 0] [5 18 88 0 false 4][5 18 19 0 false 2] [5 18 17 0 false 0] [5 18 16 0 false 0] [5 18 15 0 false 0][5 18 14 0 false 0] [5 18 13 0 false 2] [5 18 12 0 false 2] [3 27 26 0 false 10][3 47 46 0 false 4] [129 50 49 0 false 0] [65 60 49 0 false 0] [3 67 66 0 false 10] [33 70 48 0 false 0] [33 70 88 0 false 0] [17 80 68 0 false 12] [17 80 88 0 false 8] [3 87 86 0 false 2] [9 90 89 0 false 10] [9 90 88 0 false 6]] 157 | probe make-move-list play-board 0 158 | 159 | play-board: [ 160 | 0 0 0 0 0 0 0 0 0 0 161 | 0 0 0 0 0 0 0 0 0 0 162 | 0 0 0 0 0 0 0 0 0 0 163 | 0 0 0 0 0 0 0 0 0 8 164 | 128 0 0 0 0 0 0 0 0 0 165 | 0 0 0 0 0 0 0 0 0 129 166 | 8 0 0 2 0 0 0 0 0 0 167 | 0 0 0 0 0 0 0 0 0 0 168 | 0 0 0 0 0 0 0 0 0 0 169 | ] 170 | probe make-move-list play-board 1 171 | 172 | print "no moves for color 1?" 173 | play-board: [ 174 | 0 0 0 0 0 0 0 0 0 0 175 | 0 0 0 0 0 0 0 0 0 0 176 | 0 0 0 0 0 0 0 0 0 0 177 | 8 0 0 0 0 0 0 0 0 0 178 | 128 0 0 0 0 0 0 0 0 0 179 | 8 0 0 0 0 0 0 0 0 129 180 | 0 0 0 2 0 0 0 0 0 0 181 | 0 0 0 0 0 0 0 0 0 0 182 | 0 0 0 0 0 0 0 0 0 0 183 | ] 184 | probe make-move-list play-board 1 185 | 186 | 187 | print "no moves for color 1!!" 188 | play-board: [ 189 | 0 0 0 2 0 0 3 0 0 9 190 | 8 0 0 0 0 0 0 0 0 17 191 | 32 0 0 5 0 0 3 0 0 33 192 | 64 0 0 0 0 0 0 0 0 65 193 | 128 0 0 2 0 4 4 0 0 129 194 | 64 0 0 0 0 0 0 0 0 65 195 | 32 0 0 0 0 0 3 0 0 33 196 | 8 0 0 0 0 0 0 0 0 17 197 | 8 0 0 2 0 0 3 0 0 9] 198 | probe make-move-list play-board 1 199 | ; Conclude test 200 | conclude-test 201 | 202 | comment { 203 | Expected results: 204 | probe make-move-list play-board 0 205 | [[8 1 2 0 false 10] [8 1 3 0 false 6] [2 4 5 0 false 2] [16 11 3 0 false 8] [16 11 23 0 false 12] [4 13 3 0 false 4] [4 13 23 0 false 8] [4 13 33 0 false 6] [4 13 43 0 false 10] [4 13 53 0 false 6] [4 13 63 0 false 8] [4 13 14 0 false 0] [4 13 15 0 false 0] [4 13 16 0 false 0] [4 13 17 0 false 0] [4 13 20 17 false 270] [4 13 12 0 false 2] [32 21 3 0 false 0] [32 21 43 0 false 0] [2 24 25 0 false 10] [64 31 42 0 false 0] [128 41 42 0 false 0] [2 44 45 0 false 4] [64 51 42 0 false 0] [32 61 43 0 false 0] [32 61 83 0 false 0] [2 64 65 0 false 10] [16 71 63 0 false 12] [16 71 83 0 false 8] [4 73 63 0 false 8] [4 73 53 0 false 6] [4 73 43 0 false 10] [4 73 33 0 false 6] [4 73 23 0 false 8] [4 73 83 0 false 4] [4 73 74 0 false 0] [4 73 75 0 false 0] [4 73 76 0 false 0] [4 73 77 0 false 0] [4 73 80 17 false 270] [4 73 72 0 false 2] [8 81 82 0 false 10] [8 81 83 0 false 6] [2 84 85 0 false 2]] 206 | 207 | probe make-move-list play-board 1 208 | [[3 7 6 0 false 2] [9 10 9 0 false 10] [9 10 8 0 false 6] [5 18 8 0 false 4] [5 18 28 0 false 8] [5 18 38 0 false 6] [5 18 48 0 false 10] [5 18 58 0 false 6] [5 18 68 0 false 8] [5 18 19 0 false 2] [5 18 17 0 false 0] [5 18 16 0 false 0] [5 18 15 0 false 0] [5 18 14 0 false 0] [5 18 11 16 false 270] [17 20 8 0 false 8] [17 20 28 0 false 12] [3 27 26 0 false 10] [33 30 8 0 false 0] [33 30 48 0 false 0] [65 40 49 0 false 0] [3 47 46 0 false 4] [129 50 49 0 false 0] [65 60 49 0 false 0] [3 67 66 0 false 10] [33 70 48 0 false 0] [33 70 88 0 false 0] [5 78 68 0 false 8] [5 78 58 0 false 6] [5 78 48 0 false 10] [5 78 38 0 false 6] [5 78 28 0 false 8] [5 78 88 0 false 4] [5 78 79 0 false 2] [5 78 77 0 false 0] [5 78 76 0 false 0] [5 78 75 0 false 0] [5 78 74 0 false 0] [5 78 71 16 false 270] [17 80 68 0 false 12] [17 80 88 0 false 8] [3 87 86 0 false 2] [9 90 89 0 false 10] [9 90 88 0 false 6]] 209 | 210 | test3 211 | [[3 7 6 0 false 2] [9 10 20 4 false 301] [9 10 9 0 false 10] [9 10 8 0 false 6][5 18 8 0 false 4] [5 18 28 0 false 8] [5 18 38 0 false 6] [5 18 48 0 false 10][5 18 58 0 false 6] [5 18 68 0 false 8] [5 18 78 0 false 0] [5 18 88 0 false 4][5 18 19 0 false 2] [5 18 17 0 false 0] [5 18 16 0 false 0] [5 18 15 0 false 0][5 18 14 0 false 0] [5 18 13 0 false 2] [5 18 12 0 false 2] [3 27 26 0 false 10][3 47 46 0 false 4] [129 50 49 0 false 0] [65 60 49 0 false 0] [3 67 66 0 false 10] [33 70 48 0 false 0] [33 70 88 0 false 0] [17 80 68 0 false 12] [17 80 88 0 false 8] [3 87 86 0 false 2] [9 90 89 0 false 10] [9 90 88 0 false 6]] 212 | test4 213 | and capturemoves 214 | [[9 10 20 4 false 301]] 215 | } 216 | 217 | comment { 218 | Testresults: 219 | test 1 success 220 | test 2 success 221 | Test Moves Generating ended. 222 | Tests performed: 2 223 | Successes: 2 224 | Failed tests: 0 225 | 226 | } -------------------------------------------------------------------------------- /xiangqi/utils/red-element-in-collection.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Found? replacement function while compiled Red 'Found? not supported" 3 | filename: %red-element-in-collection.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "20-Feb-2015" 7 | red-version: "Needs Red 0.5.0" 8 | ] 9 | comment { 10 | Hopefully this file becomes obsolete one day, soon! 11 | } 12 | 13 | element-in-collection: function [ 14 | input [integer! char! string!] 15 | collection [series!] 16 | return: [logic!] 17 | /local what [integer! block! string! char! logic!] 18 | ][ 19 | ; found? is unfortunately unsupported in Red 20 | ; found? find collection input 21 | what: find collection input 22 | either none = what [false][true] 23 | ] 24 | 25 | comment { 26 | element: 1 27 | mycollection: [1 2 3] 28 | if element-in-collection element mycollection [print ["I found" element " in collection" mycollection]] 29 | } -------------------------------------------------------------------------------- /xiangqi/utils/red-found.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Found? replacement function while compiled Red 'Found? not supported" 3 | filename: %red-found.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "3-Apr-2015" 7 | red-version: "Needs Red 0.5.1" 8 | ] 9 | 10 | found?: function [ 11 | input [none! string! block! series!] 12 | return: [logic!] 13 | ][ 14 | either none? input [ 15 | return false 16 | ][ 17 | return true 18 | ] 19 | ] 20 | 21 | comment { 22 | print form found? find [1 2 3 4] 2 23 | print form found? find "1-2-3-4" "/" 24 | print form found? find "1/2/3/4" "/" 25 | print form found? find ["Hello" [1 2 3 4] "Goodday" [true]] "Goodday" 26 | } -------------------------------------------------------------------------------- /xiangqi/utils/red-multi-switch.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Switch replacement function while compiled Red 'switch cannot handle multiple case values" 3 | filename: %red-multi-switch.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "23-Feb-2015" 7 | red-version: "Needs Red 0.5.0" 8 | ] 9 | comment { 10 | Hopefully this file becomes obsolete one day, soon! 11 | 12 | Warning: Do NOT nest calls to multi-switch, do not use with complicated block structures. 13 | } 14 | 15 | multi-switch: func [ 16 | 'var [word!] 17 | blk [block!] 18 | /default 19 | blk2 [block!] 20 | /local i [integer!] x [integer! char! string! block!] 21 | ][ 22 | i: get var 23 | ;either found? find blk i [ 24 | either element-in-collection i blk [ 25 | x: select blk i 26 | either block! = type? x [ 27 | do x 28 | ][ 29 | blk: find blk i 30 | until [ 31 | blk: next blk 32 | x: first blk 33 | block! = type? x 34 | ] 35 | do x 36 | ] 37 | ][ ; default 38 | if default [ 39 | do blk2 40 | ] 41 | ] 42 | ] 43 | -------------------------------------------------------------------------------- /xiangqi/utils/red-power.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Power replacement function while compiled Red 'power is not around" 3 | filename: %red-power.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "25-Feb-2015" 7 | red-version: "Needs Red 0.5.0" 8 | ] 9 | 10 | xiangqi-power: function [ 11 | base-number [number!] 12 | exponent [number!] 13 | return: [number!] 14 | ][ 15 | either 0 = exponent [ 16 | return 1 17 | ][ ; only 1 or -1 as answers needed for this use in the Xiangqi program 18 | ; so not making it more difficult than necessary 19 | return -1 20 | ] 21 | 22 | ] -------------------------------------------------------------------------------- /xiangqi/utils/red-rejoin.red: -------------------------------------------------------------------------------- 1 | Red [ "Finally also added to Reds repository in commit 5626 on 6 july 2016" 2 | ] 3 | 4 | rejoin: function [ "Reduces and joins a block of values." 5 | block [block!] "Values to reduce and join" 6 | ][ 7 | if empty? block: reduce block [return block] 8 | append either series? first block [copy first block] [ 9 | form first block 10 | ] next block 11 | ] 12 | -------------------------------------------------------------------------------- /xiangqi/utils/xiangqi-helper-functions.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Add special functions for xiangqi aka Chinese Chess while Red is in development" 3 | filename: %xiangqi-influence-test.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "23-Feb-2015" 7 | red-version: "Needs Red 0.5.0" 8 | ] 9 | comment { 10 | Hopefully this file becomes empty one day. 11 | } 12 | 13 | ; This file provides multi case for switch 14 | #include %red-multi-switch.red 15 | 16 | ; Multi switch simple case replacement did not compile using 'FOUND? 17 | #include %red-element-in-collection.red 18 | 19 | ; New 'FOUND? replacement 20 | #include %red-found.red 21 | 22 | ; Because rejoin is so much nicer than all appends 23 | ; Same Rejoin function has been added in commit 6526 on 7 july 2016 24 | ;#include %red-rejoin.red 25 | -------------------------------------------------------------------------------- /xiangqi/xiangqi-best-move.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Calculate the best move in a given position for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-best-move.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.2 6 | date: "06-Aug-2015" 7 | needs: "%xiangqi-common.red #include via main program or testprogram" 8 | ] 9 | ;*********************************************************** 10 | ; Routines to determine which move from the list is the best 11 | ;*********************************************************** 12 | 13 | ;*************** 14 | ; Move list data 15 | ;*************** 16 | ; list of moves to perform iterative deepening search on 17 | ids-move-list: copy [] 18 | 19 | save-ids-move-list: func [ 20 | list [block!] 21 | ][ 22 | ids-move-list: copy list 23 | ] 24 | 25 | order-ids-move-list: func [ 26 | order-item [integer!] 27 | /desc 28 | ][ 29 | either desc [ 30 | order-moves-by-score/desc ids-move-list order-item 31 | ][ 32 | order-moves-by-score ids-move-list order-item 33 | ] 34 | ] 35 | 36 | read-ids-move-list: does [ 37 | return ids-move-list 38 | ] 39 | 40 | change-ids-move-list: func [ 41 | idx [integer!] 42 | new-move [block!] 43 | ][ 44 | ids-move-list/:idx: new-move 45 | ] 46 | 47 | winning-moves-found: func [ 48 | return: [logic!] 49 | /local 50 | value-pos [integer!] 51 | result [logic!] 52 | ][ 53 | result: false 54 | if 0 = length? ids-move-list [return result] 55 | value-pos: length? ids-move-list/1 56 | forall ids-move-list [ 57 | if INFINITY = ids-move-list/1/:value-pos [ 58 | result: true 59 | ] 60 | ] 61 | return result 62 | ] 63 | 64 | all-moves-lose: func [ 65 | return: [logic!] 66 | /local 67 | value-pos [integer!] 68 | result [logic!] 69 | ][ 70 | result: true 71 | if 0 = length? ids-move-list [return result] 72 | value-pos: length? ids-move-list/1 73 | forall ids-move-list [ 74 | if MINUS-INFINITY < ids-move-list/1/:value-pos [ 75 | result: false 76 | ] 77 | ] 78 | return result 79 | ] 80 | 81 | single-playable-move: func [ 82 | return: [logic!] 83 | /local 84 | value-pos [integer!] 85 | move [block!] 86 | count [integer!] 87 | ][ 88 | if 0 = length? ids-move-list [return false] 89 | value-pos: length? ids-move-list/1 90 | count: 0 91 | ids-move-list: head ids-move-list 92 | until [ 93 | move: first ids-move-list 94 | if MINUS-INFINITY < move/:value-pos [count: count + 1] 95 | ids-move-list: next ids-move-list 96 | any [ 1 < count 97 | tail? ids-move-list] 98 | ] 99 | ids-move-list: head ids-move-list 100 | either 1 = count [true][false] 101 | ] 102 | 103 | ;*************** 104 | ; Book functions 105 | ;*************** 106 | lookup-opening-book: function [ 107 | hash-value [string!] 108 | color [integer!] 109 | return: [block!] 110 | /local opening-result [block!] 111 | ][ 112 | opening-result: copy [] 113 | if found? find opening-book hash-value [ 114 | opening-result: select opening-book hash-value 115 | either color <> opening-result/1 [ 116 | opening-result: copy [] 117 | ][ 118 | opening-result: opening-result/2 119 | ] 120 | ] 121 | opening-result 122 | ] 123 | 124 | ;************** 125 | ; Sorting moves 126 | ;************** 127 | order-moves-by-score: function [ 128 | "insertion-sort" 129 | array-moves [block!] 130 | m [integer!] ; which column to sort on, the last 131 | /desc 132 | /local i [integer!] j [integer!] n [integer!] 133 | move [block!] 134 | logic-sort [logic!] 135 | ][ 136 | either logic! = type? array-moves/1/(m) [ 137 | logic-sort: true 138 | forall array-moves [ 139 | move: first array-moves 140 | either move/(m) [ 141 | move/(m): 0 142 | ][ 143 | move/(m): 1 144 | ] 145 | ] 146 | ][ 147 | logic-sort: false 148 | ] 149 | 150 | n: length? array-moves 151 | i: n - 1 ; start at end working to first item 152 | while [i >= 1][ 153 | move: array-moves/:i 154 | j: i 155 | while [ all [ n > j 156 | any [ all [ desc 157 | move/(m) < array-moves/(j + 1)/(m) ] 158 | all [ not desc 159 | move/(m) > array-moves/(j + 1)/(m) ]]] 160 | ][ 161 | array-moves/:j: array-moves/(j + 1) 162 | j: j + 1 163 | ] 164 | array-moves/:j: move 165 | i: i - 1 166 | ] 167 | 168 | if logic-sort [ ; now reset to logic values 169 | forall array-moves [ 170 | move: first array-moves 171 | either 0 = move/(m) [ 172 | move/(m): true 173 | ][ 174 | move/(m): false 175 | ] 176 | ] 177 | ] 178 | 179 | ] 180 | 181 | ;*************** 182 | ; Choosing moves 183 | ;*************** 184 | choose-move: function [ 185 | "Choose moves from the openingbook, or other similar sources" 186 | found-moves [block!] 187 | return: [block!] 188 | /local a [integer!] total-chance [integer!] chosen-move [block!] 189 | ][ 190 | chosen-move: copy [] 191 | a: random 100 192 | total-chance: 0 193 | foreach [move value] found-moves [ 194 | total-chance: total-chance + value 195 | if all [0 = length? chosen-move 196 | a < total-chance ][ 197 | chosen-move: move 198 | ] 199 | ] 200 | if 0 = length? chosen-move [chosen-move: first found-moves] 201 | chosen-move 202 | ] 203 | 204 | choose-move-from-list: function [ 205 | "Choose moves from result of iterative deepening search" 206 | move-list [block!] 207 | return: [block!] 208 | /local a [integer!] chosen-move [block!] max-score [integer!] 209 | number-of-moves [integer!] 210 | random-move [integer!] 211 | choose-from-top [integer!] 212 | ][ 213 | number-of-moves: length? move-list 214 | either 0 = number-of-moves [ 215 | return ["Lost"] 216 | ][ 217 | either 1 = number-of-moves [ 218 | return move-list/1 219 | ][ 220 | a: length? move-list/1 221 | 222 | ; if there are moves with max score choose (randomly) from these moves 223 | max-score: move-list/1/:a 224 | 225 | ; if there are only losing moves, choose from the best moves with longest non-losing series 226 | if max-score = MINUS-INFINITY [ 227 | ; on level a - 1 there could be more than 1 move with an equal score 228 | ; as all moves are losing it does not really matter which one to choose, 229 | ; we could maybe try the move leaving the most complex position on the board making it 230 | ; harder to the opposite (human side) to find the winning move 231 | if a <= MOVE-ELEMENTS [ 232 | ; This was the only level before all moves faced a losing countermove 233 | ; in no way this means a human will always find the winning move :-) 234 | random-move: random number-of-moves 235 | return move-list/:random-move 236 | ] 237 | a: a - 1 238 | max-score: move-list/1/:a 239 | ; because we use a backwards insertion sort the order of moves from the earlier sort is still present! 240 | ; so the values are still ordered with the score in this position descending! 241 | ] 242 | ; now choose from top x best moves 243 | choose-from-top: 0 244 | 245 | ; Sure not forget the all in this while ;-) 246 | while [ all [not tail? move-list 247 | move-list/1/:a = max-score] ][ 248 | choose-from-top: choose-from-top + 1 249 | move-list: next move-list 250 | ] 251 | move-list: head move-list ; set list back to head position 252 | random-move: random choose-from-top 253 | 254 | return move-list/:random-move 255 | ] ] ] 256 | 257 | get-game-no-more-moves-value: does [ 258 | INFINITY 259 | ] 260 | 261 | ;*************** 262 | ; Seek algoritms 263 | ;*************** 264 | ;**************************************************************** 265 | ; Iterative Deepening Search 266 | ;**************************************************************** 267 | iterative-deepening-search: func [ 268 | in-board [block!] 269 | color [integer!] 270 | requested-depth [integer!] 271 | return: [block!] 272 | /local depth [integer!] 273 | found-moves [block!] 274 | local-ids-move-list [block!] 275 | beta-cutoff [logic!] 276 | ][ 277 | 278 | if requested-depth > MAX-DEPTH [requested-depth: MAX-DEPTH] 279 | if 1 > requested-depth [requested-depth: 1] 280 | 281 | ids-hash-code: calculate-hash-code in-board 282 | 283 | if in-opening-book? [ 284 | found-moves: lookup-opening-book ids-hash-code color 285 | either 0 < length? found-moves [ 286 | return choose-move found-moves 287 | ][ 288 | in-opening-book?: false 289 | ] 290 | ] 291 | 292 | winning-moves-found?: single-playable-move?: false 293 | all-moves-lose?: max-calculation-time-used?: false 294 | variant: copy [] 295 | depth: 0 296 | 297 | ; Make the moves list that we need to keep the bookkeeping for best move 298 | local-ids-move-list: make-move-list in-board color 299 | save-ids-move-list local-ids-move-list 300 | if 0 < CHECK-INDICATOR [ 301 | order-ids-move-list CHECK-INDICATOR 302 | ] 303 | order-ids-move-list/desc MOVE-ELEMENTS 304 | 305 | ; Now loop through increasing depths 306 | 307 | until [ 308 | depth: depth + 1 309 | print ["increasing iterative deepening search depth from " depth - 1 "to " depth] 310 | either 2 < depth [beta-cutoff: true] [beta-cutoff: false] 311 | 312 | principal-variation-search in-board color alpha beta depth variant true beta-cutoff ; depth as current-depth, true to add the score to the move 313 | 314 | ; Now order the moves using the value at given depth. The move itself has MOVE-ELEMENTS fields for the move description. 315 | ;either all not max-calculation-time-used not user-forced-break 316 | order-ids-move-list/desc MOVE-ELEMENTS + depth 317 | 318 | winning-moves-found?: winning-moves-found 319 | all-moves-lose?: all-moves-lose 320 | single-playable-move?: single-playable-move 321 | 322 | any [ 323 | depth >= requested-depth 324 | winning-moves-found? 325 | single-playable-move? 326 | all-moves-lose? 327 | max-calculation-time-used? 328 | ] 329 | ] 330 | 331 | choose-move-from-list ids-move-list 332 | ] 333 | 334 | ;****************************************** 335 | ; "I can't stand pat" for quiescence-search 336 | ;****************************************** 337 | global-stand-pat: 0 338 | 339 | set-stand-pat: func [ 340 | set-value [integer!] 341 | ][ 342 | global-stand-pat: set-value 343 | ] 344 | 345 | get-stand-pat: func [ 346 | return: [integer!] 347 | ][ 348 | global-stand-pat 349 | ] 350 | 351 | ;**************************************************************** 352 | ; Principle Variation Search for fail hard 353 | ;**************************************************************** 354 | principal-variation-search: function [ 355 | in-board [block!] 356 | color [integer!] 357 | alpha [integer!] 358 | beta [integer!] 359 | depth [integer!] 360 | variant [block!] 361 | base [logic!] 362 | beta-cutoff [logic!] 363 | return: [integer!] 364 | /local 365 | search-pv [logic!] 366 | i [integer!] 367 | j [integer!] 368 | piece-value [integer!] 369 | captured [integer!] 370 | pvs-move-list [block!] 371 | work-move-list [block!] 372 | move [block!] 373 | move-length [integer!] 374 | quiet-list [block!] 375 | result-block [block!] 376 | quiescence-result [integer!] 377 | idx [integer!] 378 | skip-to-next-move [logic!] 379 | ][ 380 | if 0 = depth [ 381 | ; Required search depth is reached, 382 | ; so not expanding into more moves by the current player 383 | ; Is position quiet? We only want to enter quiescence search if necessary. 384 | 385 | ; First we want to know if the position leaves us in a lost position 386 | quiescence-result: 0 387 | quiet-list: make-move-list in-board color 388 | 389 | either 0 = length? quiet-list [ 390 | ; opponent has not more moves, "we" won 391 | quiescence-result: MINUS-INFINITY 392 | ][ 393 | ; play all moves from the quiet-list and see if we left a one move win situation 394 | ; mate or pat in 1 move 395 | forall quiet-list [ 396 | move: first quiet-list 397 | ; Play the move 398 | i: move/2 399 | j: move/3 400 | piece-value: in-board/:i 401 | in-board/:i: 0 402 | captured: in-board/:j 403 | in-board/:j: piece-value 404 | 405 | ; Using anymoves? refinement returns a block with true or false in it. 406 | result-block: make-move-list/anymoves? in-board (1 - color) 407 | 408 | if 'false = result-block/1 [ 409 | ; there is a mate or pat move in this series of moves (for the opponent) 410 | quiescence-result: INFINITY 411 | ] 412 | 413 | ; Undo the move 414 | in-board/:i: piece-value 415 | in-board/:j: captured 416 | ] 417 | ] 418 | 419 | if 0 = quiescence-result [ 420 | ; No result found, so enter the quiescence routine now 421 | quiescence-result: negate quiescence-search in-board 1 - color alpha beta 422 | ] 423 | 424 | ; Returning a value here. 425 | ; This may look strange at first but the calling PVS function knows how to deal with this. 426 | return quiescence-result 427 | ] 428 | 429 | ; The search depth is larger than 0 from here 430 | search-pv: true 431 | 432 | either base [ ; Moves made in calling function, we can use a copy now 433 | pvs-move-list: read-ids-move-list 434 | ][ 435 | pvs-move-list: make-move-list in-board color 436 | ] 437 | 438 | if 0 = length? pvs-move-list [ 439 | ; no moves found 440 | ; for Xiangqi this means lost, for regular chess this could be pat, draw 441 | ; so we use a function here to get the correct value for the game 442 | return get-game-no-more-moves-value 443 | ] 444 | 445 | if 1 = length? pvs-move-list [ 446 | ; one move found, when in base call this will be the only move playable 447 | ; if not this move may be in a better variant than another move so still search options. 448 | if base [ 449 | ; It is the only move, so any value between MINUS-INFINITY and INFINITY would do(?). 450 | ; to be sure make it the evaluate value of the position 451 | ; !!attention: this needs to be adjusted to the color and who is playing 452 | return evaluate-board in-board 453 | ] 454 | ] 455 | 456 | order-moves-by-score pvs-move-list CHECK-INDICATOR 457 | 458 | idx: 0 459 | forall pvs-move-list [ 460 | idx: idx + 1 461 | ; First get some information on the move 462 | move: first pvs-move-list 463 | move-length: length? move 464 | move-value: move/:move-length 465 | 466 | ; Only do work on moves that do not have a losing score yet. 467 | either MINUS-INFINITY < move-value [ 468 | 469 | ; Play the move 470 | i: move/2 471 | j: move/3 472 | piece-value: in-board/:i 473 | in-board/:i: 0 474 | captured: in-board/:j 475 | in-board/:j: piece-value 476 | 477 | variant: append/only variant move 478 | 479 | either search-pv [ 480 | score: negate principal-variation-search in-board (1 - color) negate beta negate alpha (depth - 1) variant false beta-cutoff 481 | ][ 482 | score: negate principal-variation-search in-board (1 - color) negate (alpha - 1) negate alpha (depth - 1) variant false beta-cutoff 483 | if score > alpha [ ; in fail-soft all [score > alpha score < beta] is common 484 | score: negate principal-variation-search in-board (1 - color) negate beta negate alpha (depth - 1) variant false beta-cutoff ; re-search 485 | ] 486 | ] 487 | 488 | ; Undo the move 489 | in-board/:i: piece-value 490 | in-board/:j: captured 491 | 492 | ; Program faced a beta cut-off on the base level 493 | skip-to-next-move: false 494 | ; variant: head clear back tail variant 495 | if base [ 496 | move: append copy move score 497 | change-ids-move-list idx move 498 | ] 499 | ; forall does not need a next to loop thru all possible values 500 | ; test score 501 | ;if score >= beta [ 502 | if score > beta [ ; is this better?? 503 | variant: head clear back tail variant 504 | ; DO NOT CUT-OFF AT BASE LEVEL!! 505 | either any [not base 506 | beta-cutoff][ 507 | return beta ; fail-hard beta-cutoff 508 | ][ 509 | skip-to-next-move: true 510 | ] 511 | ] 512 | if not skip-to-next-move [ 513 | if score > alpha [ ; Perhaps this should read if score >= alpha 514 | alpha: score ; alpha acts like max in MiniMax 515 | search-pv: false ; it is recommend to set search-pv outside the score > alpha condition. 516 | ] 517 | ] 518 | variant: head clear back tail variant 519 | ][ 520 | ; score is another MINUS-INFINITY 521 | append move MINUS-INFINITY 522 | change-ids-move-list idx move 523 | ] 524 | ] 525 | return alpha ; fail-hard 526 | ] 527 | 528 | ;**************************************************************** 529 | ; Quiescence Search 530 | ;**************************************************************** 531 | quiescence-search: function [ 532 | "this function checks if possible countercaptures balance out the last move" 533 | in-board [block!] 534 | color [integer!] 535 | alpha [integer!] 536 | beta [integer!] 537 | return: [integer!] 538 | /local 539 | stand-pat [integer!] 540 | score [integer!] 541 | qs-captures-list [block!] 542 | capturemove [block!] 543 | i [integer!] 544 | j [integer!] 545 | piece-value [integer!] 546 | captured [integer!] 547 | ][ 548 | ; !!attention will this be dependend on color and player. 549 | stand-pat: evaluate-board in-board 550 | if color = 1 [stand-pat: negate stand-pat] 551 | 552 | qs-captures-list: copy [] 553 | qs-captures-list: make-move-list/capture in-board 1 - color 554 | 555 | ; It can be that there are no playable moves left 556 | either 0 = length? qs-captures-list [ 557 | ; Are there still normal moves possible, if not this position is lost 558 | either not generator-found-moves? [ 559 | ; No possible moves, so lost position 560 | alpha: MINUS-INFINITY 561 | ][ 562 | alpha: stand-pat 563 | ] 564 | ][ ; This should be done after there has been checked if the position is lost 565 | if stand-pat >= beta [ 566 | return beta 567 | ] 568 | if alpha < stand-pat [ 569 | alpha: stand-pat 570 | ] 571 | ] 572 | 573 | score: 0 574 | 575 | ; If the length of the capture-list was 0, we will be at the tail of the series 576 | while [not tail? qs-captures-list][ 577 | 578 | ; Play capturemove, testing validity is not needed because that was already done 579 | capturemove: first qs-captures-list 580 | i: capturemove/2 581 | j: capturemove/3 582 | piece-value: capturemove/1 583 | in-board/:i: 0 584 | captured: capturemove/4 585 | in-board/:j: piece-value 586 | 587 | score: negate quiescence-search in-board (1 - color) negate beta negate alpha 588 | 589 | ; Undo capturemove 590 | in-board/:i: piece-value 591 | in-board/:j: captured 592 | 593 | if score >= beta [ 594 | return beta 595 | ] 596 | if score > alpha [ 597 | alpha: score 598 | ] 599 | 600 | ;every_capture_has_been_examined 601 | qs-captures-list: next qs-captures-list 602 | ] 603 | 604 | return alpha 605 | ] -------------------------------------------------------------------------------- /xiangqi/xiangqi-common.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Common definitions for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-common.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.2 6 | date: "13-Aug-2015" 7 | ] 8 | 9 | ; Temporary helper functions while Red is in development 10 | #include %utils/xiangqi-helper-functions.red 11 | 12 | ;******************** 13 | ; General 14 | ;******************** 15 | 16 | ;********************************************************** 17 | ; The color representing red/white is 0 black/blue is 1 18 | ; For GUI just RED and BLACK conflicted with the predefined 19 | ; colors (255.0.0 and 0.0.0), so redefined here 20 | ;********************************************************** 21 | RED-0: 0 22 | BLACK-1: 1 23 | 24 | ;******************** 25 | ; Pieces 26 | ;******************** 27 | BLACK-PAWN: BLACK-1 + RED-PAWN: PAWN: 2 28 | BLACK-CANON: BLACK-1 + RED-CANON: CANON: 4 29 | BLACK-CHARIOT: BLACK-1 + RED-CHARIOT: CHARIOT: 8 30 | BLACK-KNIGHT: BLACK-1 + RED-KNIGHT: KNIGHT: 16 31 | BLACK-ELEPHANT: BLACK-1 + RED-ELEPHANT: ELEPHANT: 32 32 | BLACK-ADVISOR: BLACK-1 + RED-ADVISOR: ADVISOR: 64 33 | BLACK-KING: BLACK-1 + RED-KING: KING: 128 34 | ROOK: 8 35 | 36 | ;******************** 37 | ; The board 38 | ;******************** 39 | empty-board: [ 40 | 0 0 0 0 0 0 0 0 0 0 41 | 0 0 0 0 0 0 0 0 0 0 42 | 0 0 0 0 0 0 0 0 0 0 43 | 0 0 0 0 0 0 0 0 0 0 44 | 0 0 0 0 0 0 0 0 0 0 45 | 0 0 0 0 0 0 0 0 0 0 46 | 0 0 0 0 0 0 0 0 0 0 47 | 0 0 0 0 0 0 0 0 0 0 48 | 0 0 0 0 0 0 0 0 0 0 49 | ] 50 | 51 | start-board: [ 52 | 8 0 0 2 0 0 3 0 0 9 53 | 16 0 4 0 0 0 0 5 0 17 54 | 32 0 0 2 0 0 3 0 0 33 55 | 64 0 0 0 0 0 0 0 0 65 56 | 128 0 0 2 0 0 3 0 0 129 57 | 64 0 0 0 0 0 0 0 0 65 58 | 32 0 0 2 0 0 3 0 0 33 59 | 16 0 4 0 0 0 0 5 0 17 60 | 8 0 0 2 0 0 3 0 0 9 61 | ] 62 | 63 | ;******************** 64 | ; Evaluation 65 | ;******************** 66 | ;******************** 67 | ; Piece values 68 | ;******************** 69 | comment { 70 | Piece values and position tables are from ELP document 71 | http://www.csie.ndhu.edu.tw/~sjyen/Papers/2004CCC.pdf 72 | } 73 | VALUE-KING: 9000 74 | VALUE-ADVISOR: 120 75 | VALUE-ELEPHANT: 120 76 | VALUE-KNIGHT: 270 77 | VALUE-CHARIOT: 600 78 | VALUE-CANON: 285 79 | VALUE-PAWN: 30 ; relative values are influencenced by position tables 80 | 81 | ;******************** 82 | ; Position tables 83 | ;******************** 84 | comment { 85 | Only position tables for white/red are needed, the ones for blue/black are implicit because of symmetry. 86 | No table for Elephant, Advisor and King needed, these have limited places to go and must go where needed. 87 | } 88 | 89 | position-values-rook: [ 90 | -2 8 4 6 12 12 12 12 16 14 91 | 10 4 8 10 16 14 18 12 20 14 92 | 6 8 6 8 14 12 14 12 18 12 93 | 14 16 14 14 20 18 22 18 24 18 94 | 12 8 12 14 20 18 22 18 26 16 95 | 14 16 14 14 20 18 22 18 24 18 96 | 6 8 6 8 14 12 14 12 18 12 97 | 10 4 8 10 16 14 18 12 20 14 98 | -2 8 4 6 12 12 12 12 16 14 99 | ] 100 | 101 | position-values-knight: [ 102 | 0 0 4 2 4 6 8 12 4 4 103 | -4 2 2 6 12 16 24 14 10 8 104 | 0 4 8 8 16 14 18 16 28 16 105 | 0 4 8 6 14 18 24 20 16 12 106 | 0 -2 4 10 12 16 20 18 8 4 107 | 0 4 8 6 14 18 24 20 16 12 108 | 0 4 8 8 16 14 18 16 28 16 109 | -4 2 2 6 12 16 24 14 10 8 110 | 0 0 4 2 4 6 8 12 4 4 111 | ] 112 | 113 | position-values-cannon: [ 114 | 0 0 4 0 -2 0 0 2 2 6 115 | 0 2 0 0 0 0 0 2 2 4 116 | 2 4 8 0 4 0 -2 0 0 0 117 | 6 6 6 2 2 2 4 -10 -4 -10 118 | 6 6 10 4 6 8 10 -8 -14 -12 119 | 6 6 6 2 2 2 4 -10 -4 -10 120 | 2 4 8 0 4 0 -2 0 0 0 121 | 0 2 0 0 0 0 0 2 2 4 122 | 0 0 4 0 -2 0 0 2 2 6 123 | ] 124 | 125 | position-values-pawn: [ 126 | 0 0 0 0 2 6 10 14 18 0 127 | 0 0 0 0 0 12 20 26 36 3 128 | 0 0 0 -2 8 18 30 42 56 6 129 | 0 0 0 0 0 18 34 60 80 9 130 | 0 0 0 4 8 20 40 80 120 12 131 | 0 0 0 0 0 18 34 60 80 9 132 | 0 0 0 -2 8 18 30 42 56 6 133 | 0 0 0 0 0 12 20 26 36 3 134 | 0 0 0 0 2 6 10 14 18 0 135 | ] 136 | 137 | ;******************** 138 | ; Best move 139 | ;******************** 140 | ;******************** 141 | ; Search depth 142 | ;******************** 143 | MAX-DEPTH: 4 144 | search-depth: MAX-DEPTH 145 | 146 | init-search-depth: func [ 147 | depth [integer!] 148 | ][ 149 | if depth > MAX-DEPTH [depth: MAX-DEPTH] 150 | search-depth: depth 151 | ] 152 | 153 | init-search-depth max-depth 154 | 155 | ;******************** 156 | ; Evaluation 157 | ;******************** 158 | MINUS-INFINITY: negate INFINITY: 99999 159 | alpha: MINUS-INFINITY 160 | beta: INFINITY 161 | 162 | ;******************************* 163 | ; Various best move and gameplay 164 | ;******************************* 165 | in-opening-book?: true 166 | 167 | time-limit: false ; time limited gameplay 168 | time-moves: 40 169 | time-total: 3600 ; 60 minutes in seconds, 7200 is 120 minutes 170 | time-per-move: time-total / time-moves ; 90 seconds per move 171 | 172 | winning-moves-found?: single-playable-move?: false 173 | all-moves-lose?: max-calculation-time-used?: false 174 | -------------------------------------------------------------------------------- /xiangqi/xiangqi-console.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Console program for Xiangqi" 3 | filename: %xiangqi-console.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.2.1 6 | date: "17-Aug-2015" 7 | ] 8 | 9 | ; Import function 'ask and time for initializing random numbers 10 | #include %../bind/C-library/ANSI.red 11 | 12 | ; Seed the random numbers, use the seconds from now/precise from the binding 13 | ; unfortunately not more precise yet but this is more than enough for our use. 14 | seconds: remainder now/precise 65536 15 | random/seed seconds 16 | 17 | ; Import the xiangqi programs 18 | 19 | ; Common definitions 20 | #include %xiangqi-common.red 21 | 22 | ; Move generation 23 | #include %xiangqi-move-common.red 24 | #include %xiangqi-moves.red 25 | 26 | ; Position evaluation 27 | #include %xiangqi-evaluate.red 28 | 29 | ; Hash calculations 30 | #include %xiangqi-hash.red 31 | 32 | ; Opening book information 33 | #include %xiangqi-open.red 34 | 35 | ; Notation conversion and conversion between board and screen values of fields 36 | #include %xiangqi-convertions.red 37 | 38 | ; Calculate the best move using a PVS like algorithm 39 | #include %xiangqi-best-move.red 40 | 41 | ; Initialize variables for a new game here 42 | init-xiangqi-display-set/standard 43 | 44 | ; turn on/off opening book 45 | in-opening-book: true 46 | 47 | ; Board, side to play, moves 48 | ; First make items in 'global' scope 49 | player-to-move: RED-0 50 | move-number: 1 51 | autoplay: true 52 | move-history: copy [] 53 | computer-has: BLACK-1 54 | search-depth: 2 ; MAX-DEPTH - 1 55 | console-board: copy start-board 56 | inactivity-counter: 0 57 | show-board?: true 58 | show-moves?: true 59 | 60 | ; And set them in the init function 61 | start-new-game: func [ 62 | ][ 63 | player-to-move: RED-0 64 | move-number: 1 65 | autoplay: true 66 | move-history: copy [] 67 | computer-has: BLACK-1 68 | answer: ask "Do you want to play with Red/White, computer has Blue/Black? (Y/N)" 69 | either #"N" = first uppercase answer [ 70 | computer-has: RED-0 71 | print "You have Blue/Black (Lowercase pieces) and the computer has White/Red." 72 | ][ 73 | print "You have White/Red (Uppercase pieces) and the computer has Blue/Black." 74 | ] 75 | search-depth: 2 ; MAX-DEPTH - 1 76 | console-board: copy start-board 77 | inactivity-counter: 0 78 | show-board?: true 79 | show-moves?: true 80 | ] 81 | 82 | start-new-game 83 | 84 | ;****************** 85 | ; Process the input 86 | ;****************** 87 | ;process-input: func [ 88 | CMD-AGAIN: 0 89 | CMD-QUIT: 1 90 | CMD-BOARD: 2 91 | CMD-MOVES: 3 92 | CMD-HELP: 4 93 | CMD-UNDO: 5 94 | CMD-AUTO: 6 95 | CMD-COMPUTE: 7 96 | CMD-NEW: 8 97 | CMD-LEVEL: 9 98 | CMD-PLAY: 10 99 | CMD-SWAP: 11 100 | CMD-HISTORY-RECORD: 12 ; "R" recorded 101 | 102 | answer-to-command: function [ 103 | answer [string!] 104 | return: [string!] 105 | ][ 106 | ;print ["answer-input is " answer] 107 | answer: uppercase answer 108 | if any [answer = "Q" 109 | answer = "QUIT"][return CMD-QUIT] 110 | if any [answer = "B" 111 | answer = "BOARD"][return CMD-BOARD] 112 | if any [answer = "H" 113 | answer = "HELP"][return CMD-HELP] 114 | if any [answer = "M" 115 | answer = "MOVES"][return CMD-MOVES] 116 | if any [answer = "U" 117 | answer = "UNDO"][return CMD-UNDO] 118 | if any [answer = "A" 119 | answer = "AUTO"][return CMD-AUTO] 120 | if any [answer = "C" 121 | answer = "COMPUTE"][return CMD-COMPUTE] ; Play 122 | if any [ #"L" = first answer 123 | answer = "LEVEL"][return CMD-LEVEL] 124 | if any [answer = "N" 125 | answer = "NEW"][return CMD-NEW] 126 | if any [answer = "R" 127 | answer = "RECORD" 128 | answer = "HIST" 129 | answer = "HISTORY"][return CMD-HISTORY-RECORD] 130 | return CMD-AGAIN 131 | ] 132 | 133 | console-help-string: { 134 | Available commands: 135 | choose the move number to select your move from the shown moves 136 | H HELP - This help message 137 | B BOARD - Show the board 138 | M MOVES - Show the available moves 139 | N NEW - Start a new game 140 | L LEVEL - Change the search depth or program level 141 | C COMPUTE - Let the program compute a best move 142 | Q QUIT - Exit the program 143 | } 144 | 145 | check-inactivity: func [ 146 | ][ 147 | inactivity-counter: inactivity-counter + 1 148 | if 4 < inactivity-counter [ 149 | print "Use H or HELP for help, Q to stop/quit/end the program" 150 | inactivity-counter: 0 151 | ] 152 | ] 153 | 154 | ;********************* 155 | ; Main loop until quit 156 | ;********************* 157 | ready?: false 158 | show-board?: true 159 | show-moves?: true 160 | 161 | until [ 162 | move-list: make-move-list console-board player-to-move 163 | either 0 = length? move-list [ 164 | print ["No more legal moves possible for" either RED-0 = player-to-move ["Red"]["Black"]] 165 | print ["It seems that" either player-to-move = computer-has ["you"]["I"] "have won this game!"] 166 | raw-answer: ask "Play a new game? (Y/N)" 167 | answer: load raw-answer 168 | if string! = type? answer [ 169 | answer: uppercase first answer 170 | ] 171 | either #"Y" = answer [ 172 | start-new-game 173 | ][ 174 | ready?: true 175 | ] 176 | ][ 177 | if show-board? [display-board console-board] 178 | if show-moves? [ 179 | ;move-list: make-move-list console-board player-to-move 180 | 181 | number-possible-moves: length? move-list 182 | print ["number of possible moves" number-possible-moves] 183 | print compose-console-move-list console-board move-list 184 | ] 185 | show-board?: false 186 | show-moves?: false 187 | 188 | either computer-has = player-to-move [ 189 | ; compute best move using IDS 190 | print ["Computing move for " either 0 = player-to-move ["White/Red "]["Blue/Black"] "at level " search-depth] 191 | computed-move: iterative-deepening-search console-board player-to-move search-depth 192 | player-to-move: 1 - player-to-move 193 | either 2 = length? computed-move [ ; The move comes from a (opening) book. 194 | i: computed-move/1 195 | j: computed-move/2 196 | ][ 197 | i: computed-move/2 198 | j: computed-move/3 199 | ] 200 | print ["I played the move" notation-to-chinese console-board i j ] 201 | ; play the computed move 202 | piece-value: console-board/:i 203 | console-board/:i: 0 204 | captured: console-board/:j 205 | console-board/:j: piece-value 206 | 207 | show-board?: true 208 | show-moves?: true 209 | ][ 210 | raw-answer: ask "Your move please (H for Help, Q to quit) >" 211 | answer: load raw-answer 212 | either integer! = type? answer [ 213 | maximum-input-move: length? move-list 214 | either all [ 215 | 0 < answer 216 | maximum-input-move >= answer][ 217 | player-move: move-list/:answer 218 | ; play the given move 219 | i: player-move/2 220 | j: player-move/3 221 | piece-value: console-board/:i 222 | console-board/:i: 0 223 | captured: console-board/:j 224 | console-board/:j: piece-value 225 | 226 | show-board?: true 227 | player-to-move: 1 - player-to-move 228 | ][ 229 | print "I did not understand your choice" 230 | check-inactivity 231 | ] 232 | ][ 233 | answer: uppercase raw-answer 234 | if string! = type? raw-answer[ 235 | raw-answer: uppercase raw-answer 236 | ] 237 | command-or-move: answer-to-command raw-answer 238 | switch command-or-move [ 239 | 0 [ ; CMD-AGAIN, nothing done perhaps quit after 5 consecutive occurences? 240 | check-inactivity 241 | ] 242 | 1 [ ; CMD-QUIT 243 | print "Quitting now! Bye!" 244 | ready?: true 245 | ] 246 | 2 [ ; CMD-BOARD 247 | show-board?: true 248 | ] 249 | 3 [ ; CMD-MOVES 250 | show-moves?: true 251 | ] 252 | 4 [ ; CMD-HELP 253 | print console-help-string 254 | ] 255 | ;CMD-UNDO: 5 256 | ;CMD-AUTO: 6 257 | 7 [ ;CMD-COMPUTE: 7 ; computes best move 258 | computer-has: 1 - computer-has ; change colors 259 | ] 260 | 8 [ ;CMD-NEW: 8 261 | raw-answer: ask "This starts a new game. Are you sure (Y/N)" 262 | answer: load raw-answer 263 | if string! = type? raw-answer [ 264 | answer: uppercase first raw-answer 265 | ] 266 | if #"Y" = answer [ 267 | start-new-game 268 | ] 269 | ] 270 | 9 [ ;CMD-LEVEL: 9 271 | print ["Current searchdepth/playlevel is: " search-depth] 272 | raw-answer: ask "Give new search depth > " 273 | answer: load raw-answer 274 | print type? answer 275 | either all [integer! = type? answer 276 | 0 > answer 277 | MAX-DEPTH <= answer][ 278 | init-search-depth answer 279 | print ["Search depth/level now set to" search-depth] 280 | ][ 281 | print "Answer not understood. Search depth not changed." 282 | ] 283 | ] 284 | ;CMD-PLAY: 10 285 | ;CMD-SWAP: 11 286 | ;CMD-HISTORY-RECORD: 12 287 | ] 288 | ] 289 | ] 290 | ] 291 | 292 | ready? 293 | ] 294 | -------------------------------------------------------------------------------- /xiangqi/xiangqi-convertions.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Conversions for GUI and notation for Xiangqi aka Chinese Chess" 3 | filename: %xiangqi-convertions.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.6.0 6 | date: "26-Nov-2015" 7 | ] 8 | ;************************************************** 9 | ; Routines for helping with GUI and I/O interaction 10 | ;************************************************** 11 | 12 | ; return x, y coordinates from fieldnumber 13 | ; Red supports the pair! type since version 0.6.0 14 | field-to-xy: function [ 15 | field [integer!] 16 | return: [pair!] 17 | /local 18 | out [pair!] 19 | ][ 20 | out: -1x-1 21 | if any [field < 1 22 | field > 90][return out ] 23 | out/1: ( field - 1 ) / 10 24 | out/2: 9 - remainder (field - 1) 10 25 | out 26 | ] 27 | 28 | ; return fieldnumber from x, y fieldcoordinates 29 | xy-to-field: function [ 30 | xy [pair!] 31 | return: [integer!] 32 | /local field 33 | ][ 34 | field: xy/1 * 10 + 10 - xy/2 35 | ] 36 | 37 | ; When a player selects a field, and there is a piece on this field, 38 | ; the program can show the legitimate moves of this piece. 39 | ; For each field with a piece on it that has valid moves, 40 | ; the destination fields are collected by this function 41 | ; so the destination fields can quickly be looked up and shown. 42 | ; Note: this is not the list for displaying moves in console mode 43 | ; so the user can choose a move by selecting a number 44 | display-moves-list: function [ 45 | move-list [block!] 46 | return: [block!] 47 | /local previous-piece [integer!] display-list [block!] dest-block [block!] 48 | ][ 49 | previous-piece: 0 50 | display-list: copy [] 51 | dest-block: copy [] 52 | 53 | if 1 > length? move-list [ return copy [] ] 54 | foreach move move-list [ 55 | if previous-piece <> move/2 [ ; new piece 56 | if 0 < previous-piece [ ; not first to prevent an empty block at beginning 57 | display-list: append display-list previous-piece 58 | display-list: append/only display-list dest-block 59 | ] 60 | ; clear the destinations block 61 | dest-block: copy [] 62 | previous-piece: move/2 63 | ] 64 | ; Append the xy coordinate of the field to the destinations 65 | ; not the destination field number to save recalculating every time 66 | dest-block: append dest-block field-to-xy move/3 67 | ] 68 | ; add the last info too 69 | display-list: append display-list move/2 70 | display-list: append/only display-list dest-block 71 | ] 72 | 73 | ;*************************** 74 | ; Routine to print the board 75 | ;*************************** 76 | print-rows: [ 77 | [10 20 30 40 50 60 70 80 90] 78 | [9 19 29 39 49 59 69 79 89] 79 | [8 18 28 38 48 58 68 78 88] 80 | [7 17 27 37 47 57 67 77 87] 81 | [6 16 26 36 46 56 66 76 86] 82 | [5 15 25 35 45 55 65 75 85] 83 | [4 14 24 34 44 54 64 74 84] 84 | [3 13 23 33 43 53 63 73 83] 85 | [2 12 22 32 42 52 62 72 82] 86 | [1 11 21 31 41 51 61 71 81] 87 | ] 88 | 89 | print-board: function [ 90 | "Print the board using the internal representation" 91 | in-board [block!] 92 | ][ 93 | print compose-output-board-internal in-board 94 | ] 95 | 96 | compose-output-board-internal: func [ 97 | "Offer the board using the internal representation" 98 | in-board [block!] 99 | return: [string!] 100 | /local 101 | field-value [integer!] 102 | row-string [string!] 103 | output-string [string!] 104 | ][ 105 | ; func because print-rows is a global block 106 | output-string: copy "" 107 | foreach row print-rows [ 108 | row-string: copy "" 109 | foreach field row [ 110 | field-value: in-board/:field 111 | multi-switch field-value [ 112 | 128 129 [ 113 | append row-string " " 114 | append row-string field-value 115 | ] 116 | 16 17 32 33 64 65 [ 117 | append row-string " " 118 | append row-string field-value 119 | ] 120 | 0 2 3 4 5 8 9 [ 121 | append row-string " " 122 | append row-string field-value 123 | ] 124 | ] 125 | ] 126 | append output-string row-string 127 | append output-string newline 128 | ] 129 | output-string 130 | ] 131 | 132 | hor-line: " ---------------------------- " 133 | xiangqi-display-set: copy "" 134 | 135 | init-xiangqi-display-set: func [ 136 | /standard 137 | /english 138 | /english2 139 | /soldier 140 | /general 141 | /sng 142 | /snmg 143 | ][ ;print ["init-xiangqi-display-set: " standard] 144 | xiangqi-display-set: ".PpCcRrHhEeAaKk" 145 | if standard [xiangqi-display-set: ".PpCcRrHhEeAaKk"] 146 | if english [xiangqi-display-set: ".PpCcRrNnEeAaKk"] 147 | if english2 [xiangqi-display-set: ".SsCcRrNnEeAaKk"] 148 | if soldier [xiangqi-display-set: ".SsCcRrHhEeAaKk"] 149 | if general [xiangqi-display-set: ".SsCcRrHhEeAaGg"] 150 | if sng [xiangqi-display-set: ".SsCcRrNnEeAaGg"] 151 | if snmg [xiangqi-display-set: ".SsCcRrNnEeMmGg"] 152 | ] 153 | 154 | init-xiangqi-display-set/standard 155 | 156 | ; Standard notation for piece that stays on the same row is the equal sign, but a dot "." is sometimes used as well. 157 | STANDARD-SAME-SIGN: copy "" 158 | 159 | set-standard-same-sign: func [ 160 | /dot 161 | ][ 162 | either dot [ 163 | STANDARD-SAME-SIGN: "." 164 | ][ 165 | STANDARD-SAME-SIGN: "=" 166 | ] 167 | ] 168 | 169 | set-standard-same-sign 170 | 171 | display-board: function [ 172 | "Print the board in a readable format" 173 | in-board [block!] 174 | ][ 175 | print compose-output-board-display in-board 176 | ] 177 | 178 | compose-output-board-display: func [ 179 | "Offer the board in a readable format to be printed or logged" 180 | in-board [block!] 181 | return: [string!] 182 | /numbers 183 | /local 184 | count [integer!] 185 | number [integer!] 186 | number-string [string!] 187 | helpstring [string!] 188 | output-string [string!] 189 | set-index [integer!] 190 | ][ ;print "compose-output-board-display" print xiangqi-display-set 191 | output-string: copy "" 192 | append output-string " 1 2 3 4 5 6 7 8 9" 193 | append output-string newline 194 | append output-string hor-line 195 | append output-string newline 196 | ;print output-string 197 | repeat count 10 [ 198 | number-string: copy " " 199 | helpstring: copy " " 200 | foreach number print-rows/:count [ 201 | set-index: switch in-board/:number [ 202 | 0 [1] 203 | 2 [2] 204 | 3 [3] 205 | 4 [4] 206 | 5 [5] 207 | 8 [6] 208 | 9 [7] 209 | 16 [8] 210 | 17 [9] 211 | 32 [10] 212 | 33 [11] 213 | 64 [12] 214 | 65 [13] 215 | 128 [14] 216 | 129 [15] 217 | ] 218 | append number-string helpstring 219 | append number-string xiangqi-display-set/:set-index 220 | ] 221 | append output-string number-string 222 | append output-string newline 223 | 224 | if numbers [ 225 | number-string: copy " " 226 | foreach number print-rows/:count [ 227 | if number < 10 [ append number-string " " ] 228 | append number-string " " 229 | append number-string number 230 | ] 231 | append number-string number-string 232 | ] 233 | ] 234 | append output-string hor-line 235 | append output-string newline 236 | append output-string " 9 8 7 6 5 4 3 2 1" 237 | output-string 238 | ] 239 | 240 | ;******************************** 241 | ; Routines to translate notations 242 | ;******************************** 243 | ; Our field notation to Chinese notation 244 | notation-to-chinese: function [ 245 | in-board [block!] 246 | start-field [integer!] 247 | end-field [integer!] 248 | return: [string!] 249 | /local piece [integer!] 250 | notation [string!] 251 | start-line [integer!] 252 | start-row [integer!] 253 | end-line [integer!] 254 | end-row [integer!] 255 | sign [string!] 256 | set-index [integer!] 257 | ][ 258 | if start-field = end-field [return "INVALID MOVE"] 259 | piece: in-board/:start-field 260 | set-index: multi-switch piece [ 261 | 2 3 [2] 262 | 4 5 [4] 263 | 8 9 [6] 264 | 16 17 [8] 265 | 32 33 [10] 266 | 64 65 [12] 267 | 128 129 [14] 268 | ] 269 | notation: copy "" 270 | append notation xiangqi-display-set/:set-index 271 | start-line: 1 + ((start-field - 1) / 10) ; black line number 272 | if even? piece [start-line: 10 - start-line] ; white counts from right to left 273 | append notation start-line 274 | end-line: 1 + ((end-field - 1) / 10) 275 | if even? piece [end-line: 10 - end-line] 276 | start-row: 1 + remainder (start-field - 1) 10 277 | end-row: 1 + remainder (end-field - 1) 10 278 | either start-row = end-row [ 279 | sign: STANDARD-SAME-SIGN 280 | append notation sign 281 | append notation end-line 282 | ][ 283 | either any [all [ even? piece 284 | end-row > start-row ] 285 | all [ odd? piece 286 | end-row < start-row ] 287 | ][ 288 | sign: "+" 289 | ][ 290 | sign: "-" 291 | ] 292 | append notation sign 293 | either element-in-collection piece [16 17 32 33 64 65] [ 294 | append notation end-line 295 | ][ 296 | append notation absolute end-row - start-row 297 | ] 298 | ] 299 | notation 300 | ] 301 | 302 | red-pawns-on: [ 303 | [ 4 5 6 7 8 9 10] 304 | [ 16 17 18 19 20] 305 | [24 25 26 27 28 29 30] 306 | [ 36 37 38 39 40] 307 | [44 45 46 47 48 49 50] 308 | [ 56 57 58 59 60] 309 | [64 65 66 67 68 69 70] 310 | [ 76 77 78 79 80] 311 | [84 85 86 87 88 89 90] 312 | ] 313 | 314 | black-pawns-on: [ 315 | [ 1 2 3 4 5 6 7] 316 | [11 12 13 14 15 ] 317 | [21 22 23 24 25 26 27] 318 | [31 32 33 34 35 ] 319 | [41 42 43 44 45 46 47] 320 | [51 52 53 54 55 ] 321 | [61 62 63 64 65 66 67] 322 | [71 72 73 74 75 ] 323 | [81 82 83 84 85 86 87] 324 | ] 325 | 326 | find-line-with-double-piece: function [ 327 | in-board [block!] 328 | piece [integer!] 329 | return: [integer!] 330 | /local 331 | value [integer!] 332 | line [integer!] 333 | count [integer!] 334 | pawns-on-fields [block!] 335 | ][ 336 | value: 0 337 | line: 0 338 | ; It says this ia a rare occasion so efficiency is less important 339 | ; Piece cannot be the King/General for each player has only 1 340 | ; If piece is not pawn there are maximal 2 of those per player 341 | ; so if we find one, the other will be on the same file 342 | ; If it is a pawn we need to find both pawns on a file 343 | either PAWN = (PAWN and piece) [ 344 | pawns-on-fields: either 1 = (BLACK-1 and piece)[black-pawns-on][red-pawns-on] 345 | foreach fields pawns-on-fields [ 346 | count: 0 347 | value: value + 1 348 | foreach field fields [ 349 | if piece = in-board/:field [count: count + 1] 350 | ] 351 | if 1 < count [line: value] 352 | ] 353 | ][ 354 | count: 0 355 | until [ 356 | count: count + 1 357 | if piece = in-board/:count [ 358 | line: 1 + (count - 1 / 10) 359 | count: 91 360 | ] 361 | count > 90 362 | ] 363 | ] 364 | 10 - line 365 | ] 366 | ;find-double-piece-on-line: closest farthest 367 | 368 | ; Chinese notation to number notation 369 | notation-to-numbers: function [ 370 | notation [string!] 371 | player-to-move [integer!] 372 | in-board [block!] 373 | return: [block!] 374 | /local piece [integer!] 375 | line [integer!] 376 | i [integer!] 377 | field [integer!] 378 | start-field [integer!] 379 | end-field [integer!] 380 | piece-found [logic!] 381 | result [block!] 382 | sign [string!] 383 | dest [integer!] 384 | shift-line [integer!] 385 | first-position [char! string! word!] 386 | double [char! string!] 387 | ][ 388 | result: copy [] 389 | first-position: first notation 390 | piece: multi-switch first-position [ 391 | #"P" #"p" 392 | #"S" #"s" [ 2 ] 393 | #"C" #"c" [ 4 ] 394 | #"R" #"r" [ 8 ] 395 | #"H" #"h" 396 | #"N" #"n" [ 16 ] ; N and n as service 397 | #"E" #"e" [ 32 ] 398 | #"A" #"a" [ 64 ] 399 | #"K" #"k" 400 | #"G" #"g" [ 128 ] 401 | ] 402 | piece: piece + player-to-move 403 | ;print ["Piece value is now" piece " for first-position:" first-position type? first-position] 404 | notation: next notation 405 | double: first notation ; use this helperfield for the rare case there is a double piece on the same file 406 | line: multi-switch double [ 407 | #"0" [0] 408 | #"1" [1] 409 | #"2" [2] 410 | #"3" [3] 411 | #"4" [4] 412 | #"5" [5] 413 | #"6" [6] 414 | #"7" [7] 415 | #"8" [8] 416 | #"9" [9] 417 | ; on rare occasions two of the same (color and kind) pieces are on the same file 418 | ; This will be noted by a "-" or a "+" sign, meaning closest or farthest piece 419 | ; It is up to the program what file this must be. 420 | #"-" #"+" [ find-line-with-double-piece in-board piece] 421 | ] 422 | if 0 = player-to-move [ line: 10 - line ] 423 | shift-line: line - 1 * 10 ; We use this to add 10*line to get fieldnumber 424 | notation: next notation 425 | sign: first notation 426 | direction: either #"-" = sign [-1][1] 427 | notation: next notation 428 | dest: switch first notation [ 429 | #"0" [0] 430 | #"1" [1] 431 | #"2" [2] 432 | #"3" [3] 433 | #"4" [4] 434 | #"5" [5] 435 | #"6" [6] 436 | #"7" [7] 437 | #"8" [8] 438 | #"9" [9] 439 | ] 440 | ; search piece in line 441 | 442 | next-field: either any[ all [BLACK-1 = (BLACK-1 and piece) 443 | #"-" = double] 444 | all [BLACK-1 <> (BLACK-1 and piece) 445 | #"+" = double]][ 446 | true 447 | ][ 448 | false 449 | ] 450 | 451 | piece-found: false 452 | i: 1 453 | until [ 454 | while [all [ not piece-found 455 | i < 11 ]][ 456 | field: i + shift-line 457 | if piece = in-board/:field [ 458 | either next-field[; Next!! 459 | next-field: false 460 | ][ 461 | piece-found: true 462 | start-field: field 463 | ; depending on piece type the dest means destination line or advance number of fields 464 | either any [#"=" = sign 465 | #"." = sign][ ; destination on same row (i) and destination line is meant 466 | if 0 = player-to-move [dest: 10 - dest] 467 | end-field: dest - 1 * 10 + i 468 | ][ ; or sign is +/- 469 | multi-switch piece [ 470 | 2 3 ; Pawn, always +1 471 | 4 5 ; Canon 472 | 8 9 ; Rook 473 | 128 129 ; King 474 | [ 475 | end-field: (power -1 player-to-move) * dest * direction + start-field 476 | ] 477 | 16 17 [ ; Horse. Horse, Advisor and Elephant never move vertical or horizontal 478 | if 0 = player-to-move [dest: 10 - dest] 479 | ;print ["Dest : " dest " Line:" line] 480 | if element-in-collection dest - line [-2 2] [ 481 | ;print ["collection -2 2 start-field" start-field "player-to-move" player-to-move "direction" direction] 482 | end-field: start-field + (10 * (dest - line)) + ((power -1 player-to-move) * direction ) 483 | ] 484 | if element-in-collection dest - line [-1 1] [ 485 | ;print ["collection -1 1 start-field" start-field "player-to-move" player-to-move "direction" direction] 486 | end-field: start-field + (10 * (dest - line)) + ((power -1 player-to-move) * direction * 2 ) 487 | ] 488 | ;print ["end field :" end-field] 489 | ] 490 | 32 33 [ ; Elephant two rows and two lines 491 | if 0 = player-to-move [dest: 10 - dest] 492 | ;end-field: start-field + ((power -1 player-to-move) * direction * 10 * (dest - line)) + ((power -1 player-to-move) * direction * 2) 493 | end-field: start-field + (direction * 10 * (dest - line)) + ((power -1 player-to-move) * direction * 2) 494 | ] 495 | 64 65 [ ; Advisor, one row and one line 496 | if 0 = player-to-move [dest: 10 - dest] 497 | ;end-field: start-field + ((power -1 player-to-move) * direction * 10 * (dest - line)) + ((power -1 player-to-move) * direction) 498 | end-field: start-field + (direction * 10 * (dest - line)) + ((power -1 player-to-move) * direction) 499 | ] 500 | ] 501 | ] 502 | ] 503 | ] 504 | i: i + 1 505 | ] 506 | if piece-found [ 507 | result: append result start-field 508 | result: append result end-field 509 | ] 510 | piece-found: false 511 | i > 10 512 | ] 513 | result 514 | ] 515 | 516 | ;******************* 517 | compose-output-move-list: function [ 518 | "Offer the moves list using the internal representation" 519 | moves-list [block!] 520 | return: [string!] 521 | /local 522 | output-string [string!] 523 | ][ 524 | output-string: copy "" 525 | foreach move moves-list [ 526 | append output-string form move 527 | append output-string newline 528 | ] 529 | output-string 530 | ] 531 | 532 | ; Note: this is the list for displaying moves in console mode 533 | ; so the user can choose a move by selecting a number 534 | ; selecting the correct move is easy from the original list taking the x'th element. 535 | compose-console-move-list: function [ 536 | "Make a string of numbered moves in Chinese notation" 537 | in-board [block!] 538 | moves-list [block!] 539 | return: [string!] 540 | /local 541 | count [integer!] 542 | dot-space [string!] 543 | output-string [string!] 544 | start-field [integer!] 545 | end-field [integer!] 546 | ][ 547 | count: 1 548 | output-string: copy "" 549 | dot-space: ". " 550 | foreach move move-list [ 551 | either 10 > count [ 552 | append output-string " " 553 | ][ 554 | append output-string " " 555 | ] 556 | append output-string count 557 | append output-string dot-space 558 | start-field: move/2 ; todo: check this 559 | end-field: move/3 560 | append output-string notation-to-chinese in-board start-field end-field 561 | if 0 = remainder count 4 [ 562 | append output-string newline 563 | ] 564 | count: count + 1 565 | ] 566 | output-string 567 | ] -------------------------------------------------------------------------------- /xiangqi/xiangqi-debug-log.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Definitions for debugging the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-debug-log.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "13-Aug-2015" 7 | ] 8 | 9 | ;************************************************************ 10 | ; Variables and functions to facilitate debugging and logging 11 | ;************************************************************ 12 | ; Sometimes it is needed to get some reporting on program state, debugging, 13 | ; knowing the moves and various values in the decision making process 14 | ; This can use some extra attention to unify various approaches. 15 | 16 | ;********** 17 | ; Debugging 18 | ;********** 19 | debug: true ; turn debugging on 20 | debug-level: 0 ; ( > 0 ) and off ( 0 ) 21 | 22 | init-debug: func [ 23 | /start 24 | /stop 25 | ][ 26 | debug: false 27 | if start [debug: true] 28 | ] 29 | 30 | ;******** 31 | ; Logging 32 | ;******** 33 | log-data: copy "" 34 | 35 | add-log-data: func [ 36 | data [string!] 37 | ][ 38 | ;print ["logging : " data] 39 | append log-data data 40 | append log-data newline 41 | ] 42 | 43 | logging-values: object [ 44 | logging-on: false 45 | list: false 46 | board: false 47 | variant: false 48 | moves: false 49 | ] 50 | 51 | logging: func [ ; logging on or off? 52 | /list 53 | /board 54 | /variant 55 | /moves 56 | return: [logic!] 57 | ][ 58 | if list [return logging-values/list] 59 | if board [return logging-values/board] 60 | if variant [return logging-values/variant] 61 | if moves [return logging-values/moves] 62 | return logging-values/logging-on 63 | ] 64 | 65 | set-logging-values: func [ 66 | set-value [logic!] 67 | /list 68 | /board 69 | /variant 70 | /moves 71 | /set-all 72 | ][ 73 | if any [set-all 74 | list ][logging-values/list: set-value] 75 | if any [set-all 76 | board ][logging-values/board: set-value] 77 | if any [set-all 78 | moves ][logging-values/moves: set-value] 79 | if any [set-all 80 | variant ][logging-values/variant: set-value] 81 | if any [set-all 82 | not any [list 83 | board 84 | moves 85 | variant]][logging-values/logging-on: set-value] 86 | ] 87 | 88 | ;********** 89 | ; Reporting 90 | ;********** 91 | reporting: off ; 92 | report-info: true ; 93 | 94 | info-area: object [ 95 | code: description: none 96 | ] 97 | 98 | init-info-area: does [ 99 | info-area/code: none 100 | info-area/description: none 101 | ] 102 | -------------------------------------------------------------------------------- /xiangqi/xiangqi-evaluate.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Position evaluation for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-evaluate.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.2.1 6 | date: "28-Sep-2015" 7 | needs: "%xiangqi-common.red #include via main program or testprogram" 8 | ] 9 | ;******************** 10 | ; Evaluation routines 11 | ;******************** 12 | get-piece-added-value: func [ 13 | board-piece [integer!] 14 | field [integer!] 15 | return: [integer!] 16 | ][ 17 | if BLACK-1 = (BLACK-1 and board-piece) [ field: 91 - field ] 18 | 19 | comment { ; this is how to do with directly valueing the black moves as negative 20 | ; but probably it is better not to negate here, instead leave that up to the pvs routine. 21 | switch board-piece [ 22 | 2 [ VALUE-PAWN + position-values-pawn/:field ] 23 | 3 [ negate ( VALUE-PAWN + position-values-pawn/:field ) ] 24 | 4 [ VALUE-CANON + position-values-cannon/:field ] 25 | 5 [ negate ( VALUE-CANON + position-values-cannon/:field ) ] 26 | 8 [ VALUE-CHARIOT + position-values-rook/:field ] 27 | 9 [ negate ( VALUE-CHARIOT + position-values-rook/:field ) ] 28 | 16 [ VALUE-KNIGHT + position-values-knight/:field ] 29 | 17 [ negate ( VALUE-KNIGHT + position-values-knight/:field ) ] 30 | 32 [ VALUE-ELEPHANT ] 31 | 33 [ negate VALUE-ELEPHANT ] 32 | 64 [ VALUE-ADVISOR] 33 | 65 [ negate VALUE-ADVISOR ] 34 | 128 [ VALUE-KING ] 35 | 129 [ negate VALUE-KING ] 36 | ] 37 | } 38 | multi-switch board-piece [ 39 | 2 3 [ VALUE-PAWN + position-values-pawn/:field ] 40 | 4 5 [ VALUE-CANON + position-values-cannon/:field ] 41 | 8 9 [ VALUE-CHARIOT + position-values-rook/:field ] 42 | 16 17 [ VALUE-KNIGHT + position-values-knight/:field ] 43 | 32 33 [ VALUE-ELEPHANT ] 44 | 64 65 [ VALUE-ADVISOR] 45 | 128 129 [ VALUE-KING ] 46 | ] 47 | ] 48 | 49 | evaluate-board: function [ 50 | "Simple evaluation routine for the entire board" 51 | board [block!] 52 | return: [integer!] 53 | /local i [integer!] moving-piece [integer!] piece-value [integer!] total-value [integer!] 54 | ][ 55 | ; for now no difference in red/black 56 | total-value: 0 57 | repeat i 90 [ 58 | moving-piece: board/:i 59 | if moving-piece > 0 [ 60 | piece-value: get-piece-added-value moving-piece i 61 | total-value: total-value + either even? moving-piece [piece-value][negate piece-value] 62 | ] 63 | ] 64 | 65 | total-value 66 | ] 67 | 68 | evaluate-move-value: function [ 69 | "Simple evaluation routine for how the move changes the board value" 70 | move [block!] 71 | return: [integer!] 72 | /local change-value [integer!] moving-piece [integer!] what-is-on-destination [integer!] move-value [integer!] 73 | from-field [integer!] destination-field [integer!] 74 | ][ 75 | ; a move is here the moving piece from field, destination field and the value of the board at the destination 76 | moving-piece: move/1 77 | from-field: move/2 78 | destination-field: move/3 79 | what-is-on-destination: move/4 80 | 81 | ; Calculate relative value of the move 82 | move-value: 0 83 | ; plus old position destination field ( <> 0 if capture of opposite piece) 84 | if 0 < what-is-on-destination [ 85 | change-value: get-piece-added-value what-is-on-destination destination-field 86 | move-value: move-value + change-value 87 | ] 88 | ; plus new position piece 89 | change-value: get-piece-added-value moving-piece destination-field 90 | 91 | move-value: move-value + change-value 92 | ; minus old position 93 | change-value: get-piece-added-value moving-piece from-field 94 | 95 | move-value: move-value - change-value 96 | ] 97 | -------------------------------------------------------------------------------- /xiangqi/xiangqi-hash.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Hash computing for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-hash.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "31-Oct-2014" 7 | documentation: "In file %docs/Xiangqi-hash.rtf" 8 | testfile: "Using file %test/xiangqi-hash-test.red" 9 | functions-description: { 10 | functions to be called: 11 | - calculate-hash-code 12 | input: board 13 | output: hash-code as string 14 | - calculate-new-hash-code-from-move 15 | input: board hash move-from move-to 16 | output: hash-code as string 17 | private functions: 18 | - sextant 19 | - init-hash 20 | - calculate-hash 21 | - calculate-new-hash-from-move 22 | - integer-to-base64 23 | - convert-to-base64 24 | used constants and variables 25 | - multiplication-table 26 | - hash-area 27 | - hash 28 | - empty-hash 29 | - base64-chars 30 | } 31 | ] 32 | 33 | comment { 34 | The sextant function. The idea is when a move is done the hash-value should be recalculated 35 | but the way we do this is only for the one or 2 sextants the move is affecting. 36 | } 37 | 38 | sextant: function [ 39 | "Compute the part of the board for this field" 40 | fieldnumber [integer!] 41 | return: [integer!] 42 | ] [ 43 | fieldnumber: fieldnumber - 1 44 | ( fieldnumber / 30 ) + either 4 < ( remainder fieldnumber 10) [4][1] 45 | ] 46 | 47 | comment { 48 | The idea is we can compute unique numbers for each sextant representing the parts of the 49 | board by multiplying the fieldnumber with the piece on it, and adding these values 50 | together for each sextant. The multiplication table helps making the values unique. 51 | } 52 | 53 | multiplication-table: [ 54 | 13 23 37 47 61 61 47 37 23 13 55 | 11 21 31 43 59 59 43 31 21 11 56 | 7 19 29 41 53 53 41 29 19 7 57 | 58 | 11 21 31 43 59 59 43 31 21 11 59 | 7 19 29 41 53 53 41 29 19 7 60 | 13 23 37 47 61 61 47 37 23 13 61 | 62 | 7 19 29 41 53 53 41 29 19 7 63 | 11 21 31 43 59 59 43 31 21 11 64 | 13 23 37 47 61 61 47 37 23 13 65 | ] 66 | 67 | ; Define the area for each hash value 68 | hash-area: [ 69 | [ 1 2 3 4 5 11 12 13 14 15 21 22 23 24 25] 70 | [31 32 33 34 35 41 42 43 44 45 51 52 53 54 55] 71 | [61 62 63 64 65 71 72 73 74 75 81 82 83 84 85] 72 | [ 6 7 8 9 10 16 17 18 19 20 26 27 28 29 30] 73 | [36 37 38 39 40 46 47 48 49 50 56 57 58 59 60] 74 | [66 67 68 69 70 76 77 78 79 80 86 87 88 89 90] 75 | ] 76 | 77 | hash: copy [] 78 | empty-hash: [0 0 0 0 0 0] 79 | 80 | init-hash: does [ 81 | hash: copy empty-hash 82 | ] 83 | 84 | calculate-hash: function [ 85 | board [block!] 86 | return: [block!] 87 | ] [ 88 | init-hash 89 | repeat area 6 [ 90 | foreach field hash-area/:area [ 91 | if 0 < board/:field [ 92 | hash/:area: board/:field * multiplication-table/:field + hash/:area 93 | ] 94 | ] 95 | ] 96 | hash 97 | ] 98 | 99 | calculate-new-hash-from-move: function [ 100 | board [block!] 101 | hash [block!] 102 | move-from [integer!] 103 | move-to [integer!] 104 | return: [block!] 105 | /local area a b 106 | ] [ 107 | a: sextant move-from 108 | b: sextant move-to 109 | piece: board/:move-from 110 | to-field-value: board/:move-to 111 | hash/:a: hash/:a - (piece * multiplication-table/:move-from) 112 | hash/:b: hash/:b - (to-field-value * multiplication-table/:move-to) + (piece * multiplication-table/:move-to) 113 | hash 114 | ] 115 | 116 | ;*********************************** 117 | ; Hash block to a base64 like string 118 | ;*********************************** 119 | base64-chars: "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" 120 | 121 | integer-to-base64: function [ 122 | id [integer!] 123 | return: [string!] 124 | /local out 125 | ][ 126 | out: copy "" 127 | while [id > 0][ 128 | ;insert out base64-chars/(id // 64 + 1) 129 | insert out base64-chars/(1 + remainder id 64) 130 | id: id / 64 131 | ] 132 | out 133 | ] 134 | 135 | convert-to-base64: function [ 136 | key [block!] 137 | return: [string!] 138 | /local i [integer!] out [string!] part [string!] 139 | ][ 140 | out: copy "" 141 | foreach i [2 5 1 4 3 6] [ 142 | part: integer-to-base64 key/:i 143 | while [3 > length? part][ insert part "A" ] 144 | append out part 145 | ] 146 | out 147 | ] 148 | 149 | calculate-hash-code: function [ 150 | board [block!] 151 | return: [string!] 152 | ] [ 153 | convert-to-base64 calculate-hash board 154 | ] 155 | 156 | calculate-new-hash-code-from-move: function [ 157 | board [block!] 158 | in-hash [block!] 159 | move-from [integer!] 160 | move-to [integer!] 161 | return: [string!] 162 | ][ 163 | convert-to-base64 calculate-new-hash-from-move board in-hash move-from move-to 164 | ] 165 | 166 | comment { 167 | [1 2 3 4 5 6] 168 | Hash block of start position should be [804 2514 804 954 2586 954] 169 | [2 5 1 4 3 6] 170 | Hash code of start position should be "AnS Aoa AMk AO6 AMk AO6" 171 | 2514 2586 804 954 804 954 172 | } -------------------------------------------------------------------------------- /xiangqi/xiangqi-move-common.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Common values for move generating and influence for Xiangqi aka Chinese Chess" 3 | filename: %xiangqi-move-common.red 4 | author: "Arnold van Hofwegen" 5 | version: 0.1 6 | date: "23-Feb-2015" 7 | ] 8 | 9 | ;******************** 10 | ; Move formats 11 | ;******************** 12 | ; Perhaps it is of value to have different formats for the moves in the move list? 13 | ; Standard format 14 | ; this-move: reduce [piece-value m n captured giving-check board-change-value] 15 | MOVE-ELEMENTS: 6 16 | CHECK-INDICATOR: 5 17 | ; other possible formats 18 | ; this-move: reduce [m n] 19 | ; this-move: reduce [piece-value m n hash-value-resulting-position] 20 | ; Not yet implemented 21 | 22 | ;******************** 23 | ; Move tables 24 | ;******************** 25 | king-moves: [ 26 | ; Red King 27 | 31 [41 32] 28 | 32 [31 33 42] 29 | 33 [32 43] 30 | 41 [31 42 51] 31 | 42 [32 41 43 52] 32 | 43 [32 42 53] 33 | 51 [41 52] 34 | 52 [42 51 53] 35 | 53 [43 52] 36 | ; Black King 37 | 38 [39 48] 38 | 39 [38 40 49] 39 | 40 [39 50] 40 | 48 [38 49 58] 41 | 49 [39 48 50 59] 42 | 50 [40 49 60] 43 | 58 [48 59] 44 | 59 [49 58 60] 45 | 60 [50 59] 46 | ] 47 | 48 | ; Advisor or Guard or Minister or Mandarin (64 or 65) 49 | advisor-moves: [ 50 | ; Red Advisor 51 | 31 [42] 52 | 33 [42] 53 | 42 [31 33 51 53] 54 | 51 [42] 55 | 53 [42] 56 | ; Black Advisor 57 | 38 [49] 58 | 40 [49] 59 | 49 [38 40 58 60] 60 | 58 [49] 61 | 60 [49] 62 | ] 63 | 64 | ; Elephant (32 or 33) 65 | elephant-moves: [ 66 | ; Red Elephant 67 | 3 [[12 21] [14 25]] 68 | 21 [[12 3] [32 43]] 69 | 25 [[14 3] [34 43]] 70 | 43 [[32 21] [34 25] [52 61] [54 65]] 71 | 61 [[52 43] [72 83]] 72 | 65 [[54 43] [74 83]] 73 | 83 [[72 61] [74 65]] 74 | ; Black Elephant 75 | 8 [[17 26] [19 30]] 76 | 26 [[17 8] [37 48]] 77 | 30 [[19 8] [39 48]] 78 | 48 [[37 26] [39 30] [57 66] [59 70]] 79 | 66 [[57 48] [77 88]] 80 | 70 [[59 48] [79 88]] 81 | 88 [[77 66] [79 70]] 82 | ] 83 | 84 | piece-color: function [ 85 | piece-value [integer!] 86 | return: [integer!] 87 | ][ 88 | piece-value and 1 89 | ] 90 | 91 | red-palace: [31 32 33 41 42 43 51 52 53] 92 | black-palace: [38 39 40 48 49 50 58 59 60] 93 | 94 | get-field-king: function [ 95 | "Find the red(0) or black(1) king on this board" 96 | in-board [block!] 97 | color [integer!] 98 | return: [integer!] 99 | /local field [integer!] 100 | ][ 101 | field: 0 102 | either color = RED-0 [ ; find the red king in his palace 103 | foreach i red-palace [ 104 | if 128 = in-board/:i [ 105 | field: i 106 | return field 107 | ] 108 | ] 109 | ][ ; find the black king in his palace 110 | foreach i black-palace [ 111 | if 129 = in-board/:i [ 112 | field: i 113 | return field 114 | ] 115 | ] 116 | ] 117 | field 118 | ] 119 | -------------------------------------------------------------------------------- /xiangqi/xiangqi-open.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | "Opening book for the game of xiangqi aka Chinese Chess" 3 | filename: %xiangqi-open.red 4 | author: "Arnold van Hofwegen" 5 | version: 1.0 6 | date: "14-Jan-2015" 7 | ] 8 | 9 | ;******************** 10 | ; Openingbook 11 | ;******************** 12 | comment { Original data was reformed from Chinese notation to positions using this translation table 13 | 1 2 3 4 5 6 7 8 9 14 | =========================== 15 | r h e a k a e h r 16 | 10 20 30 40 50 60 70 80 90 17 | 18 | 9 19 29 39 49 59 69 79 89 19 | c c 20 | 8 18 28 38 48 58 68 78 88 21 | p p p p p 22 | 7 17 27 37 47 57 67 77 87 23 | 24 | 6 16 26 36 46 56 66 76 86 25 | 26 | 5 15 25 35 45 55 65 75 85 27 | P P P P P 28 | 4 14 24 34 44 54 64 74 84 29 | C C 30 | 3 13 23 33 43 53 63 73 83 31 | 32 | 2 12 22 32 42 52 62 72 82 33 | R H E A K A E H R 34 | 1 11 21 31 41 51 61 71 81 35 | =========================== 36 | 9 8 7 6 5 4 3 2 1 37 | } 38 | 39 | ; entries in the openingbook have this form 40 | ; [ "hashcode" [ Player-to-move [[move-1] value-1 ....[move-n] value-n]]] 41 | ; where 42 | ; hashcode is the generated string we create from the board using the hashingfunctions 43 | ; Player to move is 0 or 1 for red or black 44 | ; move is from-field to-field 45 | ; value is a percentage value of how often the move should be played by the program 46 | ; For the first move there is an estimate from the site, 47 | ; for the rest it is dependent on how many variants are given 48 | 49 | opening-book: [ 50 | ; start position 51 | ;"AnSAoaAMkAO6AMkAO6" [0 [[73 43] 82 [24 25] 8 [61 43] 5 [71 63] 3 [73 53] 1 [73 33] 1]] ; Central canon(7343), Pawn(2425), Elephant(6143), Horse(7163), Palcorner cannon(7353), Crosspalace cannon(7333) 52 | "AnSAoaAMkAO6AMkAO6" [0 [[73 43] 70 [24 25] 6 [61 43] 6 [71 63] 6 [73 53] 6 [73 33] 6]] 53 | "A1yAoaAMkAO6AJEAO6" [1 [[67 66] 25 [78 48] 25 [78 38] 25 [18 38] 25]] 54 | "A1yAoaAMkAO6AJEAPe" [0 [[11 3] 50 [24 25] 50]] 55 | "A1yAq1AMkAMfAJEAO6" [0 [[1 2] 100]] 56 | "A1yAq1AMkAO6AJEAMf" [0 [[71 63] 100]] 57 | "A1yAq1AMkAO6ANUARR" [1 [[20 8] 50 [67 66] 50]] 58 | "A1yAq1AMkAO6ANkAMf" [1 [[80 68] 100]] 59 | "A1yAq1AMkAO6ANkARR" [0 [[81 71] 100]] 60 | "A1yAq1AN0AMfAJEAO6" [1 [[20 28] 100]] 61 | "A1yAq1AN0ARRAJEAO6" [0 [[2 32] 100]] 62 | "A1yAqrAMkAO6AJEAMf" [0 [[71 63] 100]] 63 | "A1yAqrAMkAO6ANUAQ/" [0 [[11 23] 100]] 64 | "A1yAqrAMkAO6ANUARR" [1 [[90 80] 100]] 65 | "A1yAqrAMkAO6ANkAMf" [1 [[80 68] 100]] 66 | "A1yAqrAMkAO6ANkARR" [0 [[81 71] 100]] 67 | "A1yAqrAREAO6ANUAQ/" [1 [[20 8] 33 [80 74] 33 [67 66] 34]] 68 | "A3FAqrAO4AViANgAU0" [1 [[48 28] 100]] 69 | "A3FAqrAO4AViAO4APc" [0 [[71 77] 100]] 70 | "A3JAqrARcAVGAPQAPc" [0 [[21 3] 100]] 71 | "A4WAqrAQ0AR1ALXAQ/" [1 [[74 73] 33 [10 20] 33 [10 9] 34]] 72 | "A4aAq1AK8ARRAJEAO6" [1 [[80 68] 100]] 73 | "A4aAq1AK8ARRAJEATs" [0 [[11 3] 100]] 74 | "A4aAq1ARcAQ/AJEATs" [0 [[4 5] 100]] 75 | "A4aAq1ARcARRAJEATs" [1 [[10 20] 100]] 76 | "A5yArTAIQAT4AO4AR1" [1 [[60 49] 100]] 77 | "AnSAoaAM8AO6AM8ATs" [1 [[18 28] 33 [78 88] 33 [90 89] 34]] 78 | "AnSAoaAM8AO6AMcAPe" [1 [[78 48] 100]] 79 | "AnSAoaAM8AO6AMkAO6" [1 [[67 66] 28 [80 68] 14 [18 28] 58]] 80 | "AnSAoaAM8AO6AMkAPe" [0 [[73 63] 50 [11 23] 50]] 81 | "AnSAoaAM8AO6AMkATs" [0 [[64 65] 100]] 82 | "AnSAoaAM8AO6AREAPe" [1 [[80 68] 100]] 83 | "AnSAoaAM8AO6AREAUQ" [0 [[11 23] 100]] 84 | "AnSAoaAM8AOwAMkAO6" [0 [[73 43] 100]] 85 | "AnSAoaAMkAO6AP0AZW" [1 [[78 88] 100]] 86 | "AnSAoaAMkAO6AREAO6" [1 [[67 66] 100]] 87 | "AnSAoaAMkAO6AREAPe" [0 [[24 25] 33 [73 83] 33 [13 33] 34]] 88 | "AnSAoaAMkAO6ARMAT+" [0 [[71 77] 100]] 89 | "AnSAoaAMkAO6ARMAUQ" [1 [[90 80] 100]] 90 | "AnSAoaAMkAO6ARcAPe" [1 [[80 68] 100]] 91 | "AnSAoaAMkAO6ARcAUQ" [0 [[81 71] 100]] 92 | "AnSAoaARcAO6AMkAPe" [1 [[80 68] 100]] 93 | "AnSAoaARcAO6AMkAUQ" [0 [[1 2] 50 [13 3] 50]] 94 | "AnSAoaARcAO6AREAUQ" [1 [[90 89] 50 [20 28] 50]] 95 | "ApGA3XAM8ALJAKoAO6" [0 [[31 42] 25 [11 3] 25 [71 63] 50]] 96 | "ApGA3XAM8ALJAO4AQU" [1 [[89 19] 100]] 97 | "ApGA3XAM8ALJAPIAO6" [1 [[90 89] 50 [27 26] 50]] 98 | "ApGA3XAM8ALJAPIAQU" [0 [[81 71] 100]] 99 | "ApGA3XAM8ALtAO4AO6" [1 [[26 25] 100]] 100 | "ApGA3XAM8ALtAPIAO6" [0 [[81 71] 100]] 101 | "ApGA3XAM8AOGAO4ANF" [0 [[11 23] 100]] 102 | "ApGA3XANxAJOAO4AO6" [0 [[11 3] 100]] 103 | "ApGA3XARcAOGAO4ANF" [1 [[20 39] 100]] 104 | "ApGA3XARcAQFAO4AT+" [0 [[13 15] 100]] 105 | "ApGA3XASUARlAU4AT+" [0 [[64 65] 33 [24 25] 33 [2 32] 34]] 106 | "ApGA3XATEAQpAPQATa" [0 [[13 17] 100]] 107 | "ApGA3XATEAUQAPQAPz" [0 [[1 2] 100]] 108 | "ApGA3XATcALJAKoAO6" [1 [[90 89] 50 [80 68] 50]] 109 | "ApGA4nAM8ATsANgARp" [0 [[11 23] 100]] 110 | "ApGA4nARcATsANgARp" [1 [[30 48] 33 [10 9] 33 [66 65] 34]] 111 | "ApGA6QATEAQpAPQARR" [0 [[13 33] 50 [13 23] 50]] 112 | "ApGA6QATEAUQAPQANq" [0 [[13 33] 50 [13 23] 50]] 113 | "ApGA88AR0ALLAO4ANF" [1 [[80 88] 100]] 114 | "ApGA88AR0ALLAO4AT/" [0 [[23 35] 100]] 115 | "ApGA88ARcALLAO4ANF" [0 [[13 3] 100]] 116 | "ApGAoaAKoAW8APQATa" [1 [[70 48] 50 [28 16] 50]] 117 | "ApGAoaAM0ATsAO4AT+" [1 [[78 76] 50 [18 14] 50]] 118 | "ApGAoaAM0ATsAO4AWK" [0 [[11 3] 100]] 119 | "ApGAoaAM8AO6AO4AT+" [1 [[78 74] 100]] 120 | "ApGAoaAM8AO6APIAT+" [0 [[11 23] 100]] 121 | "ApGAoaAM8AO6APIAT4" [0 [[11 23] 100]] 122 | "ApGAoaAM8AO6APIATa" [1 [[67 66] 25 [78 88] 75]] 123 | "ApGAoaAM8AO6ASPARj" [0 [[11 23] 100]] 124 | "ApGAoaAM8AOwAKoAO6" [1 [[30 48] 100]] 125 | "ApGAoaAM8ATsANgAYe" [0 [[44 45] 20 [11 3] 20 [13 33] 20 [11 23] 40]] 126 | "ApGAoaAM8ATsANgAZ0" [0 [[77 67] 100]] 127 | "ApGAoaAM8ATsANgAZW" [1 [[10 9] 12 [68 56] 12 [18 14] 12 [40 49] 12 [78 88] 52]] 128 | "ApGAoaAM8ATsANgAZk" [1 [[80 78] 25 [88 89] 75]] 129 | "ApGAoaAM8ATsANgAcY" [0 [[11 23] 100]] 130 | "ApGAoaAM8ATsAO4AT+" [0 [[13 23] 14 [11 23] 28 [71 77] 58]] 131 | "ApGAoaAM8ATsAO4ATa" [1 [[67 66] 100]] 132 | "ApGAoaAM8ATsAO4AXE" [0 [[11 23] 100]] 133 | "ApGAoaAM8ATsAO4AXO" [1 [[78 68] 100]] 134 | "ApGAoaAM8AVGANgAZW" [0 [[11 23] 50 [13 23] 50]] 135 | "ApGAoaAMkAO6AKoAO6" [1 [[80 68] 61 [20 28] 12 [78 48] 23 [18 48] 4]] 136 | "ApGAoaAMkAO6AKoATs" [0 [[71 63] 100]] 137 | "ApGAoaAMkAO6ANgAZW" [1 [[20 28] 100]] 138 | "ApGAoaAMkAO6AO4AT+" [0 [[24 25] 25 [71 77] 75]] 139 | "ApGAoaAMkAO6AO4ATa" [1 [[67 66] 12 [20 28] 66 [18 48] 3 [78 74] 19]] 140 | "ApGAoaAMkAO6AO4AUU" [0 [[11 3] 50 [11 23] 50]] 141 | "ApGAoaAMkAO6AO4AVG" [1 [[78 79] 100]] 142 | "ApGAoaAMkAO6APIATa" [0 [[24 25] 2 [81 71] 90 [24 25] 8]] 143 | "ApGAoaAMkAO6APIATs" [1 [[90 80] 87 [90 89] 5 [90 80] 8]] 144 | "ApGAoaAMkAO6APIAVG" [0 [[81 71] 100]] 145 | "ApGAoaAMkAO6ASPAQ/" [0 [[64 65] 100]] 146 | "ApGAoaAMkAO6ASnAQ/" [1 [[18 48] 100]] 147 | "ApGAoaAMkATsAKoAO6" [0 [[71 63] 100]] 148 | "ApGAoaAMkATsANgAZW" [0 [[44 45] 33 [13 33] 33 [11 23] 34]] 149 | "ApGAoaAMkATsAO4APe" [1 [[90 88] 100]] 150 | "ApGAoaAMkATsAO4AQU" [1 [[80 88] 100]] 151 | "ApGAoaAMkATsAO4AS2" [0 [[11 23] 100]] 152 | "ApGAoaAMkATsAO4ATa" [0 [[64 65] 20 [11 3] 10 [24 25] 70]] 153 | "ApGAoaAMkATsAO4AXO" [0 [[24 25] 100]] 154 | "ApGAoaAMkATsAPIAO6" [1 [[18 8] 12 [78 58] 64 [90 89] 12 [67 66] 12]] 155 | "ApGAoaAMkATsAPIAPe" [0 [[81 71] 100]] 156 | "ApGAoaAMkATsAPIAQU" [0 [[81 71] 100]] 157 | "ApGAoaAMkATsAPQATa" [1 [[27 26] 100]] 158 | "ApGAoaAMkAUKAPIAO6" [0 [[11 23] 100]] 159 | "ApGAoaAMkAUQAPQATa" [0 [[13 17] 25 [11 3] 75]] 160 | "ApGAoaAQ0AT4APIAO6" [1 [[20 14] 100]] 161 | "ApGAoaAQLARRAO4AT+" [0 [[71 75] 100]] 162 | "ApGAoaAQTARRANgAZW" [0 [[44 45] 100]] 163 | "ApGAoaAREAO6AO4AUU" [1 [[27 26] 100]] 164 | "ApGAoaAREAS6AO4AS2" [0 [[71 77] 100]] 165 | "ApGAoaAREAT4APIAO6" [0 [[1 11] 100]] 166 | "ApGAoaAREATsANgAZW" [1 [[27 26] 100]] 167 | "ApGAoaAREATsAO4AS2" [1 [[18 19] 100]] 168 | "ApGAoaAREAUKAPIAO6" [1 [[10 20] 100]] 169 | "ApGAoaAREAUQANgAZW" [0 [[1 2] 100]] 170 | "ApGAoaARcAO6APIAT+" [1 [[20 28] 100]] 171 | "ApGAoaARcAO6APIAT4" [1 [[18 48] 33 [67 66] 33 [80 75] 34]] 172 | "ApGAoaARcAO6APIAUc" [0 [[81 82] 33 [13 15] 33 [23 35] 34]] 173 | "ApGAoaARcAO6ASPARj" [1 [[30 48] 50 [18 48] 50]] 174 | "ApGAoaARcAO6AXbASV" [0 [[44 45] 50 [21 3] 50]] 175 | "ApGAoaARcARRAWzAT+" [0 [[61 83] 100]] 176 | "ApGAoaARcATsANgAYe" [1 [[10 9] 50 [40 49] 50]] 177 | "ApGAoaARcATsANgAcY" [1 [[30 48] 100]] 178 | "ApGAoaARcATsAO4AT+" [1 [[30 48] 25 [78 76] 25 [18 14] 50]] 179 | "ApGAoaARcATsAO4AWK" [0 [[23 35] 100]] 180 | "ApGAoaARcATsAO4AXE" [1 [[30 48] 50 [89 39] 50]] 181 | "ApGAoaARcATsAPIAT+" [0 [[81 82] 33 [13 15] 33 [13 3] 34]] 182 | "ApGAoaARcAVGANgAYe" [0 [[13 3] 100]] 183 | "ApGAoaAS8ATaAO4AT+" [0 [[1 11] 100]] 184 | "ApGAoaAS8ATsAO4AT+" [1 [[10 20] 100]] 185 | "ApGAoaAS8AU6APQATa" [1 [[28 16] 100]] 186 | "ApGAoaAS8Ac4APQATa" [0 [[1 2] 100]] 187 | "ApGAoaASUAUQANgAZW" [1 [[18 17] 100]] 188 | "ApGAoaASUAVMANgAZW" [0 [[77 75] 100]] 189 | "ApGAoaASUAVMAU4AT+" [1 [[30 48] 100]] 190 | "ApGAoaASsATaAO4AT+" [1 [[18 14] 33 [18 16] 33 [78 74] 34]] 191 | "ApGAoaATEAO6AO4AUU" [1 [[30 48] 100]] 192 | "ApGAoaATEATsAO4AT+" [0 [[13 33] 50 [13 23] 50]] 193 | "ApGAoaATEATsAO4ATa" [1 [[67 66] 100]] 194 | "ApGAoaATEAU6APQATa" [0 [[13 23] 100]] 195 | "ApGAoaATEAUQAPQATa" [1 [[30 48] 33 [70 48] 33 [7 6] 34]] 196 | "ApGAoaAUMAc4APQATa" [1 [[6 5] 33 [70 48] 33 [30 48] 34]] 197 | "ApGAoaAUzARRAO4AT+" [0 [[71 75] 50 [44 45] 50]] 198 | "ApGAoaAUzARRAU4AT+" [1 [[14 64] 100]] 199 | "ApGAoaAW3ASVAPIAO6" [0 [[13 3] 100]] 200 | "ApGAqrAKoAObASnAQ/" [1 [[20 28] 100]] 201 | "ApGAqrAM0AUQANgAYD" [1 [[28 36] 100]] 202 | "ApGAqrAM8AO6AO4AR1" [1 [[18 14] 50 [90 89] 50]] 203 | "ApGAqrAM8AO6AO4ATP" [0 [[11 23] 100]] 204 | "ApGAqrAMcAPeANgAYD" [1 [[20 28] 100]] 205 | "ApGAqrAMcAUQANgAYD" [0 [[24 25] 100]] 206 | "ApGAqrAMkAMfAKoAO6" [0 [[71 63] 100]] 207 | "ApGAqrAMkAMfAO4ATa" [0 [[71 77] 50 [11 23] 50]] 208 | "ApGAqrAMkAMfAO4AV0" [1 [[90 80] 100]] 209 | "ApGAqrAMkAMfAO4AVi" [0 [[11 3] 50 [11 23] 50]] 210 | "ApGAqrAMkAMfAPIAO6" [1 [[20 28] 67 [80 88] 33]] 211 | "ApGAqrAMkAMfAPIAV0" [0 [[81 71] 100]] 212 | "ApGAqrAMkAMfASnAQ/" [0 [[13 18] 16 [11 23] 84]] 213 | "ApGAqrAMkAO6AKoAMf" [0 [[71 63] 100]] 214 | "ApGAqrAMkAO6ANgAYD" [1 [[27 26] 100]] 215 | "ApGAqrAMkAO6AO4AR1" [0 [[11 23] 33 [24 25] 67]] 216 | "ApGAqrAMkAO6AO4ARR" [1 [[67 66] 23 [90 89] 77]] 217 | "ApGAqrAMkAO6AO4ASr" [0 [[71 77] 20 [13 33] 20 [11 23] 60]] 218 | "ApGAqrAMkAO6APIAMf" [1 [[80 68] 100]] 219 | "ApGAqrAMkAO6APIARR" [0 [[64 65] 6 [81 82] 6 [81 71] 88]] 220 | "ApGAqrAMkAO6APgARR" [1 [[90 80] 50 [90 89] 50]] 221 | "ApGAqrAMkAO6AQYAQ/" [0 [[82 32] 100]] 222 | "ApGAqrAMkAO6AQYARR" [1 [[90 80] 100]] 223 | "ApGAqrAMkAPeANgAV4" [1 [[20 28] 100]] 224 | "ApGAqrAMkAPeANgAYD" [0 [[77 67] 50 [13 23] 50]] 225 | "ApGAqrAMkAQ/AO4AO6" [0 [[11 23] 100]] 226 | "ApGAqrAMkARRAO4AO6" [1 [[10 20] 50 [80 68] 50]] 227 | "ApGAqrAMkARRAO4ATs" [0 [[13 33] 100]] 228 | "ApGAqrAMkARRAPIAO6" [0 [[81 71] 100]] 229 | "ApGAqrAO4AUhASdAQ/" [0 [[17 27] 100]] 230 | "ApGAqrAO4AUhASnAQ/" [1 [[74 64] 100]] 231 | "ApGAqrAQ0AKqASnAT8" [0 [[63 55] 50 [24 25] 50]] 232 | "ApGAqrAQ0AN5ASnAQ/" [1 [[9 79] 100]] 233 | "ApGAqrAQ0AQ/AO4ATa" [0 [[13 17] 100]] 234 | "ApGAqrAQ0AQ/AO4ATs" [1 [[90 80] 100]] 235 | "ApGAqrAQ0AR1ASnAQ/" [0 [[63 55] 50 [13 17] 50]] 236 | "ApGAqrAQ0ARRASnAQ/" [1 [[27 26] 100]] 237 | "ApGAqrAQMAU0ASnAZS" [1 [[67 66] 33 [74 64] 33 [48 58] 34]] 238 | "ApGAqrAQTAMfAO4AR1" [0 [[11 23] 100]] 239 | "ApGAqrAREAMfASnAQ/" [1 [[10 9] 20 [20 28] 80]] 240 | "ApGAqrAREAN5ASnAQ/" [0 [[1 11] 100]] 241 | "ApGAqrAREAO6AO4AR1" [1 [[20 28] 100]] 242 | "ApGAqrAREAO6AO4ASr" [1 [[20 28] 16 [89 39] 84]] 243 | "ApGAqrAREAQ/AO4AO6" [1 [[80 68] 100]] 244 | "ApGAqrAREAQ/AO4ATs" [0 [[1 11] 100]] 245 | "ApGAqrAREARRASnAQ/" [0 [[24 25] 50 [1 11] 50]] 246 | "ApGAqrAREATsAO4AR1" [0 [[24 25] 100]] 247 | "ApGAqrAREATsAO4ASr" [0 [[24 25] 100]] 248 | "ApGAqrARMAMfAPIAT4" [1 [[20 28] 100]] 249 | "ApGAqrARMAQ/ASnAQ/" [1 [[20 14] 50 [20 16] 50]] 250 | "ApGAqrARMARRAPIAT4" [0 [[64 65] 50 [81 82] 50]] 251 | "ApGAqrARMAXvASnAQ/" [0 [[13 3] 100]] 252 | "ApGAqrARcAMfAPIAT4" [0 [[1 11] 100]] 253 | "ApGAqrARcAO6AO4ATP" [1 [[89 39] 100]] 254 | "ApGAqrARcAQ/ASnAQ/" [0 [[1 11] 100]] 255 | "ApGAqrARcARRASnAQ/" [1 [[10 20] 100]] 256 | "ApGAqrARcATsAO4AR1" [1 [[10 9] 100]] 257 | "ApGAqrARcATsAO4ASr" [1 [[10 9] 100]] 258 | "ApGAqrARcAVGAO4ASr" [0 [[64 65] 50 [13 14] 50]] 259 | "ApGAqrARkAPcASnAZS" [0 [[11 17] 100]] 260 | "ApGAqrARkAXvASnAQ/" [1 [[16 76] 100]] 261 | "ApGAqrAUzAMfAO4AR1" [1 [[20 28] 50 [90 89] 50]] 262 | "ApGAqrAXPAPcASnAQ/" [0 [[23 35] 50 [13 3] 50]] 263 | "ApGArTAM8ATsANgAXN" [1 [[90 88] 50 [40 49] 50]] 264 | "ApGArTAM8ATsAO4AR1" [0 [[71 77] 100]] 265 | "ApGArTAM8ATsAO4ARR" [1 [[67 66] 100]] 266 | "ApGArTAMkATsAO4AMf" [1 [[80 68] 100]] 267 | "ApGArTAMkATsAO4ARR" [0 [[13 33] 25 [24 25] 25 [64 65] 50]] 268 | "ApGArTAMkATsAPIAMf" [0 [[81 82] 20 [81 71] 80]] 269 | "ApGArTAMkATsAPQARR" [1 [[27 26] 100]] 270 | "ApGArTAMkATsAQYAMf" [1 [[80 68] 100]] 271 | "ApGArTAMkATsAQYARR" [0 [[82 52] 100]] 272 | "ApGArTAMkAUQAPQARR" [0 [[11 3] 100]] 273 | "ApGArTATEAUQAPQARR" [1 [[30 48] 50 [70 48] 50]] 274 | "ApGAsnASPAQ/ANgAXf" [1 [[68 89] 100]] 275 | "ApGAsnASPAQ/AO4ASH" [0 [[71 77] 100]] 276 | "ApGAsnASPAQ/AO4ASr" [1 [[89 69] 100]] 277 | "ApGAtoAREAO6AO4APc" [0 [[24 25] 20 [64 65] 80]] 278 | "ApGAtoAREAO6APQAPc" [1 [[39 35] 25 [27 26] 25 [20 8] 25 [20 28] 25]] 279 | "ApGAtoAREAPeAN4AW0" [1 [[30 8] 100]] 280 | "ApGAtoAREAPeAPQAPc" [0 [[71 76] 100]] 281 | "ApGAtoAREATsAPQAPc" [0 [[24 25] 100]] 282 | "ApGAtoAREAV0APQAPc" [0 [[63 55] 100]] 283 | "ApGAtoAREAe8AN4AW0" [0 [[13 3] 100]] 284 | "ApGAtoARcAO6AO4APc" [1 [[20 8] 33 [20 28] 33 [39 34] 34]] 285 | "ApGAtoARcAO6AO4AQA" [0 [[71 75] 100]] 286 | "ApGAtoARcAO6AU4AQA" [1 [[20 28] 100]] 287 | "ApGAtoARcATsAPQAPc" [1 [[10 9] 100]] 288 | "ApGAtoARcATsAU4AQA" [0 [[64 65] 100]] 289 | "ApGAtoARcAVGAPQAPc" [0 [[31 42] 100]] 290 | "ApGAwiAM8ATsANgAZW" [0 [[11 23] 50 [13 23] 50]] 291 | "ApGAwiARcATsANgAYe" [0 [[23 35] 50 [13 3] 50]] 292 | "ApOAoaAKoAO6AREAPe" [1 [[80 68] 100]] 293 | "ApOAoaAKoAO6AREAUQ" [0 [[11 23] 100]] 294 | "ApOAoaAMkAO6AKoAO6" [1 [[78 48] 100]] 295 | "ApOAoaAPIAO6AREAUQ" [1 [[20 8] 100]] 296 | "ApOAqrAMkAO6AKoAMf" [0 [[71 63] 100]] 297 | "ApOAqrAMkAO6ANgAYD" [1 [[89 39] 100]] 298 | "ApOAqrAMkAO6AO4ARR" [1 [[90 89] 100]] 299 | "ApOAqrAMkAO6AO4ASr" [0 [[71 77] 100]] 300 | "ApOAqrAMkAO6APIAMf" [1 [[80 68] 100]] 301 | "ApOAqrAMkAO6APIARR" [0 [[81 71] 100]] 302 | "ApOAtoAMkAO6ANgAU0" [0 [[51 42] 100]] 303 | "ApeA/fAUzANqANgAZW" [0 [[1 2] 50 [13 3] 50]] 304 | "ApeA3XAQTANqANgAZW" [0 [[11 23] 100]] 305 | "ApeA3XAUzANqANgAZW" [1 [[40 49] 100]] 306 | "ApeAoaAMkATsANgAZW" [1 [[40 49] 100]] 307 | "ApeAoaAQTARRANgAZW" [1 [[30 48] 100]] 308 | "ApeAoaAUzARRAO4AT+" [1 [[78 74] 100]] 309 | "ApmAoaAMkAO6AKoAO6" [1 [[18 48] 100]] 310 | "ApmAqrAMkAMfAKoAO6" [0 [[11 23] 100]] 311 | "ApmAqrAQ0AQ/AO4AVi" [0 [[53 58] 50 [13 17] 50]] 312 | "ApmAqrAQ0ARRAO4AVi" [1 [[10 20] 100]] 313 | "ApmAqrAREAMfAKoAO6" [1 [[20 28] 100]] 314 | "ApmAqrAREARRAKoAO6" [0 [[71 63] 100]] 315 | "ApmAqrAREARRAO4AV0" [1 [[90 80] 100]] 316 | "ApmAqrAREARRAO4AVi" [0 [[1 11] 100]] 317 | "ApmAqrAREARRAPIAO6" [1 [[80 88] 100]] 318 | "ApmAqrAREARRAPIAV0" [0 [[81 71] 100]] 319 | "Ar+ArTAMkATsANgAQ/" [0 [[11 23] 100]] 320 | "Ar+ArTAMkATsANgARR" [1 [[90 80] 100]] 321 | "Ar+ArTAREATsANgAQ/" [1 [[40 49] 100]] 322 | "Ar+AzbAREATsANgAQ/" [0 [[44 45] 50 [1 2] 50]] 323 | "ArCAoaAKoATaANgAZW" [0 [[11 23] 100]] 324 | "ArCAoaAKoATsANgAZW" [1 [[10 20] 100]] 325 | "ArCAoaAPIAT4ANgAZW" [0 [[44 45] 100]] 326 | "ArCAoaAPIATaANgAZW" [1 [[18 8] 100]] 327 | "ArCAoaAQ4ATaAO4AT+" [1 [[18 14] 100]] 328 | "ArCAoaARIATaAO4AT+" [0 [[1 11] 100]] 329 | "ArCAoaARIATsAO4AT+" [1 [[10 20] 100]] 330 | "ArCAoaAUPAQ/AO4AT+" [0 [[71 75] 100]] 331 | "ArCAoaAUPAQ/AU4AT+" [1 [[78 88] 100]] 332 | "ArCAoaAUPAQ/AU4AUc" [0 [[75 55] 100]] 333 | "ArCAqrAKoAO6AO4ASr" [1 [[20 28] 50 [89 39] 50]] 334 | "ArCAqrAKoATsAO4ASr" [0 [[11 23] 100]] 335 | "ArCAqrAO4ATaAO4ASr" [1 [[18 14] 100]] 336 | "ArCAqrAPIATaAO4ASr" [0 [[1 11] 100]] 337 | "ArCAqrAPIATsAO4ASr" [1 [[10 20] 100]] 338 | "ArCAqrASPAQ/AO4ASr" [0 [[33 38] 100]] 339 | "ArCArTAKoATaAO4ARR" [0 [[11 23] 100]] 340 | "ArCArTAKoATsAO4ARR" [1 [[10 20] 100]] 341 | "ArCArTAPIAT4AO4ARR" [0 [[24 25] 100]] 342 | "ArCArTAPIATaAO4ARR" [1 [[18 8] 100]] 343 | "ArCArTAPgAT4AO4AR1" [0 [[23 35] 100]] 344 | "ArCArTAPgAT4AO4ARR" [1 [[67 66] 100]] 345 | "ArCAtoAKoAO6AO4APc" [0 [[51 42] 100]] 346 | "AruAqrAMkAO6ANgAQ/" [1 [[80 76] 100]] 347 | "AruAqrAMkAO6ANgAXv" [0 [[11 23] 100]] 348 | "AruAqrAREAO6ANgAXv" [1 [[20 28] 50 [60 49] 50]] 349 | "AvOAtoAMkAO6ANgAU0" [1 [[20 28] 100]] 350 | "AxCAtoAKoAO6AO4APc" [1 [[20 8] 100]] 351 | "AxCAtoAKoAV0AO4APc" [0 [[11 23] 100]] 352 | "AxCAtoAO4AViAO4APc" [1 [[39 34] 100]] 353 | "AxCAtoAPIAV0AO4APc" [1 [[10 20] 100]] 354 | "AxCAtoAPIAViAO4APc" [0 [[1 11] 100]] 355 | "AxGA3XAM8ALJAKoAO6" [1 [[67 66] 50 [80 68] 50]] 356 | "AxGAtoARcAVGAPQAPc" [1 [[39 34] 100]] 357 | "AxZAqrAREAO6APQAPc" [0 [[43 53] 50 [61 83] 50]] 358 | ] ; End of opening-book 359 | 360 | ; probe opening-book 361 | 362 | ; Suggestionbook 363 | ; this is still just an idea 364 | ; that should work a bit similar. Create the hashcode and if you do not find the code then find one that has 365 | ; characteristics like the code, so perhaps the situation is comparable. 366 | ; find part of the code? Then some moves are given, suggesting a move if it is in the generated move list. 367 | --------------------------------------------------------------------------------