如何在 R 中为特定 id 添加随机观察答案

【问题标题】：How add random observations for a specific id in R如何在 R 中为特定 id 添加随机观察
【发布时间】：2021-11-08 13:20:33
【问题描述】：

我有这样的数据示例

a=structure(list(person_number = c(943927L, 943927L, 943927L, 943927L, 
943927L, 943927L, 916248L, 916248L, 943579L, 943579L, 943579L, 
943579L, 943579L, 943579L), position_code = c(801L, 801L, 801L, 
801L, 801L, 801L, 5000690L, 5000690L, 5000690L, 5000690L, 5000690L, 
5000690L, 5000690L, 5000690L), date = c(4L, 6L, 2L, 1L, 3L, 5L, 
6L, 7L, 5L, 4L, 3L, 7L, 2L, 1L), start_hour = c(9L, 9L, 9L, 9L, 
9L, 9L, 10L, 10L, 9L, 9L, 10L, 9L, 10L, 10L), end_hour = c(17L, 
17L, 17L, 17L, 17L, 17L, 18L, 18L, 17L, 17L, 18L, 17L, 18L, 18L
)), class = "data.frame", row.names = c(NA, -14L))

日期是星期几，person_number 是销售人员的 id，position_code 是位置，开始和小时是销售人员开始工作和结束的时间。所以我需要如果在数据集中有任何个人号码只有 2 个观察值，例如这个 person_number=916248

916248  5000690  6  10  18
916248  5000690  7  10  18

然后再向他添加一个观察（行），但在date column 中应该有与已经有的不同的任何一天。例如

916248  5000690  6  10  18
916248  5000690  7  10  18
916248  5000690  **1**  10  18

已经有 6 天和 7 天了。所以我需要另一个随机的日子，例如 1（星期一）

我该怎么做？谢谢。

【问题讨论】：

标签： r

【解决方案1】：

您可以创建一个名为additional_random_data 的新表，然后将行连接到原始表a：

library(tidyverse)

a <- structure(list(person_number = c(
  943927L, 943927L, 943927L, 943927L,
  943927L, 943927L, 916248L, 916248L, 943579L, 943579L, 943579L,
  943579L, 943579L, 943579L
), position_code = c(
  801L, 801L, 801L,
  801L, 801L, 801L, 5000690L, 5000690L, 5000690L, 5000690L, 5000690L,
  5000690L, 5000690L, 5000690L
), date = c(
  4L, 6L, 2L, 1L, 3L, 5L,
  6L, 7L, 5L, 4L, 3L, 7L, 2L, 1L
), start_hour = c(
  9L, 9L, 9L, 9L,
  9L, 9L, 10L, 10L, 9L, 9L, 10L, 9L, 10L, 10L
), end_hour = c(
  17L,
  17L, 17L, 17L, 17L, 17L, 18L, 18L, 17L, 17L, 18L, 17L, 18L, 18L
)), class = "data.frame", row.names = c(NA, -14L))
a
#>    person_number position_code date start_hour end_hour
#> 1         943927           801    4          9       17
#> 2         943927           801    6          9       17
#> 3         943927           801    2          9       17
#> 4         943927           801    1          9       17
#> 5         943927           801    3          9       17
#> 6         943927           801    5          9       17
#> 7         916248       5000690    6         10       18
#> 8         916248       5000690    7         10       18
#> 9         943579       5000690    5          9       17
#> 10        943579       5000690    4          9       17
#> 11        943579       5000690    3         10       18
#> 12        943579       5000690    7          9       17
#> 13        943579       5000690    2         10       18
#> 14        943579       5000690    1         10       18

set.seed(1337)

additional_random_data <-
  a %>%
  group_by(person_number) %>%
  filter(n() == 2) %>%
  nest() %>%
  transmute(
    date = data %>% map_dbl(~
      # the first random day which is not already used
      seq(7) %>%
      setdiff(.x$date) %>%
      sample() %>%
      first())
  )
additional_random_data
#> # A tibble: 1 x 2
#> # Groups:   person_number [1]
#>   person_number  date
#>           <int> <dbl>
#> 1        916248     2

result <- full_join(a, additional_random_data)
#> Joining, by = c("person_number", "date")
result
#>    person_number position_code date start_hour end_hour
#> 1         943927           801    4          9       17
#> 2         943927           801    6          9       17
#> 3         943927           801    2          9       17
#> 4         943927           801    1          9       17
#> 5         943927           801    3          9       17
#> 6         943927           801    5          9       17
#> 7         916248       5000690    6         10       18
#> 8         916248       5000690    7         10       18
#> 9         943579       5000690    5          9       17
#> 10        943579       5000690    4          9       17
#> 11        943579       5000690    3         10       18
#> 12        943579       5000690    7          9       17
#> 13        943579       5000690    2         10       18
#> 14        943579       5000690    1         10       18
#> 15        916248            NA    2         NA       NA

result %>% filter(person_number == 916248)
#>   person_number position_code date start_hour end_hour
#> 1        916248       5000690    6         10       18
#> 2        916248       5000690    7         10       18
#> 3        916248            NA    2         NA       NA

^{由reprex package 创建于 2021-11-08 (v2.0.1)}

【讨论】：