extract ARIMA specificaiton - r

Printing a fitted model object from auto.arima() includes a line such as
"ARIMA(2,1,0) with drift,"
which would be a nice item to include in sweave (or other) output illustrating the fitted model. Is it possible to extract that line as a block? At this point the best I am doing is to extract the appropriate order from the arma component (possibly coupled with verbiage from the names of the coefficients of the fitted model, e.g., "with drift" or "with non-zero mean.")
# R 3.0.2 x64 on Windows, forecast 5.3
library(forecast)
y <- ts(data = c(-4.389, -3.891, -4.435, -5.403, -2.501, -1.858, -4.735, -1.085, -2.701, -3.908, -2.520, -2.009, -6.961, -2.891, -0.6791, -1.459, -3.210, -2.178, -1.972, -1.207, -1.376, -1.355, -1.950, -2.862, -3.475, -1.027, -2.673, -3.116, -1.290, -1.510, -1.736, -2.565, -1.932, -0.8247, -2.067, -2.148, -1.236, -2.207, -1.120, -0.6152), start = 1971, end = 2010)
fm <- auto.arima(y)
fm
# what I want is the line: "ARIMA(2,1,0) with drift`"
str(fm)
paste("ARIMA(", fm$arma[1], ",", fm$arma[length(fm$arma)-1], ",", fm$arma[2], ") with ",intersect("drift", names(fm$coef)), sep = "")

Checking the auto.arima function, I noticed it internally calls another function which is named arima.string.
Then I did:
getAnywhere(arima.string)
and the output was:
A single object matching ‘arima.string’ was found
It was found in the following places
namespace:forecast
with value
function (object)
{
order <- object$arma[c(1, 6, 2, 3, 7, 4, 5)]
result <- paste("ARIMA(", order[1], ",", order[2], ",", order[3],
")", sep = "")
if (order[7] > 1 & sum(order[4:6]) > 0)
result <- paste(result, "(", order[4], ",", order[5],
",", order[6], ")[", order[7], "]", sep = "")
if (is.element("constant", names(object$coef)) | is.element("intercept",
names(object$coef)))
result <- paste(result, "with non-zero mean")
else if (is.element("drift", names(object$coef)))
result <- paste(result, "with drift ")
else if (order[2] == 0 & order[5] == 0)
result <- paste(result, "with zero mean ")
else result <- paste(result, " ")
return(result)
}
Then I copied the function code and pasted it in a new function which I named arima.string1
arima.string1(fm)
# [1] "ARIMA(2,1,0) with drift "

Today I discovered the block of text I sought is also stored in the forecast from the fitted model object:
forecast(fm)$method
Thanks to Fernando for properly markup-ing my question and to Davide for providing a pair of useful insights - getAnywhere() and arima.string() ready for modification.

Related

parsing GTF files

I wrote a script to parse out the last column of a gtf file. Script works well for 238460 rows, but when I applied it for whole rows, I faced an error. I would be grateful if you could help!
GTF file link:
the error is:
“Error in h(simpleError(msg, call)) : error in evaluating the argument 'expr' in selecting a method for function 'eval': :1:376: unexpected ';' 1: odel_evidence="Supporting evidence includes similarity to: 5 ESTs, 9 Proteins, and 100% coverage of the annotated genomic feature by RNAseq alignments, including 205 samples with support for a ^”
require(data.table)
info <- fread("GCF_000005505.3_Brachypodium_distachyon_v3.0_genomic.gtf")
colnames(info)[9] <- "AdditionalInfo"
keys <- lapply(info$AdditionalInfo, function(x)
unlist(lapply(unlist(strsplit(x, "; ")),
function(y) unlist(strsplit(y, " "))[1])) )
values <- lapply(info$AdditionalInfo, function(x)
unlist(lapply(unlist(strsplit(x, "; ")),
function(y) gsub("\"", "", unlist(strsplit(y, " "))[2]))) )
#keys[[2]]
#values[[2]]
x2= rbindlist(info[, .(list(eval(parse(text=
paste0('list(',
sub(',$', '',
gsub('([^ ]+) ([^;]+); *', '\\1=\\2,', AdditionalInfo)),
')')), .SD)))
, by = AdditionalInfo]$V1, fill = T)
I want to parse last column of gtf!

Error when using `refund::prf` without model intercept

I'm trying to run a functional data analysis model with scalar-on-function and on scalar regression in R. But by removing the intercept I'm getting the following error (the example is based on this discussion),
library(refund)
data(DTI)
DTI1 <- DTI[DTI$visit==1 & complete.cases(DTI),]
par(mfrow=c(1,2))
fit_af <- pfr(pasat ~ -1 +sex + case + af(cca, k=c(5, 8), bs="ps"), data = DTI1)
#Error in str2lang(x) : <text>:1:9: unexpected symbol
#1: pasat~0 sex
# ^
#Calls: pfr -> formula -> formula.character -> str2lang
How can I remove the intercept from a pfr model?
This is a bug. Running prf() in the debugging mode identifies the problem. When there is no intercept, it does:
if (!attr(tf, "intercept")) {
newfrml <- paste(newfrml, "0", sep = "")
}
which I think should be fixed to
if (!attr(tf, "intercept")) {
newfrml <- paste(newfrml, "0 +", sep = "")
}
Consider reporting this Stack Overflow thread, i.e., https://stackoverflow.com/q/72856108 to package maintainer Julia Wrobel: julia.wrobel#cuanschutz.edu
Note: This was tested using the latest refund_0.1-26 to date (released to CRAN on 2022-04-16).

R Passing parameters to lda() or qda()

I'm trying to optimize my code by saving parameters in vector form and pass it to lda() for modeling. The following method works fine for lm, but not for qda or lda. The error message I received is highlighted in yellow.
intvars <- c("x*y","y*t","z*w")
intfm <- paste("clickthrough", "~", paste(intvars, collapse = " + "))
lda_model_int <- lda(intfm, data = s_train)
Error in lda.default(intfm, data = s_train) : 'x' is not a matrix
You will have to change your string to formula or you can reformulate
intvars <- c("x*y","y*t","z*w")
intfm <- reformulate(intvars,"clickthrough")
lda_model_int <- lda(intfm, data = s_train)
If you wanted to do it your way you will have to do
intvars <- c("x*y","y*t","z*w")
intfm <- as. formula(paste("clickthrough", "~", paste(intvars, collapse = " + ")))
lda_model_int <- lda(intfm, data = s_train)

Use defined value in output name in r

I have defined MV1 below with a value, and have used the MV1 in the output name. However, when I run the summary function on my model output I get the following meesage
'Error: unexpected symbol in: "assign(paste("Model", MV1, sep = '') <- model1 summary" '
MVx is a value that is defined as a numeric in my code already, and MV1 equates to "_3" in my code.
MV = MVx+1
MV1= paste("_", MV, sep="")
assign(paste("Model", MV1, sep = '') = model1 <- glm(tv1~., family=binomial(link='logit'), data=train70)
summary(Model_3) #Error occurs here
Would anyone know how to get around that?
Try this code
MV = MVx+1
MV1= paste("_", MV, sep="")
model1 <- paste('Model', MV1, sep="")

Extract a predictors form constparty object (CHAID output) in R

I have a large dataset (questionnaire results) of mostly categorical variables. I have tested for dependency between the variables using chi-square test. There are incomprehensible number of dependencies between variables. I used the chaid() function in the CHAID package to detect interactions and separate out (what I hope to be) the underlying structure of these dependencies for each variable. What typically happens is that the chi-square test will reveal a large number of dependencies (say 10-20) for a variable and the chaid function will reduce this to something much more comprehensible (say 3-5). What I want to do is to extract the names of those variable that were shown to be relevant in the chaid() results.
The chaid() output is in the form of a constparty object. My question is how to extract the variable names associated with the nodes in such an object.
Here is a self contained code example:
library(evtree) # for the ContraceptiveChoice dataset
library(CHAID)
library(vcd)
library(MASS)
data("ContraceptiveChoice")
longform = formula(contraceptive_method_used ~ wifes_education +
husbands_education + wifes_religion + wife_now_working +
husbands_occupation + standard_of_living_index + media_exposure)
z = chaid(longform, data = ContraceptiveChoice)
# plot(z)
z
# This is the part I want to do programatically
shortform = formula(contraceptive_method_used ~ wifes_education + husbands_occupation)
# The thing I want is a programatic way to extract 'shortform' from 'z'
# Examples of use of 'shortfom'
loglm(shortform, data = ContraceptiveChoice)
One possible sollution:
nn <- nodeapply(z)
n.names= names(unlist(nn[[1]]))
ext <- unlist(sapply(n.names, function(x) grep("split.varid.", x, value=T)))
ext <- gsub("kids.split.varid.", "", ext)
ext <- gsub("split.varid.", "", ext)
dep.var <- as.character(terms(z)[1][[2]]) # get the dependent variable
plus = paste(ext, collapse=" + ")
mul = paste(ext, collapse=" * ")
shortform <- as.formula(paste (dep.var, plus, sep = " ~ "))
satform <- as.formula(paste (dep.var, mul, sep = " ~ "))
mosaic(shortform, data = ContraceptiveChoice)
#stp <- step(glm(satform, data=ContraceptiveChoice, family=binomial), direction="both")

Resources