Search code examples
rchess

How can I turn a chess FEN into a PGN?


I have a series of FEN strings and accompanying moves in LAN (Long Algebraic Notation) that look like the below. An example dataframe is pasted at the end of my question.

FEN Moves GameUrl
r3k2r/1b1pbppp/p7/1pp5/3q4/P1NPBp1P/1PP1B1P1/R4Q1K w kq - 0 19 e3d4 f3g2 f1g2 b7g2 h1g2 c5d4 Link
3rr1k1/5ppp/6q1/pp6/1bppPn2/5P2/PPP2QPP/2NRBRK1 w - - 8 25 e1b4 f4h3 g1h1 h3f2 Link
r1bq1rk1/ppp2ppp/2np1b1n/3Q2N1/2B1PP2/4B3/PP2N1PP/R4RK1 b - - 0 13 h6g4 g5f7 f8f7 d5f7 Link

Each row in this dataframe is a chess puzzle. I would like to generate a PGN of the puzzle, based on the initial FEN and then applying the sequence of moves that make up the puzzle, currently stored in Moves in Long Algebraic Notation.

So my ideal result for the first line of the above dataframe would be:

FEN Moves GameUrl PGN
r3k2r/1b1pbppp/p7/1pp5/3q4/P1NPBp1P/1PP1B1P1/R4Q1K w kq - 0 19 e3d4 f3g2 f1g2 b7g2 h1g2 c5d4 Link [Variant "From Position"][FEN "r3k2r/1b1pbppp/p7/1pp5/3q4/P1NPBp1P/1PP1B1P1/R4Q1K w kq - 0 19"]19. Bxd4 fxg2+ 20. Qxg2 Bxg2+ 21. Kxg2 cxd4

To achieve this we need to convert the LAN moves into SAN (Short Algebraic Notation).

Using R's bigchess package I tried to turn the moves to SAN as below:

library(tidyverse)
library(bigchess)

df2 <- df %>% 
  mutate(Moves_SAN = sapply(Moves, lan2san))

But I think it's reading the Moves as being from the starting position of a chess board and so the translated Moves_SAN are incorrect.

Does anyone know a way to convert the LAN to SAN based on the FEN and using an available package in R?

I am imagining the solution involves loading the FEN with bigchess, stockfish or chess and then applying the LAN and somehow translating them into SAN with this context, but I haven't been able to work out how.

structure(list(FEN = c("r3k2r/1b1pbppp/p7/1pp5/3q4/P1NPBp1P/1PP1B1P1/R4Q1K w kq - 0 19", 
"3rr1k1/5ppp/6q1/pp6/1bppPn2/5P2/PPP2QPP/2NRBRK1 w - - 8 25", 
"r1bq1rk1/ppp2ppp/2np1b1n/3Q2N1/2B1PP2/4B3/PP2N1PP/R4RK1 b - - 0 13"
), Moves = c("e3d4 f3g2 f1g2 b7g2 h1g2 c5d4", "e1b4 f4h3 g1h1 h3f2", 
"h6g4 g5f7 f8f7 d5f7"), GameUrl = c("https://lichess.org/6OEDg4W3#Some(36)", 
"https://lichess.org/W9LaAFV1#Some(48)", "https://lichess.org/BxbS4jtt/black#Some(25)"
)), row.names = c(NA, -3L), class = c("data.table", "data.frame"
), .internal.selfref = <pointer: 0x0000026e39ef2e30>)

Solution

  • R really deserves a more complete package implementing chess stuff independently of engines. I suspect that Python does much better here. Well, here are some wrappers around bigchess that should do what you want for valid FEN and LAN movetext ...

    read.pos <- function(pos) {
        map <- list("P" =  1L, "B" =  2L, "N" =  3L, "R" =  4L, "Q" =  5L, "K" =  6L,
                    "p" = -1L, "b" = -2L, "n" = -3L, "r" = -4L, "q" = -5L, "k" = -6L)
        map <- c(map, setNames(lapply(0:8, integer), c("/", 1:8)))
        matrix(unlist(map[strsplit(pos, "")[[1L]]], FALSE, FALSE),
               nrow = 8L, ncol = 8L, byrow = TRUE,
               dimnames = list(8:1, letters[1:8]))
    }
    
    fenlan2san <- function(fen, lan) {
        lan <- strsplit(lan, " ")[[1L]]
        nhm <- length(lan)
        if (nhm == 0L)
            return("")
        fen <- strsplit(fen, " ")[[1L]]
        pos <- read.pos(fen[1L])
        san <- character(nhm)
        for (i in seq_along(lan)) {
            move <- bigchess:::string.lan.move2move(lan[i])
            m1 <- move[1L]; m2 <- move[2L]; m3 <- move[3L]; m4 <- move[4L]; m5 <- move[5L]
    
            wb <- sign(pos[m1, m2])
            san[i] <- bigchess:::move2san(pos, m1, m2, m3, m4, m5)
            pos <- bigchess:::position.move(pos, m1, m2, m3, m4, m5)
            if (bigchess:::is.check(pos, wb))
                san[i] <- paste0(san[i], if (bigchess:::is.mate(pos, wb)) "#" else "+")
        }
        wtm <- fen[2L] == "w"
        nfm <- (nhm + (if (wtm) 1L else 2L)) %/% 2L
        i1 <- as.integer(fen[6L])
        i2 <- i1 - 1L + nfm
        if (wtm)
            san[c(TRUE, FALSE)] <- paste0( i1      :i2, ". ", san[c(TRUE, FALSE)])
        else {
            san[1L] <- paste0(i1, "... ", san[1L])
            if (i1 < i2)
            san[c(FALSE, TRUE)] <- paste0((i1 + 1L):i2, ". ", san[c(FALSE, TRUE)])
        }
        paste0(san, collapse = " ")
    }
    
    fenlan2pgn <- function(fen, lan)
        paste0("[Variant \"From Position\"] [FEN \"", fen, "\"] ", mapply(fenlan2san, fen, lan))
    

    And then:

    fen <- c("r3k2r/1b1pbppp/p7/1pp5/3q4/P1NPBp1P/1PP1B1P1/R4Q1K w kq - 0 19",
             "3rr1k1/5ppp/6q1/pp6/1bppPn2/5P2/PPP2QPP/2NRBRK1 w - - 8 25",
             "r1bq1rk1/ppp2ppp/2np1b1n/3Q2N1/2B1PP2/4B3/PP2N1PP/R4RK1 b - - 0 13")
    lan <- c("e3d4 f3g2 f1g2 b7g2 h1g2 c5d4",
             "e1b4 f4h3 g1h1 h3f2",
             "h6g4 g5f7 f8f7 d5f7")
    writeLines(fenlan2pgn(fen, lan))
    
    [Variant "From Position"] [FEN "r3k2r/1b1pbppp/p7/1pp5/3q4/P1NPBp1P/1PP1B1P1/R4Q1K w kq - 0 19"] 19. Bxd4 fxg2+ 20. Qxg2 Bxg2+ 21. Kxg2 cxd4
    [Variant "From Position"] [FEN "3rr1k1/5ppp/6q1/pp6/1bppPn2/5P2/PPP2QPP/2NRBRK1 w - - 8 25"] 25. Bxb4 Nh3+ 26. Kh1 Nxf2+
    [Variant "From Position"] [FEN "r1bq1rk1/ppp2ppp/2np1b1n/3Q2N1/2B1PP2/4B3/PP2N1PP/R4RK1 b - - 0 13"] 13... Ng4 14. Nxf7 Rxf7 15. Qxf7+
    

    Importing each PGN to the Lichess analysis board suggests that it's working OK: https://lichess.org/analysis

    But my feeling is that someone familiar with stockfish and the UCI protocol could get the same result in a much nicer way ...