使用 R 中的 apply 函数重写赋值序列

Question

我试图模拟一系列按品种测量马的身高和体重的序列，从英国现有的马品种列表中采样数据。我最终使用了由大量复制粘贴组成的很长的代码，我认为必须有一种更有效的方法来做到这一点，但我尝试使用

apply

函数，但没有成功。

MWE如下

library(tidyverse)

horses_meas <- tribble(
    ~breed, ~mean_h, ~sd_h, ~mean_w, ~sd_w,
    "Hannover", 1.69, 0.10, 600, 25,
    "Arabian", 1.50, 0.05, 400, 45,
    "Holsteiner", 1.68, 0.05, 575, 125
)

# Simulation by breed
type_1 <- bind_cols(breed = rep(horses_meas$breed[1], 20), 
                    weight = rnorm(20, horses_meas$mean_w[1], horses_meas$sd_w[1]),
                    height = rnorm(20, horses_meas$mean_h[1], horses_meas$sd_h[1]))
type_2 <- bind_cols(breed = rep(horses_meas$breed[2], 20), 
                    weight = rnorm(20, horses_meas$mean_w[2], horses_meas$sd_w[2]),
                    height = rnorm(20, horses_meas$mean_h[2], horses_meas$sd_h[2]))
type_3 <- bind_cols(breed = rep(horses_meas$breed[3], 20), 
                    weight = rnorm(20, horses_meas$mean_w[3], horses_meas$sd_w[3]),
                    height = rnorm(20, horses_meas$mean_h[3], horses_meas$sd_h[3]))

horses <- bind_rows(type_1, type_2, type_3)

print(horses)

您能帮我将其转换为更有效的代码吗？我希望能够选择不同数量的马（MWE 中的马只是随机抽样的结果，但理想情况下这个数字可能会有所不同），并且我不希望每次都剪切并粘贴所有马匹

type_i

作业。

我认为分配一个临时变量

x <- NULL

，然后创建一个列表

x['breed']

来填充

for

之类的东西可能会有所帮助，但我想使用

apply

函数或使用

tidyverse

来完成此操作相反。

感谢您给我的任何帮助。

Answer 1

一种

tidyverse

方法是使用

purrr::pmap

循环遍历

horses_meas

的行，如下所示：

library(purrr)
library(dplyr)

set.seed(123)

purrr::pmap(horses_meas,
  function(breed, mean_w, sd_w, mean_h, sd_h, n) {
    data.frame(
      breed = breed,
      weight = rnorm(n, mean_w, sd_w),
      height = rnorm(n, mean_h, sd_h)
    )
  },
  n = 5
) |>
  bind_rows()
#>         breed   weight   height
#> 1    Hannover 585.9881 1.861506
#> 2    Hannover 594.2456 1.736092
#> 3    Hannover 638.9677 1.563494
#> 4    Hannover 601.7627 1.621315
#> 5    Hannover 603.2322 1.645434
#> 6     Arabian 455.0837 1.589346
#> 7     Arabian 416.1916 1.524893
#> 8     Arabian 418.0347 1.401669
#> 9     Arabian 404.9807 1.535068
#> 10    Arabian 374.9871 1.476360
#> 11 Holsteiner 441.5220 1.595665
#> 12 Holsteiner 547.7531 1.721889
#> 13 Holsteiner 446.7494 1.687669
#> 14 Holsteiner 483.8886 1.623093
#> 15 Holsteiner 496.8701 1.742691

Answer 2

我会一次性把所有事情都画出来。

library(tidyverse)

horses_meas <- tribble(
    ~breed, ~mean_h, ~sd_h, ~mean_w, ~sd_w,
    "Hannover", 1.69, 0.10, 600, 25,
    "Arabian", 1.50, 0.05, 400, 45,
    "Holsteiner", 1.68, 0.05, 575, 125
)


map_dfr(
  1:nrow(horses_meas),
  ~with(
      horses_meas,
      tibble(
        breed = rep(breed[.x], 20),
        weight = rnorm(20, mean_w[.x], sd_w[.x]),
        height = rnorm(20, mean_h[.x], sd_h[.x])
      )
    )
)
#> # A tibble: 60 x 3
#>    breed    weight height
#>    <chr>     <dbl>  <dbl>
#>  1 Hannover   611.   1.73
#>  2 Hannover   641.   1.61
#>  3 Hannover   575.   1.52
#>  4 Hannover   624.   1.68
#>  5 Hannover   610.   1.80
#>  6 Hannover   552.   1.72
#>  7 Hannover   606.   1.63
#>  8 Hannover   601.   1.86
#>  9 Hannover   591.   1.61
#> 10 Hannover   593.   1.80
#> # i 50 more rows