Author Topic: Chess game project : King + Rook vs King endgame (Read 3231 times)

Adrian · « **on:** January 05, 2021, 01:21:30 pm »

Another year, another chess project :) This time, the challenge is to write or tweak a *simple* program so that the computer is smart enough to checkmate a lone king with king and rook. This is a trivial endgame that all human chess beginners quickly learn, but strangely where weak chess engines almost always fail. As a starting point, I'll be using a stripped down version of Dean Menezes' popular chess program chess.bas bundled together with QB64. At the moment, it relies on its original AI, which has absolutely no clue how to force the simple checkmate.

Code: QB64: [Select]

_FULLSCREEN
DEFINT A-Z
DECLARE SUB SQUARE (A, B, C)
DECLARE SUB SHOWMAN (A, B, FLAG)
DECLARE SUB SHOWBD ()
DECLARE SUB IO (A, B, X, Y, RESULT)
DECLARE FUNCTION INCHECK (X)
DECLARE SUB MAKEMOVE (A, B, X, Y)
DECLARE SUB KING (A, B, XX(), YY(), NDX)
DECLARE SUB ROOK (A, B, XX(), YY(), NDX)
DECLARE SUB MOVELIST (A, B, XX(), YY(), NDX)
DECLARE FUNCTION EVALUATE (ID, PRUNE)
DIM SHARED BOARD(0 TO 7, 0 TO 7)
DIM SHARED BESTA(0 TO 7), BESTB(0 TO 7), BESTX(0 TO 7), BESTY(0 TO 7)
DIM SHARED LEVEL, MAXLEVEL, SCORE
DIM SHARED WCKSFLAG, WCQSFLAG, INTFLAG
DIM SHARED WCKSOLD, WCQSOLD
LEVEL = 0
MAXLEVEL = 5
DATA -500,0,0,0,0,0,0,-7500
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,5000,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
FOR X = 0 TO 7
    FOR Y = 0 TO 7
        READ Z
        BOARD(X, Y) = Z
    NEXT Y
NEXT X
A = -1
RESULT = 0
CLS
COLOR 15
PRINT
PRINT
PRINT
PRINT
PRINT "      SIMPLE CHESS ENDINGS : CHECKMATE WITH KING AND ROOK VS KING"
PRINT
PRINT
PRINT
PRINT "     In this game, you play White with only a King and I play Black "
PRINT "     with King and Rook. I will try to checkmate you within 50 moves."
PRINT "     To move the pieces on the chessboard, type in your move in "
PRINT "     coordinate notation, e.g. E2E3 . To exit the game, type QUIT."
PRINT
PRINT
PRINT
PRINT
PRINT
PRINT
PRINT
PRINT "                   Press any key to continue."
Z$ = INPUT$(1)
DO
    SCORE = 0
    CALL IO(A, B, X, Y, RESULT)
    CLS
    CALL SHOWBD
    RESULT = EVALUATE(-1, 10000)
    A = BESTA(1)
    B = BESTB(1)
    X = BESTX(1)
    Y = BESTY(1)
LOOP
 
 
FUNCTION EVALUATE (ID, PRUNE)
    DIM XX(0 TO 26), YY(0 TO 26)
    LEVEL = LEVEL + 1
    BESTSCORE = 10000 * ID
    FOR B = 7 TO 0 STEP -1
        FOR A = 7 TO 0 STEP -1
            IF SGN(BOARD(B, A)) <> ID THEN GOTO 1
            CALL MOVELIST(A, B, XX(), YY(), NDX)
            FOR I = 0 TO NDX
                X = XX(I)
                Y = YY(I)
                OLDSCORE = SCORE
                MOVER = BOARD(B, A)
                TARGET = BOARD(Y, X)
                CALL MAKEMOVE(A, B, X, Y)
                IF (LEVEL < MAXLEVEL) THEN SCORE = SCORE + EVALUATE(-ID, BESTSCORE - TARGET + ID * (8 - ABS(4 - X) - ABS(4 - Y)))
                SCORE = SCORE + TARGET - ID * (8 - ABS(4 - X) - ABS(4 - Y))
                IF (ID < 0 AND SCORE > BESTSCORE) OR (ID > 0 AND SCORE < BESTSCORE) THEN
                    BESTA(LEVEL) = A
                    BESTB(LEVEL) = B
                    BESTX(LEVEL) = X
                    BESTY(LEVEL) = Y
                    BESTSCORE = SCORE
                    IF (ID < 0 AND BESTSCORE >= PRUNE) OR (ID > 0 AND BESTSCORE <= PRUNE) THEN
                        BOARD(B, A) = MOVER
                        BOARD(Y, X) = TARGET
                        SCORE = OLDSCORE
                        LEVEL = LEVEL - 1
                        EVALUATE = BESTSCORE
                        EXIT FUNCTION
                    END IF
                END IF
                BOARD(B, A) = MOVER
                BOARD(Y, X) = TARGET
                SCORE = OLDSCORE
            NEXT
        1 NEXT
    NEXT
    LEVEL = LEVEL - 1
    EVALUATE = BESTSCORE
END FUNCTION
 
FUNCTION INCHECK (X)
    DIM XX(27), YY(27), NDX
    FOR B = 0 TO 7
        FOR A = 0 TO 7
            IF BOARD(B, A) >= 0 THEN GOTO 6
            CALL MOVELIST(A, B, XX(), YY(), NDX)
            FOR I = 0 TO NDX STEP 1
                X = XX(I)
                Y = YY(I)
                IF BOARD(Y, X) = 5000 THEN
                    PRINT "YOU ARE IN CHECK!"
                    PRINT " "
                    PRINT " "
                    INCHECK = 1
                    EXIT FUNCTION
                END IF
            NEXT
        6 NEXT
    NEXT
    INCHECK = 0
END FUNCTION
 
SUB IO (A, B, X, Y, RESULT)
    DIM XX(0 TO 26), YY(0 TO 26)
    CLS
    IF A >= 0 THEN
        IF RESULT < -2500 THEN
            PRINT "I RESIGN"
            SLEEP
            SYSTEM
        END IF
        PIECE = BOARD(Y, X)
        CALL MAKEMOVE(A, B, X, Y)
        IF PIECE <> 0 THEN
            PRINT "I TOOK YOUR ";
            IF PIECE = 5000 THEN PRINT "KING"
        END IF
        NULL = INCHECK(0)
    END IF
    DO
        CALL SHOWBD
        VIEW PRINT 24 TO 24
        LOCATE , 33: INPUT "YOUR MOVE: ", IN$
        IF UCASE$(IN$) = "QUIT" THEN CLS: END
        IF LEN(IN$) < 4 THEN GOTO 16
        B = 8 - (ASC(MID$(IN$, 2, 1)) - 48)
        A = ASC(UCASE$(MID$(IN$, 1, 1))) - 65
        X = ASC(UCASE$(MID$(IN$, 3, 1))) - 65
        Y = 8 - (ASC(MID$(IN$, 4, 1)) - 48)
        IF B > 7 OR B < 0 OR A > 7 OR A < 0 OR X > 7 OR X < 0 OR Y > 7 OR Y < 0 THEN GOTO 16
        IF BOARD(B, A) <= 0 THEN GOTO 16
        IF Y = 2 AND B = 3 AND (X = A - 1 OR X = A + 1) THEN
            IF BOARD(B, A) = 100 AND BOARD(Y, X) = 0 AND BOARD(Y + 1, X) = -100 THEN
                IF BESTB(1) = 1 AND BESTA(1) = X THEN
                    MOVER = BOARD(B, A)
                    TARGET = BOARD(Y, X)
                    CALL MAKEMOVE(A, B, X, Y)
                    BOARD(Y + 1, X) = 0
                    ENPASSANT = -1
                    GOTO 15
                END IF
            END IF
        END IF
        CALL MOVELIST(A, B, XX(), YY(), NDX)
        FOR K = 0 TO NDX STEP 1
            IF X = XX(K) AND Y = YY(K) THEN
                MOVER = BOARD(B, A)
                TARGET = BOARD(Y, X)
                INTFLAG = -1
                CALL MAKEMOVE(A, B, X, Y)
                INTFLAG = 0
                15 IF INCHECK(0) = 0 THEN EXIT SUB
                BOARD(B, A) = MOVER
                BOARD(Y, X) = TARGET
                GOTO 16
            END IF
        NEXT
        16 CLS
    LOOP
END SUB
 
SUB KING (A, B, XX(), YY(), NDX)
    ID = SGN(BOARD(B, A))
    FOR DY = -1 TO 1
        IF B + DY < 0 OR B + DY > 7 THEN GOTO 12
        FOR DX = -1 TO 1
            IF A + DX < 0 OR A + DX > 7 THEN GOTO 11
            IF ID <> SGN(BOARD(B + DY, A + DX)) THEN
                NDX = NDX + 1
                XX(NDX) = A + DX
                YY(NDX) = B + DY
            END IF
        11 NEXT
    12 NEXT
END SUB
 
SUB MAKEMOVE (A, B, X, Y)
    BOARD(Y, X) = BOARD(B, A)
    BOARD(B, A) = 0
END SUB
 
SUB MOVELIST (A, B, XX(), YY(), NDX)
    PIECE = INT(ABS(BOARD(B, A)))
    NDX = -1
    IF PIECE = 500 THEN CALL ROOK(A, B, XX(), YY(), NDX) ELSE CALL KING(A, B, XX(), YY(), NDX)
END SUB
 
SUB ROOK (A, B, XX(), YY(), NDX)
    ID = SGN(BOARD(B, A))
    FOR X = A - 1 TO 0 STEP -1
        IF ID <> SGN(BOARD(B, X)) THEN
            NDX = NDX + 1
            XX(NDX) = X
            YY(NDX) = B
        END IF
        IF (BOARD(B, X)) <> 0 THEN EXIT FOR
    NEXT
    FOR X = A + 1 TO 7 STEP 1
        IF ID <> SGN(BOARD(B, X)) THEN
            NDX = NDX + 1
            XX(NDX) = X
            YY(NDX) = B
        END IF
        IF (BOARD(B, X)) <> 0 THEN EXIT FOR
    NEXT
    FOR Y = B - 1 TO 0 STEP -1
        IF ID <> SGN(BOARD(Y, A)) THEN
            NDX = NDX + 1
            XX(NDX) = A
            YY(NDX) = Y
        END IF
        IF (BOARD(Y, A)) <> 0 THEN EXIT FOR
    NEXT
    FOR Y = B + 1 TO 7 STEP 1
        IF ID <> SGN(BOARD(Y, A)) THEN
            NDX = NDX + 1
            XX(NDX) = A
            YY(NDX) = Y
        END IF
        IF (BOARD(Y, A)) <> 0 THEN EXIT FOR
    NEXT
END SUB
 
SUB SHOWBD
    VIEW PRINT
    LOCATE 3, 30
    COLOR 7, 0
    PRINT "A  B  C  D  E  F  G  H"
    FOR K = 0 TO 25
        LOCATE 4, 28 + K
        COLOR 6, 0
        PRINT CHR$(220)
    NEXT
    FOR B = 0 TO 7
        LOCATE 2 * B + 5, 26
        COLOR 7, 0
        PRINT CHR$(56 - B)
        LOCATE 2 * B + 5, 28
        COLOR 6, 0
        PRINT CHR$(219)
        LOCATE 2 * B + 6, 28
        PRINT CHR$(219)
        FOR A = 0 TO 7
            IF ((A + B) MOD 2) <> 0 THEN
                COLOUR = 2
            ELSE COLOUR = 15
            END IF
            CALL SQUARE(3 * A + 31, 2 * B + 5, COLOUR)
        NEXT
        LOCATE 2 * B + 5, 53
        COLOR 6, 0
        PRINT CHR$(219)
        LOCATE 2 * B + 6, 53
        PRINT CHR$(219)
        LOCATE 2 * B + 6, 55
        COLOR 7, 0
        PRINT CHR$(56 - B)
    NEXT
    FOR K = 0 TO 25
        LOCATE 21, 28 + K
        COLOR 6, 0
        PRINT CHR$(223)
    NEXT
    LOCATE 22, 30
    COLOR 7, 0
    PRINT "A  B  C  D  E  F  G  H"
    FOR B = 0 TO 7
        FOR A = 0 TO 7
            CALL SHOWMAN(A, B, 0)
        NEXT
    NEXT
    COLOR 7, 0
END SUB
 
SUB SHOWMAN (A, B, FLAG)
    IF BOARD(B, A) < 0 THEN BACK = 0
    IF BOARD(B, A) > 0 THEN BACK = 7
    FORE = 7 - BACK + FLAG
    IF BOARD(B, A) = 0 THEN
        IF ((A + B) MOD 2) <> 0 THEN BACK = 2 ELSE BACK = 15
        FORE = BACK + -1 * (FLAG > 0)
    END IF
    N$ = " "
    PIECE = INT(ABS(BOARD(B, A)))
    IF PIECE = 0 THEN N$ = CHR$(219)
    IF PIECE = 500 THEN N$ = "R"
    IF PIECE = 5000 OR PIECE = 7500 THEN N$ = "K"
    LOCATE 2 * B + 5 - (BOARD(B, A) > 0), 3 * A + 30
    COLOR FORE, BACK
    PRINT N$
    LOCATE 1, 1
    COLOR 7, 0
END SUB
 
SUB SQUARE (A, B, C)
    MT$ = CHR$(219)
    MT$ = MT$ + MT$ + MT$
    LOCATE B, A - 2
    COLOR C, C
    PRINT MT$
    LOCATE B + 1, A - 2
    PRINT MT$
    COLOR 7, 0
END SUB

bplus · « **Reply #1 on:** January 05, 2021, 01:36:09 pm »

Yes, this is the way to start real game program:

These 2 things seem imperative
#1 seek a win in next move, if that fails
#2 seek to spoil opponents win in next move

then you start playing for best positions or seeing moves ahead with recursive use of #1 and #2!

I don't think that! is in the sample Chess program that comes with QB64.

News:

Author Topic: Chess game project : King + Rook vs King endgame (Read 3231 times)

Adrian

Chess game project : King + Rook vs King endgame

bplus

Re: Chess project : King + Rook vs King endgame