在 ggplot2 上用 R 中的多个代码替换进行迭代

Question

我对在 R 中使用具有多个代码替换的迭代来创建多个 ggplot2 派生对象很感兴趣，但我无法弄清楚。请帮忙。

我使用下面的代码创建了 2 个数据集，diamonds_top300 和 diamonds_bottom300。

diamonds_top300 <- data.frame(dplyr::top_n(diamonds, 300, table))
diamonds_bottom300 <- data.frame(dplyr::bottom_n(diamonds, -300, table))

我想使用 2x2 设计创建 4 个直方图 [2（数据 = diamonds_top300 或 diamonds_bottom300）乘以 2（DV = 价格或克拉）设计，总共 4 个直方图] .

我可以使用下面的代码手动完成，并在适当的地方进行替换：

# manual histogram input
# ---- NOTE: 2 (data = diamonds_top300 or diamonds_bottom300) by 2 (DV = price or carat) design, for a total of 4 histograms

## Model 1: DV - price, data = diamonds_top300
(ggplot2::ggplot(diamonds_top300, aes(y=price))
  + ggplot2::geom_histogram(
    aes(y=..density..), 
    alpha=0.5, 
    position="identity", 
    binwidth = as.numeric(
      nclass.Sturges(diamonds_top300$price))
  )
  + geom_density(alpha=.2)
)

## Model 2: DV - price, data = diamonds_bottom300
(ggplot2::ggplot(diamonds_bottom300, aes(y=price))
  + ggplot2::geom_histogram(
    aes(y=..density..), 
    alpha=0.5, 
    position="identity", 
    binwidth = as.numeric(
      nclass.Sturges(diamonds_bottom300$price))
  )
  + geom_density(alpha=.2)
)

## Model 3: DV - y, data = diamonds_top300
(ggplot2::ggplot(diamonds_top300, aes(y=y))
  + ggplot2::geom_histogram(
    aes(y=..density..), 
    alpha=0.5, 
    position="identity", 
    binwidth = as.numeric(
      nclass.Sturges(diamonds_top300$y))
  )
  + geom_density(alpha=.2)
)

## Model 4: DV - y, data = diamonds_bottom300
(ggplot2::ggplot(diamonds_bottom300, aes(y=y))
  + ggplot2::geom_histogram(
    aes(y=..density..), 
    alpha=0.5, 
    position="identity", 
    binwidth = as.numeric(
      nclass.Sturges(diamonds_bottom300$y))
  )
  + geom_density(alpha=.2)
)

当我尝试使用函数和 mapply 来迭代此任务并减少代码长度时，它不起作用。这是代码

# using mapply
# ---- NOTE: desired order: Model 1: DV - DVS_OF_INTEREST_list_model, data = diamonds_top300; ## Model 2: DV - DVS_OF_INTEREST_list_model, data = diamonds_bottom300; ## Model 3: DV - y, data = diamonds_top300; ## Model 4: DV - y, data = diamonds_bottom300

## creates function
function_histogram_diamonds_sub_dataset_and_DV_vary <- 
  function(DVS_OF_INTEREST_list_model, DATASET_list_model)
  {
    (ggplot2::ggplot(DATASET_list_model, aes(y=DVS_OF_INTEREST_list_model))
     + ggplot2::geom_histogram(
       aes(y=..density..), 
       alpha=0.5, 
       position="identity", 
       binwidth = as.numeric(
         nclass.Sturges(DATASET_list_model$DVS_OF_INTEREST_list_model))
     )
     + geom_density(alpha=.2)
    )
  }

## runs function with desired lists
mapply(function_histogram_diamonds_sub_dataset_and_DV_vary, DVS_OF_INTEREST_list, DATASET_list, SIMPLIFY = FALSE)

这是我得到的错误：

> mapply(function_histogram_diamonds_sub_dataset_and_DV_vary, DVS_OF_INTEREST_list, DATASET_list, SIMPLIFY = FALSE)
 Error: `data` must be a data frame, or other object coercible by `fortify()`, not a character vector
Run `rlang::last_error()` to see where the error occurred.

有什么方法可以成功吗？任何帮助将不胜感激。

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

谢谢。

这是我用于模型的代码


#### histograms ####




# 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::bottom_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)




# lists all variables/objects of interest
DVS_OF_INTEREST_list <- c("price", "carat")
DATASET_list <- c("diamonds_top300", "diamonds_bottom300")




# manual histogram input
# ---- NOTE: 2 (data = diamonds_top300 or diamonds_bottom300) by 2 (DV = price or carat) design, for a total of 4 histograms

## Model 1: DV - price, data = diamonds_top300
(ggplot2::ggplot(diamonds_top300, aes(y=price))
  + ggplot2::geom_histogram(
    aes(y=..density..), 
    alpha=0.5, 
    position="identity", 
    binwidth = as.numeric(
      nclass.Sturges(diamonds_top300$price))
  )
  + geom_density(alpha=.2)
)

## Model 2: DV - price, data = diamonds_bottom300
(ggplot2::ggplot(diamonds_bottom300, aes(y=price))
  + ggplot2::geom_histogram(
    aes(y=..density..), 
    alpha=0.5, 
    position="identity", 
    binwidth = as.numeric(
      nclass.Sturges(diamonds_bottom300$price))
  )
  + geom_density(alpha=.2)
)

## Model 3: DV - y, data = diamonds_top300
(ggplot2::ggplot(diamonds_top300, aes(y=y))
  + ggplot2::geom_histogram(
    aes(y=..density..), 
    alpha=0.5, 
    position="identity", 
    binwidth = as.numeric(
      nclass.Sturges(diamonds_top300$y))
  )
  + geom_density(alpha=.2)
)

## Model 4: DV - y, data = diamonds_bottom300
(ggplot2::ggplot(diamonds_bottom300, aes(y=y))
  + ggplot2::geom_histogram(
    aes(y=..density..), 
    alpha=0.5, 
    position="identity", 
    binwidth = as.numeric(
      nclass.Sturges(diamonds_bottom300$y))
  )
  + geom_density(alpha=.2)
)



# using mapply
# ---- NOTE: desired order: Model 1: DV - DVS_OF_INTEREST_list_model, data = diamonds_top300; ## Model 2: DV - DVS_OF_INTEREST_list_model, data = diamonds_bottom300; ## Model 3: DV - y, data = diamonds_top300; ## Model 4: DV - y, data = diamonds_bottom300

## creates function
function_histogram_diamonds_sub_dataset_and_DV_vary <- 
  function(DVS_OF_INTEREST_list_model, DATASET_list_model)
  {
    (ggplot2::ggplot(DATASET_list_model, aes(y=DVS_OF_INTEREST_list_model))
     + ggplot2::geom_histogram(
       aes(y=..density..), 
       alpha=0.5, 
       position="identity", 
       binwidth = as.numeric(
         nclass.Sturges(DATASET_list_model$DVS_OF_INTEREST_list_model))
     )
     + geom_density(alpha=.2)
    )
  }

## runs function with desired lists
mapply(function_histogram_diamonds_sub_dataset_and_DV_vary, DVS_OF_INTEREST_list, DATASET_list, SIMPLIFY = FALSE)

Answer 1

这样的事情怎么样：

function_histogram_diamonds_sub_dataset_and_DV_vary <- 
  function(DVS_OF_INTEREST_list_model, DATASET_list_model)
  {require(ggplot2)
    ggplot(DATASET_list_model, aes_string(x=DVS_OF_INTEREST_list_model))+ 
       geom_histogram(
         aes(y=..density..), 
         alpha=0.5, 
         position="identity", 
         binwidth=nclass.Sturges)+ 
      geom_density(alpha=.2)
    
  }

hists <- purrr::map2(list("price", "price", "y", "y"), 
     list(diamonds_top300, diamonds_bottom300, diamonds_top300, diamonds_bottom300), 
     ~function_histogram_diamonds_sub_dataset_and_DV_vary(.x, .y))

do.call(cowplot::plot_grid, hists)

函数必须稍微清理一下。如果您尝试传入变量的字符串名称，则需要使用 aes_string()。您还需要在美学中将感兴趣的变量定义为 x。我不确定 Sturges 的休息是否在这里起到了作用，但这很容易在代码中更改。

在 ggplot2 上用 R 中的多个代码替换进行迭代

Do iteration with multiple substitutions of code in R on ggplot2

iteration

r

ggplot2