I have a list of model objects called allAR1. For each model object, I need to use the tsdiag function to produce the diagnostics plot and then save that plot to a folder.
I am trying to use a combination of jpeg(), lapply and dev.off() to apply tsdiag to each model and then save the resulting plot as an image file. The problem is that this only seems to save the diagnostic plot for the first model in the allAR1 list, whereas I would like to save the diagnostic plots for all models in allAR1.
Here is my code and a reproducible example:
library(tseries)
data(nino)
nino = list(nino3 = nino3, nino4 = nino3.4)
ar <- function(dat, idx, order, m) {
paes = arima(dat, order = order)
bic = paes$loglik + m*log(length(dat))
res = residuals(paes)
all = list(paes = paes,
bic = bic,
res = res)
assign(idx, all)
return(all)
}
allAR1 = mapply(ar, dat = nino, idx = names(nino),
MoreArgs = list(order = c(1,0,0), m = 1),
SIMPLIFY = F)
allpaes = lapply(allpaes, function(x) x$paes)
jpeg(sprintf("C:/Users/owner/Documents/%s.jpeg", names(nino)))
lapply(allAR1, tsdiag, gof.lag = 1000)
dev.off()
I have also tried lapply(allAR1, function(x) {jpeg(sprintf("C:/Users/owner/Documents/%s.jpeg", names(nino))); tsdiag(x$paes, 1000); dev.off()}). However, this gives me the same result as the code above.
Any help would be greatly appreciated as I am not sure where I am going wrong.
Here's a code snippet to get you started:
library(tseries)
#from tsdiag help page
fit <- arima(lh, c(1,0,0))
#make an arbitrary list of model fits
models <- list(m1 = fit, m2 = fit)
lapply(1:length(models), function(x){
jpeg(paste0(names(models)[x], ".jpeg"))
tsdiag(models[[x]])
dev.off()
})
Related
I want to loop through a list of elements and use them in a function. Here is a partial code, from a t-test in jamovi package.
j = c("K1", "K2")
for (i in j) {
temp1 <- jmv::ttestIS(
formula = i ~ T1,
data = data1,
vars = i,
students = FALSE,
eqv = TRUE)
temp1
}
I get the error that the argument i is not in the dataset. I suppose it's because the function sees i as itself and not K1. Any ideas how to access the loop elements in the function?
ps. I can provide a reproducible code if needed.
You can use as.formula(). However, please note that you are overwriting temp1 for each iteration of j here; was that your intention?
for (i in j) {
formula = as.formula(paste(i,"~T1"))
temp1 <- jmv::ttestIS(
formula = formula,
data = data1,
students = FALSE,
eqv = TRUE)
temp1
}
Instead of using
for (i in j)
use
for (in in 1:length(j))
I'm trying to pass a custom R function inside spark_apply but keep running into issues and cant figure out what some of the errors mean.
library(sparklyr)
sc <- spark_connect(master = "local")
perf_df <- data.frame(predicted = c(5, 7, 20),
actual = c(4, 6, 40))
perf_tbl <- sdf_copy_to(sc = sc,
x = perf_df,
name = "perf_table")
#custom function
ndcg <- function(predicted_rank, actual_rank) {
# x is a vector of relevance scores
DCG <- function(y) y[1] + sum(y[-1]/log(2:length(y), base = 2))
DCG(predicted_rank)/DCG(actual_rank)
}
#works in R using R data frame
ndcg(perf_df$predicted, perf_df$actual)
#does not work
perf_tbl %>%
spark_apply(function(e) ndcg(e$predicted, e$actual),
names = "ndcg")
Ok, i'm seeing two possible problems.
(1)-spark_apply prefers functions that have one parameter, a dataframe
(2)-you may need to make a package depending on how complex the function in.
let's say you modify ndcg to receive a dataframe as the parameter.
ndcg <- function(dataset) {
predicted_rank <- dataset$predicted
actual_rank <- dataset$actual
# x is a vector of relevance scores
DCG <- function(y) y[1] + sum(y[-1]/log(2:length(y), base = 2))
DCG(predicted_rank)/DCG(actual_rank)
}
And you put that in a package called ndcg_package
now your code will be similar to:
spark_apply(perf_tbl, ndcg, packages = TRUE, names = "ndcg")
Doing this from memory, so there may be a few typos, but it'll get you close.
My objective is to create a number of time-series subsets from a list of variables. I wrote this with a for-loop. However, I'm looking for more elegant ideas on how to do with an existir R function, that doesn't require a loop.
All ideas and intros to new functions in R are much appreciated.
A reproducible example of the code:
russell_sim <- arima.sim(model=list(ar=c(.9,-.2)),n=449)
russell_sim <- ts(russell_sim, start = c(1980,1), end = c(2017,5) ,frequency = 12)
pmi_sim <- arima.sim(model=list(ar=c(.9,-.2)),n=449)
pmi_sim <- ts(russell_sim, start = c(1980,1), end = c(2017,5) ,frequency = 12)
big_list<- list(russell = russell_sim, pmi= pmi_sim)
for (i in 1: length(big_list)) {
assign(paste(names(x = big_list)[i], "_before08", sep = ""), window(big_list[[i]], start=c(1981,1), end=c(2007, 12)) )
}
Thank you.
You can make use of the handy list2env function but you will need to edit the list first to get your desired output:
# New List to edit
big_list_before08 <- big_list
# change your observations
big_list_before08 <- lapply(big_list_before08, function(x) window(x, start = c(1981,1),
end = c(2007,12)))
# change the individual list element names
names(big_list_before08) <- paste0(names(big_list),"_before08")
# save to the global environment
list2env(big_list_before08, envir = .GlobalEnv)
Let me know if you have any questions!
Having problems with a function I wrote in R using the forecast package. This is the function:
generateARIMAForecasts <- function(inputTSDecompList, inputArimaOrder, fcstHrzn, cnst, drft){
tmpSTL <- NULL;
fcasting <- NULL;
tsfcastList <- NULL;
counter <- 1;
while(counter <= length(inputTSDecompList)){
#select the TS decompositions
tmpSTL <- inputTSDecompList[counter]$TimeSeriesDecomposition;
#add the lattice plot to the list of plots
if(cnst == TRUE & drft == TRUE){
fcasting <- forecast(tmpSTL, h=fcstHrzn,
forecastfunction=function(x,h,level, ...){
fit <- Arima(x, order=inputArimaOrder, include.constant = TRUE, include.drift = TRUE)
return(forecast(fit,h=fcstHrzn,level=level, ...))});
}
fcastCoefs <- fcasting$model$coef;
fcstValues <- fcasting;
fcastSummary <- summary(fcasting);
#add the forecast results to the forecast list
tsfcastList[[counter]] <- list(FinancialInstitution=LVTSFITimeSeriesList[counter]$LVTSFITimeSeriesList$FinancialInstitution,
ForecastCoefficients=fcastCoefs,
ForecastedSeries=fcstValues,
ForecastSummary=fcastSummary);
counter <- counter+1;
}
return(tsfcastList);
}
The function takes a list of STL decomposed series, and generates Arima forecasts for each of the individual stl decomposed time series in the input list.
I have run the forecast generation manually by hardcoding for individual elements and it works. However when I try to do it using the function I get the following error
Error in meanf(object, h = h, level = level, fan = fan, lambda = lambda, :
unused argument (forecastfunction = function (x, h, level, ...)
{
fit <- Arima(x, order = inputArimaOrder, include.constant = TRUE, include.drift = TRUE)
return(forecast(fit, h = fcstHrzn, level = level, ...))
})
In addition: There were 50 or more warnings (use warnings() to see the first 50)
Could someone advise please?
Hi after a few more hours manually debugging each line in the RStudio console, I figured it out the issue was my call
tmpSTL <- inputTSDecompList[counter]$TimeSeriesDecomposition;
This returned NULL because I had created the inputTSDecompList as a 2-D list using
tsDecomList[[counter]] <- list(FinancialInstitution=inputTSList[counter]$LVTSFITimeSeriesList$FinancialInstitution, TimeSeriesDecomposition=tsDecom);
So I should have been calling
tmpSTL <- inputTSDecompList[[counter]]$TimeSeriesDecomposition;
I often run JAGS models on simulated data with known parameters. I like the default plot method for mcmc objects. However, I would like to add an abline(v=TRUE_VALUE) for each parameter that is modelled. This would give me a quick check for whether the posterior is reasonable.
Of course I could do this manually, or presumably reinvent the wheel and write my own function. But I was wondering if there is an elegant way that builds on the existing plot method.
Here's a worked example:
require(rjags)
require(coda)
# simulatee data
set.seed(4444)
N <- 100
Mu <- 100
Sigma <- 15
y <- rnorm(n=N, mean=Mu, sd=Sigma)
jagsdata <- list(y=y)
jags.script <- "
model {
for (i in 1:length(y)) {
y[i] ~ dnorm(mu, tau)
}
mu ~ dnorm(0, 0.001)
sigma ~ dunif(0, 1000)
tau <- 1/sigma^2
}"
mod1 <- jags.model(textConnection(jags.script), data=jagsdata, n.chains=4,
n.adapt=1000)
update(mod1, 200) # burn in
mod1.samples <- coda.samples(model=mod1,
variable.names=c('mu', 'sigma'),
n.iter=1000)
plot(mod1.samples)
I just want to run something like abline(v=100) for mu and abline(v=15) for sigma. Of course in many other examples, I would have 5, 10, 20 or more parameters of interest. Thus, I'm interested in being able to supply a vector of true values for named parameters.
I've had a look at getAnywhere(plot.mcmc). Would modifying that be a good way to go?
Okay. So I modified plot.mcmc to look like this:
my.plot.mcmc <- function (x, trace = TRUE, density = TRUE, smooth = FALSE, bwf,
auto.layout = TRUE, ask = FALSE, parameters, ...)
{
oldpar <- NULL
on.exit(par(oldpar))
if (auto.layout) {
mfrow <- coda:::set.mfrow(Nchains = nchain(x), Nparms = nvar(x),
nplots = trace + density)
oldpar <- par(mfrow = mfrow)
}
for (i in 1:nvar(x)) {
y <- mcmc(as.matrix(x)[, i, drop = FALSE], start(x),
end(x), thin(x))
if (trace)
traceplot(y, smooth = smooth, ...)
if (density) {
if (missing(bwf)) {
densplot(y, ...); abline(v=parameters[i])
} else densplot(y, bwf = bwf, ...)
}
if (i == 1)
oldpar <- c(oldpar, par(ask = ask))
}
}
Then running the command
my.plot.mcmc(mod1.samples, parameters=c(Mu, Sigma))
produces this
Note that parameters must be a vector of values in the same sort order as JAGS sorts variables, which seems to be alphabetically and then numerically for vectors.
Lessons learnt
Simply writing a new plot.mcmc didn't work by default presumably because of namespaces. So I just created a new function
I had to change set.mfrow to coda:::set.mfrow presumably also because of namespaces.
I changed ask to ask=FALSE, because RStudio permits browsing through figures.
I'd be happy to hear any suggestions about better ways of overriding or adapting existing S3 methods.