在 R 中的网格中模拟二维随机游走并使用 ggplot 绘图

Posted 2023-02-16

【中文标题】在 R 中的网格中模拟二维随机游走并使用 ggplot 绘图

【英文标题】：Simulate a two-dimensional random walk in a grid in R and plot with ggplot

【发布时间】：2021-07-29 02:32:41

【问题描述】：

我正在寻找一个简单的代码，它可以模拟网格中的二维随机游走（使用R），然后使用ggplot 绘制数据。

特别是，我对从 2D 网格中的几个位置（5 个点）到方形网格中心的随机游走很感兴趣。它仅用于可视化目的。

然后我的想法是用ggplot 在离散网格上绘制结果（作为模拟的），可能使用函数geom_tile。

您对我可以轻松操作的预先存在的代码有什么建议吗？

【问题讨论】：

你能澄清一下你想做什么吗？你能举个例子说明它的样子吗？

类似于econometricsbysimulation.com/2012/08/…，但在一个网格中。

为什么选择 geom_tile()？

【参考方案1】：

这是一个带有for 循环的小例子。从这里，您可以简单地调整 X_t 和 Y_t 的定义方式：

Xt = 0; Yt = 0
for (i in 2:1000)

  Xt[i] = Xt[i-1] + rnorm(1,0,1)
  Yt[i] = Yt[i-1] + rnorm(1,0,1)

df <- data.frame(x = Xt, y = Yt)
ggplot(df, aes(x=x, y=y)) + geom_path() + theme_classic() + coord_fixed(1)

【参考方案2】：

编辑----

在与 OP 聊天后，我修改了代码以包含步进概率。这可能导致步行更频繁地静止。在更高的维度中，您需要将prob 因子缩小以补偿更多选项。

最后，我的函数不考虑绝对距离，它只考虑网格上在所有维度上都在一定步长范围内的点。例如，假设在c(0,0) 位置，您可以使用此函数转到c(1,1)。但我想这与网格的连通性有关。

如果 OP 只想考虑距离当前位置 1（距离）以内的节点，则使用以下版本的move_step()

move_step <- function(cur_pos, grid, prob = 0.04, size = 1)
  opts <- grid %>%
    rowwise() %>%
    mutate(across(.fns = ~(.x-.env$cur_pos[[cur_column()]])^2,
                  .names = '.col_square_diff')) %>%
    filter(sqrt(sum(c_across(ends_with("_square_diff"))))<=.env$size) %>%
    select(-ends_with("_square_diff")) %>%
    left_join(y = mutate(cur_pos, current = TRUE), by = names(grid)) 
  new_pos <- opts %>%
    mutate(weight = case_when(current ~ 1-(prob*(n()-1)), #calculate chance to move, 
                              TRUE ~ prob),               #in higher dimensions, we may have more places to move
           weight = if_else(weight<0, 0, weight)) %>%    #thus depending on prob, we may always move.
    sample_n(size = 1, weight = weight) %>%
    select(-weight, -current)
  new_pos

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(ggplot2)
library(gganimate)

move_step <- function(cur_pos, grid, prob = 0.04, size = 1)
  opts <- grid %>%
    filter(across(.fns =  ~ between(.x, .env$cur_pos[[cur_column()]]-.env$size, .env$cur_pos[[cur_column()]]+.env$size))) %>%
    left_join(y = mutate(cur_pos, current = TRUE), by = names(grid)) 
  new_pos <- opts %>%
    mutate(weight = case_when(current ~ 1-(prob*(n()-1)), #calculate chance to move, 
                              TRUE ~ prob),               #in higher dimensions, we may have more places to move
           weight = if_else(weight<0, 0, weight)) %>%    #thus depending on prob, we may always move.
    sample_n(size = 1, weight = weight) %>%
    select(-weight, -current)
  new_pos


sim_walk <- function(cur_pos, grid, grid_prob = 0.04, steps = 50, size = 1)
  iterations <- cur_pos
  for(i in seq_len(steps))
    cur_pos <- move_step(cur_pos, grid, prob = grid_prob, size = size)
    iterations <- bind_rows(iterations, cur_pos)
  
  iterations$i <- 1:nrow(iterations)
  iterations


origin <- data.frame(x = 0, y =0)
small_grid <- expand.grid(x = -1:1, y = -1:1)
small_walk <- sim_walk(cur_pos = origin,
                       grid = small_grid)

ggplot(small_walk, aes(x, y)) +
  geom_path() +
  geom_point(color = "red") +
  transition_reveal(i) +
  labs(title = "Step frame_along") +
  coord_fixed()

large_grid <- expand.grid(x = -10:10, y = -10:10)
large_walk <- sim_walk(cur_pos = origin,
                       grid = large_grid,
                       steps = 100)

ggplot(large_walk, aes(x,y)) +
  geom_path() +
  geom_point(color = "red") +
  transition_reveal(i)  +
  labs(title = "Step frame_along") +
  xlim(c(-10,10)) + ylim(c(-10,10))+
  coord_fixed()

large_walk %>% 
  count(x, y) %>%
  right_join(y = expand.grid(x = -10:10, y = -10:10), by = c("x","y")) %>%
  mutate(n = if_else(is.na(n), 0L, n)) %>%
  ggplot(aes(x,y)) +
  geom_tile(aes(fill = n)) +
  coord_fixed()

multi_dim_walk <- sim_walk(cur_pos = data.frame(x = 0, y = 0, z = 0),
                           grid =  expand.grid(x = -20:20, y = -20:20, z = -20:20),
                           steps = 100, size = 2)

library(cowplot)
plot_grid(
  ggplot(multi_dim_walk, aes(x, y)) + geom_path(),
  ggplot(multi_dim_walk, aes(x, z)) + geom_path(),
  ggplot(multi_dim_walk, aes(y, z)) + geom_path())

^{由reprex package (v1.0.0) 于 2021-05-06 创建}

【讨论】：

这是非常令人印象深刻和有趣的。我在徘徊，您是否认为可能包含移动步骤概率..例如，在时间间隔 = 1 内，每一步发生的概率为 4%。这对您有意义吗？

也许可以，但我认为如果您可以在帖子中更具体地说明您对模拟的期望，那将会很有帮助。有什么限制，一步可以带你在网格中的任何地方（即步长不重要）。或者您是否希望每个网格位置根据时间或距当前位置的距离而具有不同的概率。这些细节可以彻底改变代码

我先在这里回复你的问题，然后我会更新我的帖子。约束条件是：步长 = 1，并且这种步移动以给定的概率 px 发生。步骤发生在离散的时间间隔上。每个网格位置都有相同的移动概率，但是假设我将步长设置为 1，那么对于每个离散时间点，假设发生（取决于 px），那么每个离散时间点将只有一个步长。是不是清楚一点？对不起，如果不是，我会再试一次。

与您当前讨论的内容无关，但我建议您使用+ coord_fixed(1) 将 ggplot 轴设置为相同的比例。多么出色的解决方案啊！

现在重新渲染reprex。

【参考方案3】：

这是一个基本 R 选项，使用 Reduce + replicate + plot 进行 2D 随机游走过程

set.seed(0)
plot(
  setNames(
    data.frame(replicate(
      2,
      Reduce(`+`, rnorm(99), init = 0, accumulate = TRUE)
    )),
    c("X", "Y")
  ),
  type = "o"
)