Go is a set of coordinates for stones that never move, but it's not as simple as plotting them. Stones are "connected" on the cardinal directions, and if a group of them is completely surrouding on cardinal points, they are removed from the board. So, the same spot might have many stones placed on it throughout the game, and Go programs must take that into acccount.
To properly figure this out, we need to create a groups table that dynamically runs forwards through the game.
The basic algorithm is as follows: each stone has a group_id
which represents all stones that share the same liberties. Stones can only be part of the same group as a result of a move by that player; enemy play cannot join groups together. Conversely, a group can only reach 0 liberties as a result of enemy action (with the exception of suicides which are prohibited under most rulessets).
Once removed, play no more role in any calculations.
changes to kaya then:
- instide the moves table, a group_id
and a move_number
which labels all setup stones are move 0
- also new metadata, n_moves
which is NOT the nrow(moves) b/c of handicap and other stones which are "move 0"
for each move i in 1:n_moves, do the following: step 1: identify enemy color and (re)assign group_id for all "active" stones of that color, from move 0 to move (i-1) step 2: (re)calculate liberties for all groups of active stones of enemy color, taking into account all active stones on board including move i just played. if any such groups of enemy stones have 0 liberties, reassign the group_id for the stones of that group to "removed" (step 3): optionally repeat step 1 and step 2 for groups of the color that just placed the move. this should never matter but might be useful as a check against illegal moves (suicides)
that should give you the present/absent state for the board at move j, then just plot all the moves classified as "present" and you are good!
We do this step in two parts. First, we detect direct connections between dyadic pairs of stones, via a nxn presence-absence matrix which is empty in the lower triangle. This is accomplished by an id_direct_connections
function. Second, we use this direct connections matrix to infer all clusters of groups, which is done by id_groups
. The latter function calls the former during its operation.
# input is just the emove list # output is the vector of group id id_direct_connections_refactor <- function(moves){ # for n moves there are n*n - n ordered dyads, but that repeates each twice so # n(n-1)/2 unique "groups" (order doesnt matted) # so for each i in 1:(n-1) we look over all j from 1+1 to n # is there a tie between these two coordinates? only if diff(x) == 0 & diff(y) == 1 or vis versa direct_mat <- matrix(FALSE, nrow = nrow(moves), ncol = nrow(moves)) diag(direct_mat) <- TRUE n <- nrow(moves) for (i in 1:(n - 1)){ for (j in (i + 1):n){ tied <- abs(diff(moves$column[c(i,j)])) + abs(diff(moves$row[c(i,j)])) == 1 if(tied){ direct_mat[i,j] <- TRUE } } } return(direct_mat) } # this could maybe be sped up by evaluating each dyad in a directed fashion? # right now im checking each space around a stone for an empty one but we know!
# ha! the refactor is super slow! # its because original needs only check 4 places, vs refactor which has to check all stones! library(testthat) for(i in 1:1000){ x <- sample(1:19, 150, replace = TRUE) y <- sample(1:19, 150, replace = TRUE) moves <- data.frame(column = x, row = y) drop <- which(duplicated(moves)) if(length(drop)>0) moves <- moves[-drop,] dat <- id_direct_connections(moves) expect_true(identical(id_direct_connections(moves), id_direct_connections_refactor(moves))) if(i %% 10 == 0) print(i) }
At most 4 other stones can be connected to each stone, at least 0, which provides a useful test of the row-column sums of this matrix.
I use the following algorith on the direct connections matrix.
For each row, identify the columns that have a tie. These are all in the same group as the row. Then, for each column that is included here, identify all the other rows that have ties to that column. This captures all relationships in that group, and we need only assign a common ID at that point. Iterating over all rows gives the solution, though this is inefficient.
Here's a testing area for the algorithm.
for(t in 1:10000){ # make a fake direct connection matrix blah <- sample( c(TRUE, FALSE), size = 8*8, prob = c(1,10), replace = TRUE) test_direct_mat <- matrix(blah, nrow = 8, ncol = 8) diag(test_direct_mat) <- TRUE direct_mat <- test_direct_mat | t(test_direct_mat) test_direct_mat # now i just need to provide a direct connection matrix and an ID for all the moves...hmmm... # direct_mat[lower.tri(direct_mat)] <- FALSE # direct_mat <- direct_mat | t(direct_mat) group_IDs <- LETTERS[1:nrow(direct_mat)] # fails if > 26 groups for(i in 1:length(group_IDs)){ tie_cols <- which(direct_mat[i,]) leftmost <- group_IDs[tie_cols][1] ingroup <- tie_cols for(j in 1:length(tie_cols)){ tie_rows <- which(direct_mat[,tie_cols[j]]) ingroup <- c(ingroup, tie_rows) for(k in 1:length(tie_rows)){ tie_cols_2 <- which(direct_mat[tie_rows[k],]) ingroup <- c(ingroup, tie_cols_2) for(l in 1:length(tie_cols_2)){ tie_rows_2 <- which(direct_mat[,tie_cols_2[l]]) ingroup <- c(ingroup, tie_rows_2) for(m in 1:length(tie_rows_2)){ tie_cols_3 <- which(direct_mat[tie_rows_2[m],]) ingroup <- c(ingroup, tie_cols_3) } } } } ingroup <- sort(unique(ingroup)) group_IDs[ingroup] <- leftmost } dat <- direct_mat | t(direct_mat) singletons <- group_IDs[which(colSums(dat) == 1)] groupers <- group_IDs[which(colSums(dat) > 1)] multistone_ids <- sort(unique(group_IDs[duplicated(group_IDs)])) expect_true(!any(singletons %in% multistone_ids)) expect_true(all(groupers %in% multistone_ids)) if(t %% 10 == 0) print(t) } # ah, htis algorithm is imperfect, I can still find problems this way... # look into grouping alogritms for ties...maybe its a quick q for jeremy # or maybe use the n*(n-1)/2 strat i wa sthinkig of earlier...hmm... # just mkae an edge list and go down it one by one?
diagnostics on id_groups: - no stone should be directly connected to more than 4 other stones [x] - no stone with 0 direct connections should be in a multistone group - stone shoud not appaer in more than one group (duh) - should not appear in group of another color! (hmmm)
So defined, now lets test out these functions for identifying groups
moves$group_id <- id_groups(moves) group_list <- sort(unique(moves$group_id)) group_colors <- rainbow(length(group_list)) moves$group_colors <- group_colors[match(moves$group_id, group_list)] plot(moves$column, moves$row, pch=20, col=moves$group_colors) sort(table(moves$group_id))
Ok, seems to be working (not really!). On to step 2!
The step 2 of this process is to count the liberties of the enemy groups and remove those stones that have 0 liberties.
So we count up all liberties for each stone, and sum them iwhtin groups. Group liberties only matter when they are 0, so we dont have to owrry about the fact multiple stones in a group might overcount the same liberty.
for each group in group_id for each move in that group count how many adjacent spots do NOT appear in the game moves object's present stones
x <- sample(1:19, 100, replace = TRUE) y <- sample(1:19, 100, replace = TRUE) moves <- data.frame(column = x, row = y) drop <- which(duplicated(moves)) if(length(drop)>0) moves <- moves[-drop,] game_moves <- moves game_moves$number <- 1:nrow(game_moves) game_moves$group_id <- id_groups(game_moves) moves <- game_moves focal_move <- 10 plot(moves$column, moves$row) points(moves$column[focal_move], moves$row[focal_move], col="red", pch=20) x <- count_liberties(moves) x[focal_move]
over each group_id it counts up all the liberties
it replays the entire game to a move to assign that state
The two steps defined above happen after each move is played. group updating happens to the same color stones counting liberties and poentially removing gtoups happens to opposite color stones
# important check: stones of diff colors in same group! library(kaya) my_game <- read_sgf("./inputs/2009-09-01-1.sgf") game_moves <- my_game$moves n_moves <- max(game_moves$number) game_moves$group_id <- id_maker(n=nrow(game_moves), nchars=3) game_moves$n_liberties <- count_liberties(game_moves) for(i in 1:n_moves){ # 1. update group identity of stones of same color for all moves up to this move update_rows <- which(game_moves$color == game_moves$color[i] & game_moves$number <= i & game_moves$group_id != "removed") if(length(update_rows) > 0) game_moves$group_id[update_rows] <- id_groups(game_moves[update_rows, c("column", "row", "group_id")]) bad <- any(game_moves$group_id[which(game_moves$group_id != "removed" & game_moves$color=="black")] %in% game_moves$group_id[which(game_moves$group_id != "removed" & game_moves$color=="white")]) if(bad) stop("mixup groups!") # 2. recount liberties for all stones active_rows <- which(game_moves$number <= i & game_moves$group_id != "removed") game_moves$n_liberties[active_rows] <- count_liberties(game_moves[active_rows,]) # 3. remove enemy groups with 0 liberties! update_rows <- which(game_moves$color == game_moves$color[i-1] & game_moves$number < i & game_moves$group_id != "removed") group_liberties <- tapply(game_moves$n_liberties[update_rows], game_moves$group_id[update_rows], sum) removable_groups <- names(which(group_liberties == 0)) if(length(removable_groups) > 0){ game_moves$group_id[update_rows][which(game_moves$group_id[update_rows] %in% removable_groups)] <- "removed" } # 4. recount liberties again active_rows <- which(game_moves$number <= i & game_moves$group_id != "removed") game_moves$n_liberties[active_rows] <- count_liberties(game_moves[active_rows,]) # 5. suicide check update_rows <- which(game_moves$color == game_moves$color[i] & game_moves$number <= i & game_moves$group_id != "removed") group_liberties <- tapply(game_moves$n_liberties[update_rows], game_moves$group_id[update_rows], sum) removable_groups <- names(which(group_liberties == 0)) if(length(removable_groups) > 0){ stop(paste("suicide detected at move ", i)) } tar <- which(game_moves$number <= i & game_moves$group_id != "removed") plot(game_moves$column[tar], game_moves$row[tar], pch=21, bg=game_moves$color[tar], xlim=c(1,19), ylim=c(1,19), main=i, cex=3) tar <- which(game_moves$number <= i & game_moves$group_id == "removed") points(game_moves$column[tar], game_moves$row[tar], pch=20, cex=0.5, col="red") Sys.sleep(0.1) }
my_game <- read_sgf("./inputs/2009-09-01-1.sgf") game_moves <- my_game$moves game_moves$number <- 1:nrow(game_moves) n_moves <- max(game_moves$number) game_moves$group_id <- id_maker(n=nrow(game_moves), nchars=3) game_moves$group_id <- update_status(game_moves) # run it forwards now my_game <- read_sgf("./inputs/2009-09-01-1.sgf") if(is.na(max)) max <- my_game$n_moves moves <- my_game$moves moves$rev_color <- ifelse(moves$color=="black", "white", "black" ) moves$group_id <- id_maker(nrow(moves), nchar=3) for(i in 1:20){ update_rows <- which(moves$number <= i & moves$group_id != "removed") moves$group_id[update_rows] <- update_status(moves[update_rows,]) } i <- i + 1 update_rows <- which(moves$number <= i & moves$group_id != "removed") update_status(moves[update_rows,]) plot(moves$column[update_rows], moves$row[update_rows], bg=moves$color[update_rows], pch=21) groups <- sort(unique(game_moves$group_id)) groups <- setdiff(groups, "removed") group_cols <- rainbow(length(groups)) game_moves$group_cols <- group_cols[match(game_moves$group_id, groups)] i <- n_moves par(mfrow = c(1,2)) tar <- which(game_moves$number <= i & game_moves$group_id != "removed") plot(game_moves$column[tar], game_moves$row[tar], pch=21, bg=game_moves$group_cols[tar], xlim=c(1,19), ylim=c(1,19), main=i, cex=3) tar <- which(game_moves$number <= i & game_moves$group_id != "removed") plot(game_moves$column[tar], game_moves$row[tar], pch=21, bg=game_moves$color[tar], xlim=c(1,19), ylim=c(1,19), main=i, cex=3) tar <- which(game_moves$number <= i & game_moves$group_id == "removed") points(game_moves$column[tar], game_moves$row[tar], pch=20, cex=0.5, col="red")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.