DaveM DaveM - 2 months ago 18
R Question

Saving ggplot2 output in R to pdf file when using dplyr and mapply function

I'm still learning R (clearly), and cannot figure out where my problem might be when trying to save ggplot2 output into a pdf file. I have been able to create code using a loop to save ggplot output, but want to force myself to avoid loops and take advantage of R's ability to do so.

I have looked at other posts regarding saving pdf files, but none seemed to address my issue.

Here is a reproducible example:

# Create example data frame for reproducible example
amount <- c(rep(5, 25), rep(10, 50), rep(15, 25))
value <- c(rep(100, 20), rep(200, 30), rep(300, 50))
fund <- I(c(rep("FundA", 50), rep("FundB", 50)))

example_df <- data.frame(amount, value, fund)
#==============================================================
# Weighted histogram function for plotting

histogram_wt_fx <- function(my_df, xvar, my_weight,
chart_title = "title",
chart_xlabel = "x",
chart_ylabel = "y") {
library(ggplot2)

histogram <- ggplot(my_df, aes(x = xvar, weight = my_weight)) +
geom_histogram(binwidth=0.25, colour="black", fill="white")

# add another layer showing weighted avg amount
histogram <- histogram + geom_vline(aes(xintercept = sum (xvar*my_weight)),
color="red", linetype="dashed", size=1) +
labs(title = chart_title , x = chart_xlabel, y = chart_ylabel)
}

#===============================================================
# Function to weight data and plot histogram
# Note: fund_wtd_fx in turn calls histogram_wt_fx

fund_wtd_fx <- function(my_df, my_title) {
my_df <- my_df %>%
mutate(pct_amount = amount/sum(amount))

my_df %>%
histogram_wt_fx (xvar = my_df$value,
my_weight = my_df$pct_amount,
chart_title = my_title,
chart_xlabel = "Amount",
chart_ylabel = "Percent") %>%
plot() #%>%
#*** This is where the problem code is ****
#pdf() %>%
#plot()

}
#=====================================
# Extract fund lists from larger data set and run the functions on this list

fund_names <- unique(example_df$fund) # List of funds in the data frame
fund_dfs <- list() # Initialize list of data frames

# Create list of fund data frames
for (myfund in fund_names) {
myfund <- example_df %>%
filter(fund == myfund)
fund_dfs[[length(fund_dfs)+1]] <- myfund
}
rm(myfund)
names(fund_dfs) <- fund_names

# Assign list of fund names to the list of data frames
for (i in 1:length(fund_names)) {
assign(fund_names[[i]], fund_dfs[[i]])
}

# Run histogram function on each fund
my_title <- as.list(paste0("Some title for ", (names(fund_dfs))))
mapply(FUN = fund_wtd_fx, fund_dfs, my_title)
#dev.off()


My problem:
This code runs like I want it to, but if you uncomment lines 39, 41, 42, and 68 (assuming you pasted the code starting in line 1), then the plots do not get saved and a plot.window error is thrown.

I would have thought that pipe operator on uncommented line 39, would feed into the pdf function to save the plot output as the mapply function cycles through the data frames. Ultimately that is what I am trying to do--save the plots generated into a pdf file with this code.

Many thanks for any help or suggestions.

Answer

histogram_wt_fx() now returns the plot object to fund_wtd_fx() which now also returns the plot object.

Switched to purrr::map2() from mapply and did the plotting at the end.

Take a look, give it a go and let me know if I can/should explain a bit more.

library(dplyr)
library(ggplot2)
library(purrr)

amount <- c(rep(5, 25), rep(10, 50), rep(15, 25))
value  <- c(rep(100, 20), rep(200, 30), rep(300, 50))
fund   <- I(c(rep("FundA", 50), rep("FundB", 50)))            

example_df  <- data.frame(amount, value, fund)

histogram_wt_fx <- function(my_df, xvar, my_weight,
                            chart_title  = "title", 
                            chart_xlabel = "x", 
                            chart_ylabel = "y") {

  histogram <- ggplot(my_df, aes(x = xvar, weight = my_weight)) + 
    geom_histogram(binwidth=0.25, colour="black", fill="white")

  histogram <- histogram + geom_vline(aes(xintercept = sum (xvar*my_weight)), 
                                      color="red", linetype="dashed", size=1) +
    labs(title = chart_title , x = chart_xlabel, y = chart_ylabel)

  histogram

}

fund_wtd_fx <- function(my_df, my_title) {

  my_df <- my_df %>%
    mutate(pct_amount = amount/sum(amount)) 

  my_df %>%
    histogram_wt_fx(xvar         = my_df$value,
                    my_weight    = my_df$pct_amount,
                    chart_title  = my_title,
                    chart_xlabel = "Amount", 
                    chart_ylabel = "Percent")  

}

fund_names <- unique(example_df$fund)     # List of funds in the data frame 
fund_dfs <- list()                        # Initialize list of data frames

for (myfund in fund_names) {
  myfund <- example_df %>%
    filter(fund == myfund)
  fund_dfs[[length(fund_dfs)+1]] <- myfund
}
rm(myfund)
names(fund_dfs) <- fund_names

for (i in 1:length(fund_names)) {
  assign(fund_names[[i]], fund_dfs[[i]])
}

my_title <- as.list(paste0("Some title for ", (names(fund_dfs))))

plots <- map2(fund_dfs, my_title, fund_wtd_fx)

pdf()
walk(plots, print)
dev.off()
Comments