首页 > 解决方案 > 是否可以在 r 中使用带有多个列表对象输入的 lapply() (或其他命令)?

问题描述

我想lapply()与多个列表输入一起使用。

具体来说,我想对lm()不同的 IV、DV 和数据集进行测试。

我创建了 2 个数据集,称为diamonds_top300diamonds_bottom300,从ggplot2::diamonds数据集派生。我想lm()在这些数据集上运行测试,其中 IV 为xor y,DV 为priceor carat

使用下面的代码,我可以做到这一点:

## long way
# ---- NOTE: works

### DV is price, IV is x, and dataset is diamonds_top300
lm__dataset_is_diamonds_top300__DV_is_price__IV_is_x <-
  lm(price ~ x, data = diamonds_top300)

### DV is price, IV is y, and dataset is diamonds_top300
lm__dataset_is_diamonds_top300__DV_is_price__IV_is_y <-
  lm(price ~ y, data = diamonds_top300)

### DV is carat, IV is x, and dataset is diamonds_top300
lm__dataset_is_diamonds_top300__DV_is_carat__IV_is_x <-
  lm(carat ~ x, data = diamonds_top300)

### DV is carat, IV is y, and dataset is diamonds_top300
lm__dataset_is_diamonds_top300__DV_is_carat__IV_is_y <-
  lm(carat ~ y, data = diamonds_top300)

### DV is price, IV is x, and dataset is diamonds_bottom300
lm__dataset_is_diamonds_bottom300__DV_is_price__IV_is_x <-
  lm(price ~ x, data = diamonds_bottom300)

### DV is price, IV is y, and dataset is diamonds_bottom300
lm__dataset_is_diamonds_bottom300__DV_is_price__IV_is_y <-
  lm(price ~ y, data = diamonds_bottom300)

### DV is carat, IV is x, and dataset is diamonds_bottom300
lm__dataset_is_diamonds_bottom300__DV_is_carat__IV_is_x <-
  lm(carat ~ x, data = diamonds_bottom300)

### DV is carat, IV is y, and dataset is diamonds_bottom300
lm__dataset_is_diamonds_bottom300__DV_is_carat__IV_is_y <-
  lm(carat ~ y, data = diamonds_bottom300)

当我尝试使用lapply()下面的代码以简短的方式执行此操作时,但这不起作用。我想使用 3 个列表输入来做到这一点(即,一个用于使用的数据集,一个用于使用的 DV,一个用于使用的 IV)。

## short way, using lapply()
# ---- NOTE: does not work

### creates list object
lm__dataset_is_XXXX__DV_is_XXXX__IV_is_XXXX <- 
  lapply(
    # ---- NOTE: tells dataset used in analysis
    DV_info$dataset_analyses,
    # ---- NOTE: tells DV used in analysis
    DV_info$DV_original,
    # ---- NOTE: tells IV used in analysis
    IV_info$IV_original,
    function(
      # ---- NOTE: name of function object input for dataset used in lapply() object
      dataset_list,
      # ---- NOTE: name of function object input for DV used in lapply() object
      DV_list,
      # ---- NOTE: name of function object input for IV used in lapply() object
      IV_list
             ) {
      # ---- NOTE: creates _funct_object versions of function() inputs
      IV_funct_object <- 
        IV_list
      DV_funct_object <- 
        DV_list
      dataset_funct_object <- 
        dataset_list
      # ---- NOTE: creates 
      lm_funct_object <- 
        lm(DV_funct_object ~ IV_funct_object, data = dataset_funct_object)
      # ---- NOTE: returns object
      return(lm_funct_object)
    }
  )

### changes list object name
lm__dataset_is_XXXX__DV_is_XXXX__IV_is_XXXX <- 
  setNames(
    lm__dataset_is_XXXX__DV_is_XXXX__IV_is_XXXX, 
    paste(
      "list_derived_object_",
      "lm",
      "_dataset_is",
      DV_info$dataset_analyses,
      "_DV_is",
      DV_info$DV_original,
      "_IV_is",
      IV_info$IV_original,
      sep = "_"
           )
  )

如果可能的话,我想使用 来执行此操作lapply(),因为我可以修改与 相关的代码lapply(),但我对其他选项持开放态度(例如,使用 mapply() 和预先制作的用户生成函数)。

非常感谢任何建议。

仅供参考,我使用的是 2013 Macbook Pro,配备 2.4 GHz 双核英特尔芯片、8 GB 内存、macOS big sur 11.2.2、RStudio 版本 1.4.1106 和 R 基础包 4.04。

谢谢。



我使用的 R 脚本如下:

#### lapply() with multiple objects ####




# Loads packages
# ---- NOTE: making plots and diamonds dataset
if(!require(ggplot2)){install.packages("ggplot2")}
# ---- NOTE: for data wrangling
if(!require(dplyr)){install.packages("dplyr")}




# dataset creation

## for dataset with top 300 rows
# ---- NOTE: selects only the top 300 rows of the dataset
diamonds_top300 <- data.frame(dplyr::top_n(diamonds, 300, table))
# ---- NOTE: gives dataset info
head(diamonds_top300)
str(diamonds_top300)
colnames(diamonds_top300)
nrow(diamonds_top300)
# ---- NOTE: gives unique values of Fixed and Random effects, and dvs
unique(diamonds_top300$price)
unique(diamonds_top300$y)
unique(diamonds_top300$cut)
unique(diamonds_top300$color)
unique(diamonds_top300$carat)
unique(diamonds_top300$clarity)
unique(diamonds_top300$depth)
unique(diamonds_top300$table)

## for dataset with bottom 300 rows
### dataset
# ---- NOTE: selects only the bottom 300 rows of the dataset
diamonds_bottom300 <- data.frame(dplyr::top_n(diamonds, -300, table))
# ---- NOTE: gives dataset info
head(diamonds_bottom300)
str(diamonds_bottom300)
colnames(diamonds_bottom300)
nrow(diamonds_bottom300)
# ---- NOTE: gives unique values of Fixed and Random effects, and dvs
unique(diamonds_bottom300$price)
unique(diamonds_bottom300$y)
unique(diamonds_bottom300$cut)
unique(diamonds_bottom300$color)
unique(diamonds_bottom300$carat)
unique(diamonds_bottom300$clarity)
unique(diamonds_bottom300$depth)
unique(diamonds_bottom300$table)

## creates DV_info object
# ---- NOTE: length of data needs to match up with the maximum number of tests being done (i.e., 8 tests total means this list based data frame needs to be 8 rows in length)
DV_info <- 
  data.frame(
    DV_original = c("price", "carat", "price", "carat", "price", "carat", "price", "carat"),
    dataset_analyses = c("diamonds_top300", "diamonds_top300", "diamonds_top300", "diamonds_top300", "diamonds_bottom300", "diamonds_bottom300", "diamonds_bottom300")
  )

## creates IV_info object
# ---- NOTE: length of data needs to match up with the maximum number of tests being done (i.e., 8 tests total means this list based data frame needs to be 8 rows in length)
IV_info <- 
  data.frame(
    IV_original = c("x", "y", "x", "y", "x", "y", "x", "y")
  )




# creating lm() objects

## long way
# ---- NOTE: works

### DV is price, IV is x, and dataset is diamonds_top300
lm__dataset_is_diamonds_top300__DV_is_price__IV_is_x <-
  lm(price ~ x, data = diamonds_top300)

### DV is price, IV is y, and dataset is diamonds_top300
lm__dataset_is_diamonds_top300__DV_is_price__IV_is_y <-
  lm(price ~ y, data = diamonds_top300)

### DV is carat, IV is x, and dataset is diamonds_top300
lm__dataset_is_diamonds_top300__DV_is_carat__IV_is_x <-
  lm(carat ~ x, data = diamonds_top300)

### DV is carat, IV is y, and dataset is diamonds_top300
lm__dataset_is_diamonds_top300__DV_is_carat__IV_is_y <-
  lm(carat ~ y, data = diamonds_top300)

### DV is price, IV is x, and dataset is diamonds_bottom300
lm__dataset_is_diamonds_bottom300__DV_is_price__IV_is_x <-
  lm(price ~ x, data = diamonds_bottom300)

### DV is price, IV is y, and dataset is diamonds_bottom300
lm__dataset_is_diamonds_bottom300__DV_is_price__IV_is_y <-
  lm(price ~ y, data = diamonds_bottom300)

### DV is carat, IV is x, and dataset is diamonds_bottom300
lm__dataset_is_diamonds_bottom300__DV_is_carat__IV_is_x <-
  lm(carat ~ x, data = diamonds_bottom300)

### DV is carat, IV is y, and dataset is diamonds_bottom300
lm__dataset_is_diamonds_bottom300__DV_is_carat__IV_is_y <-
  lm(carat ~ y, data = diamonds_bottom300)

### lists created file(s)
# ---- NOTE: list of object, out right
lm__dataset_is_diamonds_top300__DV_is_price__IV_is_x
lm__dataset_is_diamonds_top300__DV_is_price__IV_is_y
lm__dataset_is_diamonds_top300__DV_is_carat__IV_is_x
lm__dataset_is_diamonds_top300__DV_is_carat__IV_is_y
lm__dataset_is_diamonds_bottom300__DV_is_price__IV_is_x
lm__dataset_is_diamonds_bottom300__DV_is_price__IV_is_y
lm__dataset_is_diamonds_bottom300__DV_is_carat__IV_is_x
lm__dataset_is_diamonds_bottom300__DV_is_carat__IV_is_y
# ---- NOTE: apropos() command list
apropos("lm__dataset_is_")

## short way, using lapply()
# ---- NOTE: does not work

### creates list object
lm__dataset_is_XXXX__DV_is_XXXX__IV_is_XXXX <- 
  lapply(
    # ---- NOTE: tells dataset used in analysis
    DV_info$dataset_analyses,
    # ---- NOTE: tells DV used in analysis
    DV_info$DV_original,
    # ---- NOTE: tells IV used in analysis
    IV_info$IV_original,
    function(
      # ---- NOTE: name of function object input for dataset used in lapply() object
      dataset_list,
      # ---- NOTE: name of function object input for DV used in lapply() object
      DV_list,
      # ---- NOTE: name of function object input for IV used in lapply() object
      IV_list
             ) {
      # ---- NOTE: creates _funct_object versions of function() inputs
      IV_funct_object <- 
        IV_list
      DV_funct_object <- 
        DV_list
      dataset_funct_object <- 
        dataset_list
      # ---- NOTE: creates 
      lm_funct_object <- 
        lm(DV_funct_object ~ IV_funct_object, data = dataset_funct_object)
      # ---- NOTE: returns object
      return(lm_funct_object)
    }
  )

### changes list object name
lm__dataset_is_XXXX__DV_is_XXXX__IV_is_XXXX <- 
  setNames(
    lm__dataset_is_XXXX__DV_is_XXXX__IV_is_XXXX, 
    paste(
      "list_derived_object_",
      "lm",
      "_dataset_is",
      DV_info$dataset_analyses,
      "_DV_is",
      DV_info$DV_original,
      "_IV_is",
      IV_info$IV_original,
      sep = "_"
           )
  )

标签: riterationlapply

解决方案


你可以利用Map-

Map(function(x, y, z) lm(reformulate(x, y), data = z),
  IV_info$IV_original, DV_info$DV_original, mget(DV_info$dataset_analyses))

推荐阅读