Charada: Você consegue resolver o mistério do xadrez?

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br


[Esteartigofoipublicadopelaprimeiravezem[Thisarticlewasfirstpublishedon Posts | Joshua Cook, e gentilmente contribuiu para os R-blogueiros]. (Você pode relatar um problema sobre o conteúdo desta página aqui)


Deseja compartilhar seu conteúdo com R-blogueiros? clique aqui se você tiver um blog ou aqui se não tiver.

Sumário

O enigmático é um
quebra-cabeça semanal fornecido pela FiveThirtyEight. O quebra-cabeça desta semana envolve
encontrar o caminho usado pelo cavaleiro para matar a rainha adversária em um jogo
de xadrez. Abaixo, mostro como resolvi quebra-cabeças usando dois métodos:
simulação do tabuleiro de xadrez e construindo um gráfico das possíveis
caminhos para o cavaleiro. As simulações foram boas, mas a solução não foi
encontrado na primeira tentativa. Somente depois de perceber um insight importante, o
enigma ser resolvido.

Riddler Express da FiveThirtyEight

https://fivethirtyeight.com/features/can-you-solve-the-chess-mystery/

De Yan Zhang vem um mistério de assassinato real:

Bispo Negro: “Senhor, testes forenses indicam o assassino da rainha,
o Cavaleiro Branco entre nós, mudou-se exatamente oito vezes desde o
início do jogo, que foi jogado pelas regras legais. ”

Rei Negro: “Então?”

Bispo Negro: “Bem, para condenar esse assassino, precisamos construir uma
história legal do jogo. Mas não conseguimos descobrir como ele chegou lá! “

Você pode descobrir isso?

tabuleiro de xadrez

(O
solução
está disponível no final do Charada da semana seguinte.)

knitr::opts_chunk$set(echo = TRUE, comment = "#>")
library(glue)
library(tidygraph)
library(ggraph)
library(tidyverse)
theme_set(theme_minimal())

Método de simulação

O primeiro método que tentei foi usar uma simulação para encontrar o caminho de
o espaço em branco para o espaço final.

Eu abstraí o tabuleiro de xadrez como uma matriz com 0 como espaço vazio, 1 como um
ocupado, e 2 como cavaleiro.

chessboard <- matrix(c(
1, 1, 1, 0, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
1, 1, 1, 1, 1, 1, 1, 1,
1, 2, 1, 1, 1, 1, 1, 1
), nrow = 8, byrow = TRUE)
chessboard
#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
#> [1,] 1 1 1 0 1 1 1 1
#> [2,] 1 1 1 1 1 1 1 1
#> [3,] 0 0 0 0 0 0 0 0
#> [4,] 0 0 0 0 0 0 0 0
#> [5,] 0 0 0 0 0 0 0 0
#> [6,] 0 0 0 0 0 0 0 0
#> [7,] 1 1 1 1 1 1 1 1
#> [8,] 1 2 1 1 1 1 1 1

Eu criei um monte de funções que cuidam de diferentes partes do
o algoritmo.

# Return the current location of the knight on the chessboard `mat`.
get_knight_location <- function(mat) {
knight_row <- which(apply(mat, 1, function(x) any(x == 2)))
knight_col <- which(apply(mat, 2, function(x) any(x == 2)))
return(list(x = knight_col, y = knight_row))
}
get_knight_location(chessboard)
#> $x
#> [1] 2
#>
#> $y
#> [1] 8
# A helper for visiualizing the chessboard.
print_chessboard <- function(mat) {
new_mat <- mat
new_mat[new_mat == "0"] <- " "
new_mat[new_mat == "1"] <- "+"
new_mat[new_mat == "2"] <- "H"
new_mat[1, 4] <- "o"
print(new_mat)
invisible(NULL)
}
print(chessboard)
#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
#> [1,] 1 1 1 0 1 1 1 1
#> [2,] 1 1 1 1 1 1 1 1
#> [3,] 0 0 0 0 0 0 0 0
#> [4,] 0 0 0 0 0 0 0 0
#> [5,] 0 0 0 0 0 0 0 0
#> [6,] 0 0 0 0 0 0 0 0
#> [7,] 1 1 1 1 1 1 1 1
#> [8,] 1 2 1 1 1 1 1 1
# Movement: (horizontal movement, vertical movement)
possible_knight_movements %
as_tibble() %>%
set_names(c("x", "y"))
possible_knight_movements
#> # A tibble: 8 x 2
#> x y
#>  
#> 1 1 2
#> 2 -1 2
#> 3 1 -2
#> 4 -1 -2
#> 5 2 1
#> 6 -2 1
#> 7 2 -1
#> 8 -2 -1

Uma otimização que adicionei à simulação para ajudá-la a realizar melhor
do que uma caminhada puramente aleatória era para impedir que ela refizesse seus passos.
Isso foi alcançado adicionando um check-in is_available_move() prevenir
retorne à etapa anterior. (Como vemos na final
solução, isso não era realmente necessário.)

# Select a random move for the knight.
get_random_movement <- function() {
sample_n(possible_knight_movements, 1)
}
# Get the new location of the knight after a move.
get_new_location <- function(movement, current_loc) {
new_x_loc <- movement$x + current_loc$x
new_y_loc <- movement$y + current_loc$y
return(list(x = new_x_loc, y = new_y_loc))
}
# Move the knight on the board.
move_knight_to_new_location <- function(movement, mat) {
current_loc <- get_knight_location(mat)
new_loc <- get_new_location(movement, current_loc)
new_mat <- mat
new_mat[current_loc$y, current_loc$x] <- 0
new_mat[new_loc$y, new_loc$x] <- 2
return(new_mat)
}
previous_location <- get_knight_location(chessboard)
# Is the new position on a board possible or available.
# i.e. can the knight make the `movement` on the `mat`.
# This function "remembers" the previous location and will not let the knight
# move backwards. Because this is reset at the beginning, the knight won't get
# trapped in a corder forever, just one round.
is_available_move <- function(movement, mat) {
current_loc <- get_knight_location(mat)
new_loc <- get_new_location(movement, current_loc)
# Check that the piece stays on the board.
if (new_loc$x  ncol(chessboard)) {
return(FALSE)
} else if (new_loc$y  nrow(chessboard)) {
return(FALSE)
}
# Check if the new location would be the same as the previous location.
if (new_loc$x == previous_location$x & new_loc$y == previous_location$y) {
return(FALSE)
}
# Check the new space is not already taken.
if (mat[new_loc$y, new_loc$x] == 1) {
return(FALSE)
}
previous_location <<- current_loc
TRUE
}
# Move the knight one time randomly, but legally.
move_knight <- function(mat) {
old_loc <- get_knight_location(mat)
movement <- get_random_movement()
while(!is_available_move(movement, mat)) {
movement <- get_random_movement()
}
move_knight_to_new_location(movement, mat)
}

A função de jogar uma rodada apenas chama move_knight() 8 vezes no
mesmo tabuleiro de xadrez. Retorna uma pitada com os locais do cavaleiro
durante o processo.

# Return a tidy tibble of the knights locations.
knight_location_tidy %
mutate(x = map_dbl(value, ~ .x[[1]]),
y = map_dbl(value, ~ .x[[2]])) %>%
select(move_idx, x, y) %>%
mutate(move_idx = move_idx - 1)
}
# Play a round of the simulation.
play_round <- function(num_moves = 8) {
gameboard <- chessboard
knight_locs <- rep(NA, num_moves + 1)
knight_locs[1] <- list(get_knight_location(gameboard))
for (i in seq(1, num_moves)) {
gameboard <- move_knight(gameboard)
knight_locs[i + 1] <- list(get_knight_location(gameboard))
}
return(knight_location_tidy(knight_locs))
}
play_round()
#> # A tibble: 9 x 3
#> move_idx x y
#>   
#> 1 0 2 8
#> 2 1 3 6
#> 3 2 1 5
#> 4 3 3 4
#> 5 4 4 6
#> 6 5 5 4
#> 7 6 3 3
#> 8 7 2 5
#> 9 8 1 3

Também adicionei uma função simples para traçar o caminho do cavaleiro. Cada passo
é rotulado com seu lugar na sequência.

# A visualization tool for the path of the knight.
plot_knight_locations %
ggplot(aes(x = x, y = y, color = move_idx)) +
geom_path(aes(group = game_idx), size = 2) +
geom_point(size = 5) +
scale_x_continuous(limits = c(1, 8),
expand = expansion(add = c(0.1, 0.1)),
breaks = 1:8) +
scale_y_continuous(limits = c(1, 8),
expand = expansion(add = c(0.1, 0.1)),
breaks = 1:8) +
scale_color_viridis_c(breaks = seq(0, 8, 2)) +
theme(
panel.grid.major = element_line(color = "grey50", size = 0.5),
panel.grid.minor = element_blank(),
panel.border = element_rect(fill = NA, color = "grey50")
)
}
play_round() %>%
add_column(game_idx = 1) %>%
plot_knight_locations()

Leia Também  RcppAnnoy 0.0.16 | R-bloggers

Finalmente, podemos jogar o jogo várias vezes até que uma solução seja encontrada.

# `TRUE` is returned if the riddle was solved.
finished_riddle <- function(df) {
last_loc % slice(nrow(df))
if (last_loc$x == 4 & last_loc$y == 1) {
return(TRUE)
} else {
return(FALSE)
}
}
set.seed(0)
n_max <- 5e2
all_games <- rep(NA, n_max)
for (i in seq(1, n_max)) {
moves <- play_round()
all_games[i] <- list(moves)
if (finished_riddle(moves)) {
print("RIDDLE SOLVED!")
break
}
}

Curiosamente, o ponto final desejado, (4, 1), foi alcançado, mas não em
o fim do caminho.

bind_rows(all_games, .id = "game_idx") %>%
plot_knight_locations()

Podemos ver os locais mais visitados (ignorando o ponto de partida
localização).

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br
bind_rows(all_games, .id = "game_idx") %>%
count(x, y) %>%
mutate(n = ifelse(x == 2 & y == 8, 1, n)) %>%
ggplot(aes(x = x, y = y, color = n)) +
geom_point(aes(size = n), alpha = 0.7) +
scale_x_continuous(limits = c(1, 8),
expand = expansion(add = c(0.1, 0.1)),
breaks = 1:8) +
scale_y_continuous(limits = c(1, 8),
expand = expansion(add = c(0.1, 0.1)),
breaks = 1:8) +
scale_color_gradient(low = "dodgerblue", high = "tomato") +
scale_size_continuous(range = c(3, 25)) +
theme(
panel.grid.major = element_line(color = "grey50", size = 0.5),
panel.grid.minor = element_blank(),
panel.border = element_rect(fill = NA, color = "grey50")
)

Depois de muitas simulações (apenas 500 mostradas acima, mas também tentei
10.000), nenhuma solução foi encontrada. Eu fui inspirado pela visualização para
tente uma abordagem baseada em gráficos.

Método gráfico

Eu posso construir um gráfico de todos os caminhos possíveis do cavaleiro, dado o
estado do quadro e, em seguida, encontre o caminho entre o início e o fim desse
tem 8 passos.

O processo de criação de gráficos é um pouco complicado, mas segue o
algoritmo básico descrito abaixo:

  1. Comece a partir de um local inicial ((2, 8) no inicio).
  2. Encontre todos os próximos locais possíveis para o cavaleiro.
  3. Desses locais, adicione os novos a um registro de locais visitados
    (position_table)
  4. Adicione à lista de arestas (edge_list) um link entre o pai (x,y)

    para estas próximas posições.

  5. Para os nós que ainda não foram visitados, repita esse algoritmo
    para cada.

# A table to track where the algorithm has been already.
position_table <- tibble(x = 2, y = 8)
# An edge list for the graph.
edge_list <- tibble()
# A tibble with the possible x and y changes of position for the knight.
possible_knight_changes %
set_names(c("change_x", "change_y"))
# Is the position allowed on the chessboard?
position_is_allowed  8 | x  8 | y < 1) {
return(FALSE)
} else if (chessboard[y, x] != 0) {
return(FALSE)
}
TRUE
}
# A tibble of the next possible locations for the knight.
possible_next_positions %
bind_rows() %>%
bind_cols(possible_knight_changes) %>%
mutate(x = x + change_x,
y = y + change_y,
is_legal = map2_lgl(x, y, position_is_allowed)) %>%
filter(is_legal) %>%
select(x, y)
}
# Build the graphs starting from a seed x and y position.
get_knight_edges <- function(x, y) {
df <- possible_next_positions(x, y)
# Add the new edges to the edge list.
edge_list <<- bind_rows(
edge_list,
tibble(from = paste0(x, ",", y),
to = paste0(df$x, ",", df$y))
)
# Remove positions already recorded.
df % anti_join(position_table, b = c("x", "y"))
if (nrow(df) != 0) {
position_table <<- bind_rows(position_table, df)
for (i in 1:nrow(df)) {
get_knight_edges(df$x[[i]], df$y[[i]])
}
}
invisible(NULL)
}
get_knight_edges(2, 8)
edge_list
#> # A tibble: 134 x 2
#> from to
#>  
#> 1 2,8 3,6
#> 2 2,8 1,6
#> 3 3,6 4,4
#> 4 3,6 2,4
#> 5 3,6 5,5
#> 6 3,6 1,5
#> 7 4,4 5,6
#> 8 4,4 3,6
#> 9 4,4 6,5
#> 10 4,4 2,5
#> # … with 124 more rows

A lista de arestas pode ser transformada em tidygraph do 'arrumar'
biblioteca.

knight_graph <- as_tbl_graph(edge_list, directed = FALSE)
knight_graph
#> # A tbl_graph: 34 nodes and 134 edges
#> #
#> # An undirected multigraph with 1 component
#> #
#> # Node Data: 34 x 1 (active)
#> name
#> 
#> 1 2,8
#> 2 3,6
#> 3 4,4
#> 4 5,6
#> 5 6,4
#> 6 7,6
#> # … with 28 more rows
#> #
#> # Edge Data: 134 x 2
#> from to
#>  
#> 1 1 2
#> 2 1 34
#> 3 2 3
#> # … with 131 more rows

Aqui está uma visualização simples do gráfico.

knight_graph %N>%
mutate(color = case_when(name == "2,8" ~ "start",
name == "4,1" ~ "end",
TRUE ~ "middle")) %>%
ggraph(layout = "stress") +
geom_edge_link() +
geom_node_label(aes(label = name, color = color)) +
scale_color_manual(values = c("green3", "grey40", "dodgerblue")) +
theme_graph()

Uma maneira possível de encontrar o caminho de 8 etapas entre o “início” e
"Fim" seria elucidar todos os caminhos possíveis e depois encontrar aqueles
de comprimento 8. No entanto, isso leva muito tempo, então eu usei um
método de caminhada. No entanto, ainda não consegui encontrar uma solução após 1.000
passeios aleatórios.

n_max <- 1e3
set.seed(0)
for (i in seq(1, n_max)) {
path <-igraph::random_walk(knight_graph,
start = "2,8",
steps = 9,
mode = "all")
if (names(path)[[9]] == "4,1") {
print("RIDDLE SOLVED!")
break
}
}

Isso significa que meus dois métodos falharam em encontrar uma solução para esse problema.
Charada…

Problema com meus métodos de solução

O cavaleiro não pode viajar do quadrado em branco original para o final
posição.
Isso é verdade porque toda vez que o cavaleiro se move, ele vai
de um quadrado preto para um quadrado branco ou de um branco para um quadrado preto. Assim, é
não é possível para o cavaleiro no canto inferior esquerdo viajar de um branco
quadrado para um quadrado preto em 8 movimentos. Em 8 movimentos, ele estará sempre em um
quadrado branco novamente.

Solução

Assim, o cavaleiro que matou a rainha deve ter vindo do
o cavaleiro inferior direito e o cavaleiro inferior esquerdo tomaram seu lugar. Nós podemos resolver o
quebra-cabeça, apenas alterando o tabuleiro de xadrez original e re-executando o
simulações e pesquisa de gráficos.

Simulação

Se mudarmos o tabuleiro de xadrez e tentarmos novamente o método de simulação, ele encontrará um
solução facilmente.

chessboard <- matrix(c(
1, 1, 1, 0, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 2, 1
), nrow = 8, byrow = TRUE)
chessboard
#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
#> [1,] 1 1 1 0 1 1 1 1
#> [2,] 1 1 1 1 1 1 1 1
#> [3,] 0 0 0 0 0 0 0 0
#> [4,] 0 0 0 0 0 0 0 0
#> [5,] 0 0 0 0 0 0 0 0
#> [6,] 0 0 0 0 0 0 0 0
#> [7,] 1 1 1 1 1 1 1 1
#> [8,] 1 1 1 1 1 1 2 1
previous_location <- get_knight_location(chessboard)
set.seed(0)
n_max <- 1e2
all_games <- rep(NA, n_max)
for (i in seq(1, n_max)) {
moves <- play_round()
all_games[i] <- list(moves)
if (finished_riddle(moves)) {
print("RIDDLE SOLVED!")
break
}
}
#> [1] "RIDDLE SOLVED!"
all_games <- all_games[!is.na(all_games)]
successful_game <- all_games[length(all_games)][[1]]
successful_game %
mutate(game_idx = 1)
p <- plot_knight_locations(successful_game)
p +
ggrepel::geom_text_repel(aes(label = move_idx),
color = "black", size = 6)

Gráfico

Também podemos tentar o método baseado em gráficos novamente, e desta vez ele encontra um
solução.

# A table to track where the algorithm has been already.
position_table <- tibble(x = 7, y = 8)
# An edge list for the graph.
edge_list <- tibble()
get_knight_edges(7, 8)
new_knight_graph <- as_tbl_graph(edge_list, directed = FALSE)
new_knight_graph
#> # A tbl_graph: 34 nodes and 134 edges
#> #
#> # An undirected multigraph with 1 component
#> #
#> # Node Data: 34 x 1 (active)
#> name
#> 
#> 1 7,8
#> 2 8,6
#> 3 7,4
#> 4 5,5
#> 5 6,3
#> 6 7,5
#> # … with 28 more rows
#> #
#> # Edge Data: 134 x 2
#> from to
#>  
#> 1 1 2
#> 2 1 34
#> 3 2 3
#> # … with 131 more rows
n_max <- 1e2
set.seed(0)
for (i in seq(1, n_max)) {
path <-igraph::random_walk(new_knight_graph,
start = "7,8",
steps = 9,
mode = "all")
if (names(path)[[9]] == "4,1") {
print("RIDDLE SOLVED!")
break
}
}
#> [1] "RIDDLE SOLVED!"
print(path)
#> + 9/34 vertices, named, from d355afd:
#> [1] 7,8 8,6 7,4 6,6 4,5 6,4 4,5 5,3 4,1
p %
mutate(x = as.numeric(str_extract(node, "^[:digit:]")),
y = as.numeric(str_extract(node, "[:digit:]$"))) %>%
mutate(move_idx = 1:n() - 1,
game_idx = 1) %>%
plot_knight_locations()
p +
ggrepel::geom_text_repel(aes(label = move_idx), color = "black")

Parece que existem realmente algumas soluções diferentes. 34 diferentes
Foram encontrados caminhos em 10.000 ensaios.

n_max <- 1e4
set.seed(0)
successful_paths <- c()
for (i in seq(1, n_max)) {
path <-igraph::random_walk(new_knight_graph,
start = "7,8",
steps = 9,
mode = "all")
if (names(path)[[9]] == "4,1") {
successful_paths <- c(successful_paths, path)
}
}
length(unique(successful_paths))
#> [1] 34

Se você der uma olhada no
solução
disponível no final do Riddler da semana seguinte, você verá que eu
resolveram com sucesso o quebra-cabeça.

var vglnk = {key: '949efb41171ac6ec1bf7f206d57e90b8'};

(função (d, t) {
var s = d.createElement
s.src = '//cdn.viglink.com/api/vglnk.js';
var r = d.getElementsByTagName
} (documento, 'script'));

Para Deixe um comentário para o autor, siga o link e comente no blog: Posts | Joshua Cook.

R-bloggers.com oferece atualizações diárias por email sobre notícias e tutoriais do R sobre o aprendizado do R e muitos outros tópicos. Clique aqui se você deseja publicar ou encontrar um emprego em ciência da dados / R.


Deseja compartilhar seu conteúdo com R-blogueiros? clique aqui se você tiver um blog ou aqui se não tiver.



cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br