在R中循环一组数字生成命令

Question

下面，我展示了一段代码，用于在R 中生成一组项目分数。然而，似乎有相当多的不必要的重复才能到达最终的data。

我想知道是否有更紧凑的方法可以在R 中实现相同的data？

set.seed(8649)     
N      = 10        
latent = rnorm(N)  

##### generate latent responses to items
item1 = latent + rnorm(N, mean=0, sd=0.2)  
item2 = latent + rnorm(N, mean=0, sd=0.3)
item3 = latent + rnorm(N, mean=0, sd=0.5)
item4 = latent + rnorm(N, mean=0, sd=1.0)
item5 = latent + rnorm(N, mean=0, sd=1.2)  

##### convert latent responses to ordered categories
item1 = findInterval(item1, vec=c(-Inf,-2.5,-1, 1,2.5,Inf)) 
item2 = findInterval(item2, vec=c(-Inf,-2.5,-1, 1,2.5,Inf))
item3 = findInterval(item3, vec=c(-Inf,-3,  -2, 2,3,  Inf))  
item4 = findInterval(item4, vec=c(-Inf,-3,  -2, 2,3,  Inf))
item5 = findInterval(item5, vec=c(-Inf,-3.5,-3,-1,0.5,Inf))

data = cbind(item1, item2, item3, item4, item5)

Answer 1

您可以使用mapply。例如。像这样：

mapply(findInterval, vec = v_arg,
       x = lapply(sig_arg, rnorm, mean = latent, n = N)) 
#R>       [,1] [,2] [,3] [,4] [,5]
#R>  [1,]    4    4    3    3    3
#R>  [2,]    3    3    3    4    5
#R>  [3,]    3    3    3    4    4
#R>  [4,]    4    4    3    3    5
#R>  [5,]    2    2    3    3    3
#R>  [6,]    3    3    3    3    5
#R>  [7,]    3    3    3    3    4
#R>  [8,]    1    1    2    3    3
#R>  [9,]    4    4    3    3    5
#R> [10,]    3    3    3    3    4

如果您想要列名，请使用例如：

mapply(findInterval,
       setNames(lapply(sig_arg, rnorm, mean = latent, n = N), 
                paste0("item", seq_along(sig_arg))), 
       v_arg)
#R>       item1 item2 item3 item4 item5
#R>  [1,]     4     4     3     3     3
#R>  [2,]     3     3     3     4     5
#R>  [3,]     3     3     3     4     4
#R>  [4,]     4     4     3     3     5
#R>  [5,]     2     2     3     3     3
#R>  [6,]     3     3     3     3     5
#R>  [7,]     3     3     3     3     4
#R>  [8,]     1     1     2     3     3
#R>  [9,]     4     4     3     3     5
#R> [10,]     3     3     3     3     4

你可以把它包装成一个函数，这样你就可以像这样改变N、标准差和断点：

sim_scores <- function(N, sigs, cuts)
  mapply(findInterval,
         setNames(lapply(sigs, rnorm, mean = rnorm(N), n = N), 
                  paste0("item", seq_along(cuts))), 
         cuts)

# use the function
sim_scores(10L, sig_arg, v_arg)
#R>       item1 item2 item3 item4 item5
#R>  [1,]     3     3     3     2     3
#R>  [2,]     3     3     3     3     5
#R>  [3,]     3     3     3     3     4
#R>  [4,]     5     4     4     4     5
#R>  [5,]     3     3     3     3     3
#R>  [6,]     3     3     3     3     5
#R>  [7,]     3     4     3     3     5
#R>  [8,]     2     2     3     3     3
#R>  [9,]     3     3     3     3     4
#R> [10,]     2     2     3     3     2

sim_scores(4L, sig_arg[1:2], v_arg[1:2])
#R>      item1 item2
#R> [1,]     2     2
#R> [2,]     3     3
#R> [3,]     2     3
#R> [4,]     3     3

数据

sig_arg <- c(.2, .3, .5, 1, 1.5)
v_arg <- list(c(-Inf,-2.5,-1, 1,2.5,Inf), 
              c(-Inf,-2.5,-1, 1,2.5,Inf), 
              c(-Inf,-3,  -2, 2,3,  Inf), 
              c(-Inf,-3,  -2, 2,3,  Inf), 
              c(-Inf,-3.5,-3,-1,0.5,Inf))

Answer 2

我们可以在list 中创建第一组“item”，变量部分为“sd”

# // loop over the sd vector and create the list of random numbers in a list
lst1 <- lapply(c(0.2, 0.3, 0.5, 1, 1.2), function(x) 
           latent + rnorm(N, mean = 0, sd = x))
# // set the names of the list if needed
names(lst1) <- paste0("item", seq_along(lst1))

使用Map 将'lst1' 和vec 的相应元素作为list ('veclst') 循环并应用findInterval

data.frame(Map(findInterval, lst1, vec = veclst))
#   item1 item2 item3 item4 item5
#1      4     4     3     3     5
#2      3     3     3     3     5
#3      3     3     3     3     5
#4      4     4     4     3     5
#5      2     2     3     2     4
#6      3     3     3     3     3
#7      3     3     3     3     4
#8      2     2     2     2     2
#9      4     4     5     4     5
#10     3     3     3     3     4

---

或者用tidyverse做同样的事情

library(purrr)
library(dplyr)
library(stringr)
map2_dfc(c(0.2, 0.3, 0.5, 1, 1.2), veclst, ~ 
          findInterval(latent + rnorm(N, mean = 0, sd = .x), vec = .y)) %>%
  set_names(str_c('item', seq_along(.)))

-输出

# A tibble: 10 x 5
#  item1 item2 item3 item4 item5
#   <int> <int> <int> <int> <int>
# 1     4     4     3     4     4
# 2     3     3     3     3     5
# 3     3     3     3     3     4
# 4     3     4     3     3     5
# 5     2     2     3     3     4
# 6     3     3     3     3     5
# 7     3     3     3     3     4
# 8     2     2     2     1     2
# 9     4     4     4     5     5
#10     3     3     3     3     4

更新

如果我们正在创建一个函数，请确保 latent 是基于函数内传递的新“N”创建的，因为它可能导致长度不同。在 OP' 帖子中显示的原始代码中，length 是 10，latent 是基于此创建的

make_likert <- function(N.judge = 10, item.sds, cut_points, seed = NULL){
   set.seed(seed)
   latent <- rnorm(N.judge)
   lst1 <- lapply(item.sds, function(x) latent + rnorm(n = N.judge, sd = x))
      names(lst1) <- paste0("item", seq_along(lst1))
      data.frame(Map(findInterval, lst1, cut_points))
     }
      
make_likert(N.judge=13, item.sds = item.sds, cut_points = cut_points)
#     item1 item2 item3 item4 item5 item6 item7 item8 item9 item10
#1      4     3     2     3     1     3     3     5     4      4
#2      5     3     3     3     5     3     3     5     5      5
#3      2     2     3     3     3     3     3     4     3      5
#4      3     5     3     3     3     3     4     5     4      3
#5      3     1     4     3     4     3     1     2     4      4
#6      2     1     3     3     1     3     3     5     5      4
#7      3     2     3     3     3     3     5     1     5      3
#8      3     1     2     3     5     3     3     5     3      5
#9      4     3     2     3     3     4     3     1     5      5
#10     3     2     3     3     1     3     4     3     3      2
#11     4     5     1     3     5     3     1     3     5      5
#12     3     5     3     3     3     3     5     3     5      5
#13     3     4     5     3     3     3     1     1     5      3

数据

veclst <- rep(list(c(-Inf,-2.5,-1, 1,2.5,Inf), 
                   c(-Inf,-3,  -2, 2,3,  Inf),
                   c(-Inf,-3.5,-3,-1,0.5,Inf)), 
           c(2, 2, 1))