Charada: Você pode continuar girando?

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.

Riddler Express do FiveThirtyEight

ligação

Na cidade de Riddler, as ruas da cidade seguem um layout de grade,
norte-sul e leste-oeste. Você está dirigindo para o norte quando decide
jogar um joguinho. Toda vez que você alcança um cruzamento, você aleatoriamente
vire à esquerda ou à direita, cada uma com 50% de chance.

Depois de atravessar 10 cruzamentos, qual é a probabilidade de
você ainda está dirigindo para o norte?

Crédito extra: agora suponha que, em todo cruzamento, exista uma
um terço de chance de virar à esquerda, um terço de chance de virar à direita e
uma chance de um terço de você seguir em frente. Depois de passar 10
interseções, agora qual é a probabilidade de você ainda estar dirigindo
norte?

Plano

Esse quebra-cabeça poderia ser resolvido analiticamente, mas isso exigiria muito
mais pensamento do que apenas simulá-lo. Vou tentar fazer o algoritmo
generalizável para também ser capaz de resolver o problema de crédito extra sem
muitas mudanças.

Configuração

knitr::opts_chunk$set(echo = TRUE, comment = "#>", cache = TRUE, dpi = 400)
library(tidyverse)
library(conflicted)
# Handle any namespace conflicts.
conflict_prefer("filter", "dplyr")
conflict_prefer("select", "dplyr")
# Default 'ggplot2' theme.
theme_set(theme_minimal())
# For reproducibility.
set.seed(0)

Uma única simulação

A abstração

O código para a simulação em si é muito simples e contém principalmente
dentro de duas funções, simulate_one_drive() que coordena tudo
e adjust_direction() que transforma o player com base no atual
direção e rotação aleatória. Mais sobre isso em um segundo.

A parte complicada dessa simulação foi escolher uma abstração. Minhas
As primeiras tentativas se basearam em acompanhar a direção cardinal
(isto é, norte, sul, leste e oeste), decidindo aleatoriamente a curva e
atualizando a direção cardinal com base na curva. Mas isso foi
irritantemente complicado porque o efeito da esquerda ou da direita no
direção cardinal depende da direção em si. Portanto,
parecia que eu precisaria escrever um formulário enorme (leia “propenso a erros”)
declaração.

Depois de bastante reflexão e diagramação, percebi que poderia usar
ângulos para resolver o problema. Se eu definir o norte como $ frac { pi} {2} $, então um
virar à esquerda seria equivalente a adicionar $ frac { pi} {2} $ e virar
right seria equivalente a subtrair $ frac { pi} {2} $. E isto
seria verdade independentemente da direção atual!

Usando essa abordagem, decidi apenas acompanhar o ângulo da
direção atual e ignore realmente viajando pela cidade. Eu
poderia apenas calcular isso depois, se necessário.

Leia Também  Janeiro 2020: "Top 40" novos pacotes R

O processo principal

Finalmente, podemos chegar ao código. o simulate_one_drive() função
assume probabilidades de virar à esquerda (l), certo (r) ou continuando
em linha reta (s) e um argumento para o número de etapas na simulação
(n_steps)

Imediatamente, a direção inicial é definida como $ frac {1} {2} $. Eu deixei
fora $ pi $ da simulação, porque eu nunca preciso de radianos,
apenas uma unidade relativa para o ângulo. Portanto, em vez de variar de 0
a $ 2 pi $, o “ângulo” varia de 0 a 2. Multiplicando por $ pi $
depois pode retornar os radianos.

Antes do loop for, há uma verificação rápida para garantir que o
as probabilidades somam 1.

Finalmente, o rastreador é instanciado como um quadro de dados com o
interação, direção atual e a escolha da curva (“S” para
começar com).

Em cada etapa do loop for

  1. um turno é escolhido aleatoriamente de acordo com a sua predeterminada
    probabilidades,
  2. a direção é alterada de acordo com o resultado da aleatória
    seleção usando o adjust_direction() função (mais em um
    segundo),
  3. o rastreador é atualizado com a etapa atual.

O rastreador é retornado como resultado da simulação.

# Simulate one drive.
simulate_one_drive <- function(l, r, s, n_steps = 10) {
# Start facing "North".
dir <- 1/2
# Check that the total probability of turning choices is 1.
stopifnot(sum(c(l, r, s)) == 1)
# Start the tracker.
tracker <- update_tracker(tibble(), 0, dir, "S")
# Take `n_steps` for the simulation.
for (i in seq(1, n_steps)) {
next_turn <- sample(c("L", "R", "S"), 1, prob = c(l, r, s))
dir <- adjust_direction(dir, next_turn)
tracker <- update_tracker(tracker, i, dir, next_turn)
}
return(tracker)
}

A função rastreador de atualização é apenas uma função de conveniência para adicionar
linhas para um quadro de dados do estado atual da simulação em cada
degrau.

# Update the tracker data frame.
update_tracker <- function(tracker, i, dir, turn) {
bind_rows(
tracker,
tibble(i = i, direction = dir, turn = turn)
)
}

o adjust_direction() A função segue uma direção atual (curr_dir)
e para que lado virar (turn) Em seguida, ele adiciona $ frac {1} {2} $ para ativar
esquerda ("L") ou subtrai $ frac {1} {2} $ para virar à direita ("R") o
a direção original é retornada para continuar em linha reta ("S")

Observe que o motivo dessa função ser tão simples não é porque eu fiz
qualquer coisa inteligente com o código, mas é porque a abstração
é tão natural para o problema.

# Adjust the current direction `curr_dir` based off of the `turn`.
adjust_direction <- function(curr_dir, turn) {
new_dir <- curr_dir
if (turn == "L") {
new_dir <- curr_dir + 0.5
} else if (turn == "R") {
new_dir <- curr_dir - 0.5
} else if (turn == "S") {
new_dir <- curr_dir
} else {
stop(paste0("The change in direction '", turn, "' is not recognized."))
}
return(new_dir)
}

Um exemplo de simulação

Abaixo, corro um único exemplo de simulação e recebo de volta o rastreador.

set.seed(0)
example_sim <- simulate_one_drive(0.5, 0.5, 0, n_steps = 10)
example_sim
#> # A tibble: 11 x 3
#> i direction turn
#>   
#> 1 0 0.5 S
#> 2 1 1 L
#> 3 2 0.5 R
#> 4 3 0 R
#> 5 4 0.5 L
#> 6 5 1 L
#> 7 6 0.5 R
#> 8 7 1 L
#> 9 8 1.5 L
#> 10 9 2 L
#> 11 10 2.5 L

De direction Na coluna, podemos calcular a alteração em $ x $ e
$ y $ convertendo das coordenadas polares $ (r, theta) $ para cartesiana
coordenadas $ (x, y) $:

Leia Também  Um exemplo onde a perda quadrada de uma previsão sigmóide não é convexa nos parâmetros

$ x = r times cos ( theta) $
$ y = r times sin ( theta) $

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br
example_sim2 %
mutate(dx = round(1 * cos(direction * pi)),
dy = round(1 * sin(direction * pi)))
example_sim2
#> # A tibble: 11 x 5
#> i direction turn dx dy
#>     
#> 1 0 0.5 S 0 1
#> 2 1 1 L -1 0
#> 3 2 0.5 R 0 1
#> 4 3 0 R 1 0
#> 5 4 0.5 L 0 1
#> 6 5 1 L -1 0
#> 7 6 0.5 R 0 1
#> 8 7 1 L -1 0
#> 9 8 1.5 L 0 -1
#> 10 9 2 L 1 0
#> 11 10 2.5 L 0 1

Com a alteração em $ x $ e $ y $ após cada turno na simulação,
a posição real do carro na grade pode ser calculada. Isto é
realizado usando o
accumulate2()

função do
'ronronar'
pacote.

calculate_position <- function(pos, dx, dy) {
new_pos <- pos
new_pos$x <- pos$x + dx
new_pos$y <- pos$y + dy
return(new_pos)
}
example_sim3 %
mutate(pos = accumulate2(dx, dy,
calculate_position,
.init = list(x = 0, y = 0))[-1],
x = map_dbl(pos, ~ .x$x),
y = map_dbl(pos, ~ .x$y))

Finalmente, para ter uma visualização mais satisfatória da simulação, nós
pode plotar as posições $ x $ e $ y $ para cada turno.

example_sim3 %>%
ggplot(aes(x, y)) +
geom_path(group = "a",
arrow = arrow(length = unit(4, "mm"), ends = "last", type = "closed")) +
geom_point() +
ggrepel::geom_text_repel(aes(label = i))

Para facilitar uma análise mais aprofundada dos resultados das simulações, empacotei
as etapas acima em uma única função
simulation_results_to_cartesian_positions().

calculate_position <- function(pos, dx, dy) {
new_pos <- pos
new_pos$x <- pos$x + dx
new_pos$y <- pos$y + dy
return(new_pos)
}
simulation_results_to_cartesian_positions %
mutate(dx = round(1 * cos(direction * pi)),
dy = round(1 * sin(direction * pi)),
pos = accumulate2(dx, dy,
calculate_position,
.init = list(x = 0, y = 0))[-1],
x = map_dbl(pos, ~ .x$x),
y = map_dbl(pos, ~ .x$y))
}
simulation_results_to_cartesian_positions(example_sim)
#> # A tibble: 11 x 8
#> i direction turn dx dy pos x y
#>        
#> 1 0 0.5 S 0 1  0 1
#> 2 1 1 L -1 0  -1 1
#> 3 2 0.5 R 0 1  -1 2
#> 4 3 0 R 1 0  0 2
#> 5 4 0.5 L 0 1  0 3
#> 6 5 1 L -1 0  -1 3
#> 7 6 0.5 R 0 1  -1 4
#> 8 7 1 L -1 0  -2 4
#> 9 8 1.5 L 0 -1  -2 3
#> 10 9 2 L 1 0  -1 3
#> 11 10 2.5 L 0 1  -1 4

Eu também fiz uma função de plotagem mais expressiva plot_simulation() aquele
mostra a direção em cada etapa.

plot_simulation %
group_by(sim) %>%
mutate(x_start = dplyr::lag(x, default = 0),
y_start = dplyr::lag(y, default = 0)) %>%
ungroup() %>%
ggplot() +
geom_segment(aes(x = x_start, y = y_start, xend = x, yend = y,
color = i, group = sim),
arrow = arrow(length = unit(3, "mm"), type = "closed"),
alpha = 1.0, size = 1) +
geom_label(aes((x_start + x) / 2, (y_start + y) / 2, label = i, fill = i),
color = "white", label.size = 0, fontface = "bold") +
scale_color_gradient(low = "grey70", high = "grey15", guide = FALSE) +
scale_fill_gradient(low = "grey75", high = "grey25", guide = FALSE) +
labs(x = "W  E",
y = "S  N")
}
example_sim %>%
simulation_results_to_cartesian_positions() %>%
mutate(sim = 1) %>%
plot_simulation()

A simulação

Finalmente, podemos executar várias simulações e analisar o original
questão:

Depois de atravessar 10 cruzamentos, qual é a probabilidade de
você ainda está dirigindo para o norte?

Primeiro, vamos traçar os resultados de 5 simulações para garantir que o
a simulação está funcionando como esperado em várias execuções.

set.seed(0)
tibble(sim = 1:5) %>%
mutate(res = map(sim, ~ simulate_one_drive(0.5, 0.5, 0, n_steps = 10)),
res = map(res, simulation_results_to_cartesian_positions)) %>%
unnest(res) %>%
plot_simulation()

Leia Também  Crescimento de cartões na Europa diminui para 2,7%, com pagamentos digitais começando a crescer

Com essa verificação, estamos prontos para executar alguns milhares de simulações.

set.seed(0)
N_sims <- 1e4
simulation_results %
mutate(res = map(sim, ~ simulate_one_drive(0.5, 0.5, 0, n_steps = 10)))
simulation_results
#> # A tibble: 10,000 x 2
#> sim res
#>  
#> 1 1 
#> 2 2 
#> 3 3 
#> 4 4 
#> 5 5 
#> 6 6 
#> 7 7 
#> 8 8 
#> 9 9 
#> 10 10 
#> # … with 9,990 more rows

Agora temos um quadro de dados longo com quadros de dados aninhados, cada um
representando os resultados de uma única simulação. Agora queremos dizer se
a direção final estava apontando para o norte. No entanto, há um sutil
problema: $ frac { pi} {2} = frac {5 pi} {2} = frac {9 pi} {2} =… $.
Existem muitos ângulos possíveis (infinitos) que apontam para o norte.
Portanto, eu escrevi o reduce_angle() função para reduzir qualquer ângulo para
estão entre 0 e 2 (porque removemos a constante $ pi $ do
ângulo de direção).

# Reduce the angle from an value to between 0 and 2.
reduce_angle <- function(theta) {
theta - (2 * trunc(theta / 2))
}

Agora, podemos desnaturar os resultados da simulação, tomar a última direção e
veja se está apontando para o norte.

simulation_results %
unnest(res) %>%
filter(i == 10) %>%
mutate(reduced_direction = reduce_angle(direction))
prob_north <- sum(simulation_results$reduced_direction == 0.5) / N_sims

A probabilidade de ainda estar voltado para o norte depois de virar aleatoriamente à esquerda e
direito em cada interseção é 0,369.

Crédito extra

Desde que eu permitia uma probabilidade de ir direto no
simulate_one_drive() , resolvendo o problema de crédito extra
não requer nenhuma alteração no código além de um único valor de argumento.

Crédito extra: agora suponha que, em todo cruzamento, exista uma
um terço de chance de virar à esquerda, um terço de chance de virar à direita e
uma chance de um terço de você seguir em frente. Depois de passar 10
interseções, agora qual é a probabilidade de você ainda estar dirigindo
norte?

set.seed(0)
tibble(sim = 1:5) %>%
mutate(res = map(sim, ~ simulate_one_drive(1/3, 1/3, 1/3, n_steps = 10)),
res = map(res, simulation_results_to_cartesian_positions)) %>%
unnest(res) %>%
plot_simulation()

set.seed(0)
simulation_results %
mutate(res = map(sim, ~ simulate_one_drive(1/3, 1/3, 1/3, n_steps = 10))) %>%
unnest(res) %>%
filter(i == 10) %>%
mutate(reduced_direction = reduce_angle(direction))
prob_north <- sum(simulation_results$reduced_direction == 0.5) / N_sims

A probabilidade de ainda estar voltado para o norte depois de virar à esquerda aleatoriamente,
à direita ou continuar em linha reta em cada interseção é de 0,205.

var vglnk = {key: '949efb41171ac6ec1bf7f206d57e90b8'}; (função (d, t) {var s = d.createElement

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 informação / dados.


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