根据一年中的月份随机绘制该月的某一天

Question

我想根据一年中的月份生成每月的随机日期。我当前的代码是：

  df$new_day = case_when(
  df$new_month == 2 ~ (floor(runif(1, min=1, max=28))),
  df$new_month == 1 ~ floor(runif(1, min=1, max=31)),
  df$new_month == 3 ~ floor(runif(1, min=1, max=31)),
  df$new_month == 5 ~ floor(runif(1, min=1, max=31)),
  df$new_month == 7 ~ floor(runif(1, min=1, max=31)),
  df$new_month == 8 ~ floor(runif(1, min=1, max=31)),
  df$new_month == 10 ~ floor(runif(1, min=1, max=31)),
  df$new_month == 12 ~ floor(runif(1, min=1, max=31)),
  TRUE ~ floor(runif(1, min=1, max=30))
)

然而，我每个月的日子都是一样的。例如，2 月的所有日期均为 23。

我怎样才能真正随机化每个月内的日期？

Answer 1

您每次都明确调用 1 个随机数：runif(1, ...)。相反，使用runif(n(), ...). 请注意，它不会为每一行调用一次，而是为满足该条件的所有行运行一次。在下面的示例中，五月有三行，但runif被称为 asrunif(1,..)并且该单个数字应用于所有三行。

样本数据：

set.seed(42)
df <- data.frame(day = as.Date("2022-01-01") + sample(364, size=10)) %>%
  arrange(day) %>%
  mutate(month = as.POSIXlt(day)$mon + 1L)
df
#           day month
# 1  2022-02-19     2
# 2  2022-03-16     3
# 3  2022-05-03     5
# 4  2022-05-09     5
# 5  2022-05-27     5
# 6  2022-06-03     6
# 7  2022-08-17     8
# 8  2022-10-31    10
# 9  2022-11-18    11
# 10 2022-12-31    12

破碎的：

library(dplyr)
set.seed(42)
df %>%
  mutate(
    new_day = case_when(
      month == 2                ~ floor(runif(1, 1, 28)), 
      month %in% c(9, 4, 6, 11) ~ floor(runif(1, 1, 30)), 
      TRUE                      ~ floor(runif(1, 1, 31))
    )
  )
#           day month new_day
# 1  2022-02-19     2      25
# 2  2022-03-16     3       9
# 3  2022-05-03     5       9
# 4  2022-05-09     5       9
# 5  2022-05-27     5       9
# 6  2022-06-03     6      28
# 7  2022-08-17     8       9
# 8  2022-10-31    10       9
# 9  2022-11-18    11      28
# 10 2022-12-31    12       9

为了证明对满足每个条件的所有行都runif调用一次message，我将添加到每个条件。如果我们可以依赖runif(1,..)，那么我们应该会看到"30d"打印到控制台 7 次和"31d"两次，但我们没有。

set.seed(42)
df %>%
  mutate(
    new_day = case_when(
      month == 2                ~ { message("Feb: ", length(month)); floor(runif(1, 1, 28)); }, 
      month %in% c(9, 4, 6, 11) ~ { message("30d: ", length(month)); floor(runif(1, 1, 30)); }, 
      TRUE                      ~ { message("31d: ", length(month)); floor(runif(1, 1, 31)); }
    )
  )
# Feb: 10
# 30d: 10
# 31d: 10
#           day month new_day
# 1  2022-02-19     2      25
# 2  2022-03-16     3       9
# 3  2022-05-03     5       9
# 4  2022-05-09     5       9
# 5  2022-05-27     5       9
# 6  2022-06-03     6      28
# 7  2022-08-17     8       9
# 8  2022-10-31    10       9
# 9  2022-11-18    11      28
# 10 2022-12-31    12       9

这表明，当我们位于其中一个条件的 RHS“内部”时，它会调用框架的所有行。请注意，每次我们调用 时runif，它都会看到的所有值month（我们有 10 行df）。

相反，使用n()（每次调用中的行数）：

set.seed(42)
df %>%
  mutate(
    new_day = case_when(
      month == 2                ~ floor(runif(n(), 1, 28)), 
      month %in% c(9, 4, 6, 11) ~ floor(runif(n(), 1, 30)), 
      TRUE                      ~ floor(runif(n(), 1, 31))
    )
  )
#           day month new_day
# 1  2022-02-19     2      25
# 2  2022-03-16     3       5
# 3  2022-05-03     5      30
# 4  2022-05-09     5      29
# 5  2022-05-27     5       3
# 6  2022-06-03     6      28
# 7  2022-08-17     8      12
# 8  2022-10-31    10      28
# 9  2022-11-18    11      14
# 10 2022-12-31    12      26

这意味着我们在其中提取 30 个随机数case_when，每个条件 10 个。虽然这不是这里的问题（大量熵的提取可能很慢），但您可以通过预先提取随机数据然后相应地缩放来缓解这一问题。

set.seed(42)
df %>%
  mutate(
    rand = runif(n(), 0, 1),
    new_day = case_when(
      month == 2                ~ ceiling(rand*28), 
      month %in% c(9, 4, 6, 11) ~ ceiling(rand*30), 
      TRUE                      ~ ceiling(rand*31)
    )
  )
#           day month      rand new_day
# 1  2022-02-19     2 0.9148060      26
# 2  2022-03-16     3 0.9370754      30
# 3  2022-05-03     5 0.2861395       9
# 4  2022-05-09     5 0.8304476      26
# 5  2022-05-27     5 0.6417455      20
# 6  2022-06-03     6 0.5190959      16
# 7  2022-08-17     8 0.7365883      23
# 8  2022-10-31    10 0.1346666       5
# 9  2022-11-18    11 0.6569923      20
# 10 2022-12-31    12 0.7050648      22

floor（注意从到 的转变ceiling）。还有其他方法可以重构代码，但我认为这通常已经足够了。