Automatically plots with autoplot function from forecasting object - r

I am foresting with combination of data sets from fpp2 package and forecasting function from the forecast package. Output from this forecasting is object list with SNAIVE_MODELS_ALL. This object contain data separate for two series, where first is Electricity and second is Cement.
You can see code below :
# CODE
library(fpp2)
library(dplyr)
library(forecast)
library(gridExtra)
library(ggplot2)
#INPUT DATA
mydata_qauselec <- qauselec
mydata_qcement <- window(qcement, start = 1956, end = c(2010, 2))
# Мerging data
mydata <- cbind(mydata_qauselec, mydata_qcement)
colnames(mydata) <- c("Electricity", "Cement")
# Test Extract Name
mydata1 <- data.frame(mydata)
COL_NAMES <- names(mydata1)
rm(mydata_qauselec, mydata_qcement)
# FORCASTING HORIZON
forecast_horizon <- 12
#FORCASTING
BuildForecast <- function(Z, hrz = forecast_horizon) {
timeseries <- msts(Z, start = 1956, seasonal.periods = 4)
forecast <- snaive(timeseries, biasadj = TRUE, h = hrz)
}
frc_list <- lapply(X = mydata1, BuildForecast)
#FINAL FORCASTING
SNAIVE_MODELS_ALL<-lapply(frc_list, forecast)
So my intention here is to put this object SNAIVE_MODELS_ALL into autoplot function in order to get two plots like pic below.
With code below I draw both plots separate, but my main intention is to do this with function autoplot and some function like apply or something similar, which can automatically draw this two chart like pic above.This is only small example in real example I will have maybe 5 or 10 charts.
#PLOT 1
P_PLOT1<-autoplot(SNAIVE_Electricity,main = "Snaive Electricity forecast",xlab = "Year", ylab = "in billion kWh")+
autolayer(SNAIVE_Electricity,series="Data")+
autolayer(SNAIVE_Electricity$fitted,series="Forecasts")
# PLOT 2
P_PLOT2<-autoplot(SNAIVE_Cement,main = "Snaive Cement forecast",xlab = "Year", ylab = "in millions of tonnes")+
autolayer(SNAIVE_Cement,series="Data")+
autolayer(SNAIVE_Cement$fitted,series="Forecasts")
#UNION PLOTS (PLOT 1 AND PLOT 2)
SNAIVE_PLOT_ALL<-grid.arrange(P_PLOT1,P_PLOT2)
So can anybody help me with this code ?

If I understand in a proper way, one of the difficulties with that problem is that each plot should have a specific title and y label. One of the possible solutions is to set the plot titles and y-lables as function arguments:
PlotForecast <- function(df_pl, main_pl, ylab_plt){
autoplot(df_pl,
main = main_pl,
xlab = "Year", ylab = ylab_plt)+
autolayer(df_pl,series="Data")+
autolayer(df_pl$fitted,series="Forecasts")
}
Prepare lists of the plot labels to be used with PlotForecast():
main_lst <- list("Snaive Electricity forecast", "Snaive Cement forecast")
ylab_lst <- list("in billion kWh", "in millions of tonnes")
Construct a list of plot-objects using a base Map() function:
PL_list <- Map(PlotForecast, df_pl = SNAIVE_MODELS_ALL, main_pl = main_lst,
ylab_plt= ylab_lst)
Then all we have to do is to call grid.arrange() with the plot list:
do.call(grid.arrange, PL_list)
Note, please, that main_lst and ylab_lst are created manually for demonstration purposes, but it is not the best way if you work with a lot of charts. Ideally, the labels should be generated automatically using the original SNAIVE_PLOT_ALL list.

Related

Creating multiple plots within a loop and saving in R?

I am having trouble saving multiple plots from the output of a loop. To give some background:
I have multiple data frames, each with the data for single chemical toxicity for multiple species. I have labelled each data frame for the chemical that it represents, ie "ChemicalX". The data is in this format as this is how the "SSDTools" package works, which creates a species sensitivity distribution for a single chemical.
Because I have a lot of chemicals, I want to create a loop that iterates over each data frame, calculates the required metrics to create an SSD, plot the SSD, and then save the plot.
The code below works for calculating all of metrics and plotting the SSDs - it only breaks when I try to create a title within the loop, and when I try to save the plot within the loop
For reference, I am using the packages:
SSDTools, ggplot2, tidyverse, fitdistrplus
My code is as follows:
# Create a list of data frames
list_dfs <- list(ChemicalX, ChemicalY, ChemicalZ)
# make the loop
for (i in list_dfs){ # for each chemical (ie data frame)
ssd.fits <- ssd_fit_dists(i, dists = c("llogis", "gamma", "lnorm", "gompertz", "lgumbel", "weibull", "burrIII3", "invpareto", "llogis_llogis", "lnorm_lnorm")) # Test the goodness of fit using all distributions available
ssd.gof_fits <- ssd_gof(ssd.fits) # Save the goodness of fit statistics
chosen_dist <- ssd.gof_fits %>% # Choose the best fit distribution by
filter(aicc==min(aicc)) # finding the minimum aicc
final.fit <- ssd_fit_dists(i, dists = chosen_dist$dist) # Use the chosen distribution only
final.predict <-predict(final.fit, ci = TRUE) # generate the final predictions
plotdata <- i # create a separate plot data frame
final.plot <- ssd_plot(plotdata, final.predict, # generate the final plot
color = "Taxa",
label = "Species",
xlab = "Concentration (ug/L)", ribbon = TRUE) +
expand_limits(x = 10e6) + # to ensure the species labels fit
ggtitle(paste("Species Sensitivity for",chem_names_df[i], sep = " ")) +
scale_colour_ssd()
ggsave(filename = paste("SSD for",chem_names_df[i], ".pdf", sep = ""),
plot = final.plot)
}
The code works great right up until the last part, where I want to create a title for each chemical in each iteration, and where I want to save the filename as the chemical name.
I have two issues:
I want the title of the plot to be "Species Sensitivity for ChemicalX", with ChemicalX being the name of the data frame. However, when I use the following code the title gets all messed up, and gives me a list of the species in that data frame (see image).
ggtitle(paste("Species Sensitivity. for",i, sep = " "))
Graph title output using "i"
To try and get around this, I created a vector of chemical names that matches the order of the data frame list, called "chem_names_df". When I use ggtitle(paste("Species Sensitivity for",chem_names_df[i], sep = " ")) however, it gives me the error of Error in chem_names_df[i] : invalid subscript type 'list'
A similar issue is happening when I try to save the plot using GGSave. I am trying to save the filenames for each chemical data frame as "SSD_ChemicalX", except similarly to above it just outputs a list of the species in the place of i.
I think it has something to do with how R is calling from my list of dataframes - I am not sure why it is calling the species list (ie c("Danio Rerio, Lepomis macrochirus,...)) instead of the chemical name.
Any help would be appreciated! Thank you!
Basically your problem here is that you are sometimes using i as if it is an index, and sometimes as if it is a data frame, but in fact it is a data frame.
Your example is not reproducible so let me provide one. You have done the equivalent of:
list_dfs2 <- list(mtcars, mtcars, cars)
for(i in list_dfs2){
print(i)
}
This is just going to print the whole mtcars dataset twice and then the cars dataset. You can then define a vector:
cars_names <- c("mtcars", "mtcars", "cars")
If you call cars_names[i], on the first iteration you're not calling cars_names[1], you're trying to subset a vector with an entire data frame. That won't work. Better to seq_along() your list of data frames and then subset it with list_dfs[[i]] when you want to refer to the actual data frame rather than the index, i. Something like:
# Create a list of data frames
list_dfs <- list(ChemicalX, ChemicalY, ChemicalZ)
# make the loop
for (i in seq_along(list_dfs)){ # for each chemical (ie data frame)
ssd.fits <- ssd_fit_dists(list_dfs[[i]], dists = c("llogis", "gamma", "lnorm", "gompertz", "lgumbel", "weibull", "burrIII3", "invpareto", "llogis_llogis", "lnorm_lnorm")) # Test the goodness of fit using all distributions available
ssd.gof_fits <- ssd_gof(ssd.fits) # Save the goodness of fit statistics
chosen_dist <- ssd.gof_fits %>% # Choose the best fit distribution by
filter(aicc==min(aicc)) # finding the minimum aicc
final.fit <- ssd_fit_dists(list_dfs[[i]], dists = chosen_dist$dist) # Use the chosen distribution only
final.predict <-predict(final.fit, ci = TRUE) # generate the final predictions
plotdata <- list_dfs[[i]] # create a separate plot data frame
final.plot <- ssd_plot(plotdata, final.predict, # generate the final plot
color = "Taxa",
label = "Species",
xlab = "Concentration (ug/L)", ribbon = TRUE) +
expand_limits(x = 10e6) + # to ensure the species labels fit
ggtitle(paste("Species Sensitivity for",chem_names_df[i], sep = " ")) +
scale_colour_ssd()
ggsave(filename = paste("SSD for",chem_names_df[i], ".pdf", sep = ""),
plot = final.plot)
}
Consider using a defined method that receives name and data frame as input parameters. Then, pass a named list into the method using Map to iterate through data frames and corresponding names elementwise:
Function
build_plot <- function(plotdata, plotname) {
# Test the goodness of fit using all distributions available
ssd.fits <- ssd_fit_dists(
plotdata,
dists = c(
"llogis", "gamma", "lnorm", "gompertz", "lgumbel", "weibull",
"burrIII3", "invpareto", "llogis_llogis", "lnorm_lnorm"
)
)
# Save the goodness of fit statistics
ssd.gof_fits <- ssd_gof(ssd.fits)
# Choose the best fit distribution by finding the minimum aicc
chosen_dist <- filter(ssd.gof_fits, aicc==min(aicc))
# Use the chosen distribution only
final.fit <- ssd_fit_dists(plotdata, dists = chosen_dist$dist)
# generate the final predictions
final.predict <- predict(final.fit, ci = TRUE)
# generate the final plot
final.plot <- ssd_plot(
plotdata, final.predict, color = "Taxa", label = "Species",
xlab = "Concentration (ug/L)", ribbon = TRUE) +
expand_limits(x = 10e6) + # to ensure the species labels fit
ggtitle(paste("Species Sensitivity for", plotname)) +
scale_colour_ssd()
# export plot to pdf
ggsave(filename = paste0("SSD for ", plotname, ".pdf"), plot = final.plot)
# return plot to environment
return(final.plot)
}
Call
# create a named list of data frames
chem_dfs <- list(
"ChemicalX"=ChemicalX, "ChemicalY"=ChemicalY, "ChemicalZ"=ChemicalZ
)
chem_plots <- Map(build_plot, chem_dfs, names(chem_dfs))

Saving output plot in R with grid.grab() doesn't work

I've been trying to save multiple plot generated with the meta package in R, used to conduct meta-analysis, but I have some troubles. I need to save this plot to arrange them in a multiple plot figure.
Example data:
s <- data.frame(Study = paste0("Study", 1:15),
event.e = sample(1:100, 15),
n.e = sample(100:300, 15))
meta1 <- meta::metaprop(event = event.e,
n= n.e,
data=s,
studlab = Study)
Here is the code:
meta::funnel(meta1)
funnelplot <- grid::grid.grab()
I can see the figure in the "plot" tab in R Studio; However, if I search the funnelplot object in the environment it say that is a "NULL" type, and obviously trying to recall that doesn't work.
How can I fix it?

Trying to change time labels in R

I'm posting this because i've been having a little problem with my code. What i want to do is to make a forecast of COVID cases in a province for the next 30 days using the AUTOARIMA script. Everything is ok, but when i plot the forecast model, the date labels appears in increments of 25% (IE: 2020.2, 2020.4, etc), but i want to label that axis with a YMD format. This is my code:
library(readxl)
library(ggplot2)
library(forecast)
data <- read_xlsx("C:/Users/XXXX/Documents/Casos ARIMA Ejemplo.xlsx")
provincia_1 <- ts(data$Provincia_1, frequency = 365, start = c(2020,64))
autoarima_provincia1 <- auto.arima(provincia_1)
forecast_provincia1 <- forecast(autoarima_provincia1, h = 30)
plot(forecast_provincia1, main = "Proyeccion Provincia 1", xlab = "Meses", ylab = "Casos Diarios")
When i plot the forecast, this is what appears (with the problem i've stated before on the dates label)
The database is here:
https://github.com/pgonzalezp/Casos-Covid-provincias
Try to create a data.frame having on one column your predictions and in the other the daily dates. Then plot it.
Introduce your start and ending date as seen below, then at "by" argument, please check documentation from this link:
https://www.rdocumentation.org/packages/base/versions/3.6.2/topics/as.Date
df <- data.frame(
date=seq(as.Date("1999-01-01"), as.Date("2014-01-10"), by="6 mon"),
pred_val = forecast_provincia1
)
with(df, plot(date, pred_val ))
I got inspired from here:
R X-axis Date Labels using plot()

How do I plot multiple lines on the same graph?

I am using the R. I am trying to use the "lines' command in ggplot2 to show the predicted values vs. the actual values for a statistical model (arima, time series). Yet, when I ran the code, I can only see a line of one color.
I simulated some data in R and then tried to make plots that show actual vs predicted:
#set seed
set.seed(123)
#load libraries
library(xts)
library(stats)
#create data
date_decision_made = seq(as.Date("2014/1/1"), as.Date("2016/1/1"),by="day")
date_decision_made <- format(as.Date(date_decision_made), "%Y/%m/%d")
property_damages_in_dollars <- rnorm(731,100,10)
final_data <- data.frame(date_decision_made, property_damages_in_dollars)
#aggregate
y.mon<-aggregate(property_damages_in_dollars~format(as.Date(date_decision_made),
format="%W-%y"),data=final_data, FUN=sum)
y.mon$week = y.mon$`format(as.Date(date_decision_made), format = "%W-%y")`
ts = ts(y.mon$property_damages_in_dollars, start = c(2014,1), frequency = 12)
#statistical model
fit = arima(ts, order = c(4, 1, 1))
Here were my attempts at plotting the graphs:
#first attempt at plotting (no second line?)
plot(fit$residuals, col="red")
lines(fitted(fit),col="blue")
#second attempt at plotting (no second line?)
par(mfrow = c(2,1),
oma = c(0,0,0,0),
mar = c(2,4,1,1))
plot(ts, main="as-is") # plot original sim
lines(fitted(fit), col = "red") # plot fitted values
legend("topleft", legend = c("original","fitted"), col = c("black","red"),lty = 1)
#third attempt (plot actual, predicted and 5 future values - here, the actual and future values show up, but not the predicted)
pred = predict(fit, n.ahead = 5)
ts.plot(ts, pred$pred, lty = c(1,3), col=c(5,2))
However, none of these seem to be working correctly. Could someone please tell me what I am doing wrong? (note: the computer I am using for my work does not have an internet connection or a usb port - it only has R with some preloaded packages. I do not have access to the forecast package.)
Thanks
Sources:
In R plot arima fitted model with the original series
R fitted ARIMA off by one timestep? pkg:Forecast
Plotting predicted values in ARIMA time series in R
You seem to be confusing a couple of things:
fitted usually does not work on an object of class arima. Usually, you can load the forecast package first and then use fitted.
But since you do not have acces to the forecast package you cannot use fitted(fit): it always returns NULL. I had problems with fitted
before.
You want to compare the actual series (x) to the fitted series (y), yet in your first attempt you work with the residuals (e = x - y)
You say you are using ggplot2 but actually you are not
So here is a small example on how to plot the actual series and the fitted series without ggplot.
set.seed(1)
x <- cumsum(rnorm(10))
y <- stats::arima(x, order = c(1, 0, 0))
plot(x, col = "red", type = "l")
lines(x - y$residuals, col = "blue")
I Hope this answer helps you get back on tracks.

Creating Hexbins with Dates in R hexbin()

I am trying to create hexbins where the x-axis is a date using the hexbin function in the hexbin package in R. When I feed in my data, it seems to convert the dates into a numeric, which gets displayed on the x-axis. I want it force the x-axis to be a date.
#Create Hex Bins
hbin <- hexbin(xData$Date, xData$YAxis, xbins = 80)
#Plot using rBokeh
figure() %>%
ly_hexbin(hbin)
This gives me:
Here's a brute force approach using the underlying grid plotting package. The axes are ugly; maybe someone with better grid skills than I could pretty them up.
# make some data
x = seq.Date(as.Date("2015-01-01"),as.Date("2015-12-31"),by='days')
y = sample(x)
# make the plot and capture the plot
p <- plot(hexbin(x,y),yaxt='n',xaxt='n')
# calculate the ticks
x_ticks_date <-
x_ticks <- axTicks(1, log = FALSE, usr = as.numeric(range(x)),
axp=c(as.numeric(range(x)) ,5))
class(x_ticks_date) <- 'Date'
y_ticks_date <-
y_ticks <- axTicks(1, log = FALSE, usr = as.numeric(range(y)),
axp=c(as.numeric(range(y)) ,5))
class(y_ticks_date) <- 'Date'
# push the ticks to the view port.
pushViewport(p$plot.vp#hexVp.off)
grid.xaxis(at=x_ticks, label = format(y_ticks_date))
grid.yaxis(at=y_ticks, label = format(y_ticks_date))

Resources