Related
I am trying to implement NLPCA (Nonlinear PCA) on a data set using the homals package in R but I keep on getting the following error message:
Error in dimnames(x) <- dn : length of 'dimnames' [1] not equal to array extent
The data set I use can be found in the UCI ML Repository and it's called dat when imported in R: https://archive.ics.uci.edu/ml/datasets/South+German+Credit+%28UPDATE%29
Here is my code (some code is provided once the data set is downloaded):
nlpcasouthgerman <- homals(dat, rank=1, level=c('nominal','numerical',rep('nominal',2),
'numerical','nominal',
rep('ordinal',2), rep('nominal',2),
'ordinal','nominal','numerical',
rep('nominal',2), 'ordinal',
'nominal','ordinal',rep('nominal',3)),
active=c(FALSE, rep(TRUE, 20)), ndim=3, verbose=1)
I am trying to predict the first attribute, therefore I set it to be active=FALSE.
The output looks like this (skipped all iteration messages):
Iteration: 1 Loss Value: 0.000047
Iteration: 2 Loss Value: 0.000044
...
Iteration: 37 Loss Value: 0.000043
Iteration: 38 Loss Value: 0.000043
Error in dimnames(x) <- dn :
length of 'dimnames' [1] not equal to array extent
I don't understand why this error comes up. I have used the same code on some other data set and it worked fine so I don't see why this error persists. Any suggestions about what might be going wrong and how I could fix this issue?
Thanks!
It seems the error comes from code generating NAs in the homals function, specifically for your data for the number_credits levels, which causes problems with sort(as.numeric((rownames(clist[[i]])))) and the attempt to catch the error, since one of the levels does not give an NA value.
So either you have to modify the homals function to take care of such an edge case, or change problematic factor levels. This might be something to file as a bug report to the package maintainer.
As a work-around in your case you could do something like:
levels(dat$number_credits)[1] <- "_1"
and the function should run without problems.
Edit:
I think one solution would be to change one line of code in the homals function, but no guarantee this does work as intended. Better submit a bug report to the package author/maintainer - see https://cran.r-project.org/web/packages/homals/ for the address.
Using rnames <- as.numeric(rownames(clist[[i]]))[order(as.numeric(rownames(clist[[i]])))] instead of rnames <- sort(as.numeric((rownames(clist[[i]])))) would allow the following code to identify NAs, but I am not sure why the author did not try to preserve factor levels outright.
Anyway, you could run a modified function in your local environment, which would require to explicitly call internal (not exported) homals functions, as shown below. Not necessarily the best approach, but would help you out in a pinch.
homals <- function (data, ndim = 2, rank = ndim, level = "nominal", sets = 0,
active = TRUE, eps = 0.000001, itermax = 1000, verbose = 0) {
dframe <- data
name <- deparse(substitute(dframe))
nobj <- nrow(dframe)
nvar <- ncol(dframe)
vname <- names(dframe)
rname <- rownames(dframe)
for (j in 1:nvar) {
dframe[, j] <- as.factor(dframe[, j])
levfreq <- table(dframe[, j])
if (any(levfreq == 0)) {
newlev <- levels(dframe[, j])[-which(levfreq == 0)]
}
else {
newlev <- levels(dframe[, j])
}
dframe[, j] <- factor(dframe[, j], levels = sort(newlev))
}
varcheck <- apply(dframe, 2, function(tl) length(table(tl)))
if (any(varcheck == 1))
stop("Variable with only 1 value detected! Can't proceed with estimation!")
active <- homals:::checkPars(active, nvar)
rank <- homals:::checkPars(rank, nvar)
level <- homals:::checkPars(level, nvar)
if (length(sets) == 1)
sets <- lapply(1:nvar, "c")
if (!all(sort(unlist(sets)) == (1:nvar))) {
print(cat("sets union", sort(unlist(sets)), "\n"))
stop("inappropriate set structure !")
}
nset <- length(sets)
mis <- rep(0, nobj)
for (l in 1:nset) {
lset <- sets[[l]]
if (all(!active[lset]))
(next)()
jset <- lset[which(active[lset])]
for (i in 1:nobj) {
if (any(is.na(dframe[i, jset])))
dframe[i, jset] <- NA
else mis[i] <- mis[i] + 1
}
}
for (j in 1:nvar) {
k <- length(levels(dframe[, j]))
if (rank[j] > min(ndim, k - 1))
rank[j] <- min(ndim, k - 1)
}
x <- cbind(homals:::orthogonalPolynomials(mis, 1:nobj, ndim))
x <- homals:::normX(homals:::centerX(x, mis), mis)$q
y <- lapply(1:nvar, function(j) homals:::computeY(dframe[, j], x))
sold <- homals:::totalLoss(dframe, x, y, active, rank, level, sets)
iter <- pops <- 0
repeat {
iter <- iter + 1
y <- homals:::updateY(dframe, x, y, active, rank, level, sets,
verbose = verbose)
smid <- homals:::totalLoss(dframe, x, y, active, rank, level,
sets)/(nobj * nvar * ndim)
ssum <- homals:::totalSum(dframe, x, y, active, rank, level, sets)
qv <- homals:::normX(homals:::centerX((1/mis) * ssum, mis), mis)
z <- qv$q
snew <- homals:::totalLoss(dframe, z, y, active, rank, level,
sets)/(nobj * nvar * ndim)
if (verbose > 0)
cat("Iteration:", formatC(iter, digits = 3, width = 3),
"Loss Value: ", formatC(c(smid), digits = 6,
width = 6, format = "f"), "\n")
r <- abs(qv$r)/2
ops <- sum(r)
aps <- sum(La.svd(crossprod(x, mis * z), 0, 0)$d)/ndim
if (iter == itermax) {
stop("maximum number of iterations reached")
}
if (smid > sold) {
warning(cat("Loss function increases in iteration ",
iter, "\n"))
}
if ((ops - pops) < eps)
break
else {
x <- z
pops <- ops
sold <- smid
}
}
ylist <- alist <- clist <- ulist <- NULL
for (j in 1:nvar) {
gg <- dframe[, j]
c <- homals:::computeY(gg, z)
d <- as.vector(table(gg))
lst <- homals:::restrictY(d, c, rank[j], level[j])
y <- lst$y
a <- lst$a
u <- lst$z
ylist <- c(ylist, list(y))
alist <- c(alist, list(a))
clist <- c(clist, list(c))
ulist <- c(ulist, list(u))
}
dimlab <- paste("D", 1:ndim, sep = "")
for (i in 1:nvar) {
if (ndim == 1) {
ylist[[i]] <- cbind(ylist[[i]])
ulist[[i]] <- cbind(ulist[[i]])
clist[[i]] <- cbind(clist[[i]])
}
options(warn = -1)
# Here is the line that I changed in the code:
# rnames <- sort(as.numeric((rownames(clist[[i]]))))
rnames <- as.numeric(rownames(clist[[i]]))[order(as.numeric(rownames(clist[[i]])))]
options(warn = 0)
if ((any(is.na(rnames))) || (length(rnames) == 0))
rnames <- rownames(clist[[i]])
if (!is.matrix(ulist[[i]]))
ulist[[i]] <- as.matrix(ulist[[i]])
rownames(ylist[[i]]) <- rownames(ulist[[i]]) <- rownames(clist[[i]]) <- rnames
rownames(alist[[i]]) <- paste(1:dim(alist[[i]])[1])
colnames(clist[[i]]) <- colnames(ylist[[i]]) <- colnames(alist[[i]]) <- dimlab
colnames(ulist[[i]]) <- paste(1:dim(as.matrix(ulist[[i]]))[2])
}
names(ylist) <- names(ulist) <- names(clist) <- names(alist) <- colnames(dframe)
rownames(z) <- rownames(dframe)
colnames(z) <- dimlab
dummymat <- as.matrix(homals:::expandFrame(dframe, zero = FALSE, clean = FALSE))
dummymat01 <- dummymat
dummymat[dummymat == 2] <- NA
dummymat[dummymat == 0] <- Inf
scoremat <- array(NA, dim = c(dim(dframe), ndim), dimnames = list(rownames(dframe),
colnames(dframe), paste("dim", 1:ndim, sep = "")))
for (i in 1:ndim) {
catscores.d1 <- do.call(rbind, ylist)[, i]
dummy.scores <- t(t(dummymat) * catscores.d1)
freqlist <- apply(dframe, 2, function(dtab) as.list(table(dtab)))
cat.ind <- sequence(sapply(freqlist, length))
scoremat[, , i] <- t(apply(dummy.scores, 1, function(ds) {
ind.infel <- which(ds == Inf)
ind.minfel <- which(ds == -Inf)
ind.nan <- which(is.nan(ds))
ind.nael <- which((is.na(ds) + (cat.ind != 1)) ==
2)
ds[-c(ind.infel, ind.minfel, ind.nael, ind.nan)]
}))
}
disc.mat <- apply(scoremat, 3, function(xx) {
apply(xx, 2, function(cols) {
(sum(cols^2, na.rm = TRUE))/nobj
})
})
result <- list(datname = name, catscores = ylist, scoremat = scoremat,
objscores = z, cat.centroids = clist, ind.mat = dummymat01,
loadings = alist, low.rank = ulist, discrim = disc.mat,
ndim = ndim, niter = iter, level = level, eigenvalues = r,
loss = smid, rank.vec = rank, active = active, dframe = dframe,
call = match.call())
class(result) <- "homals"
result
}
I have an R programm for a regression that somehow gives me an error message that I do not understand. The regression model takes as input heat input heat data (Q_htg) and the corresponding temperature data (T_amb) and then builds a linear regression for those two variables. Afterwards I want to use the trained regression model to predict some outputs. Here is the code:
dalinearPowerScaling2.function <-
function(Dataset,
numberOfDaysForAggregation,
normOutsideTemperature) {
heatingPower <- Dataset$Q_htg
outSideTemperature <- Dataset$T_amb
aggregationLevel <- numberOfDaysForAggregation * 1440
index <- 0
meanValuesOutsideTemperature <-
vector(, length(outSideTemperature) / aggregationLevel)
for (i in seq(1, length(outSideTemperature), aggregationLevel)) {
sum <- 0
for (j in seq(i, i + aggregationLevel - 1, 1)) {
sum <- sum + outSideTemperature[j]
}
index <- index + 1
meanValuesOutsideTemperature[index] <- sum / aggregationLevel
}
index <- 0
meanValuesHeatingDemand <-
vector(, length(heatingPower) / aggregationLevel)
for (i in seq(1, length(heatingPower), aggregationLevel)) {
sum <- 0
for (j in seq(i, i + aggregationLevel - 1, 1)) {
sum <- sum + heatingPower[j]
}
index <- index + 1
meanValuesHeatingDemand[index] <- sum / aggregationLevel
}
linearModel <-
lm(meanValuesHeatingDemand ~ meanValuesOutsideTemperature)
abline(linearModel, col = "red")
pred <- predict(linearModel, data.frame(meanValuesOutsideTemperature = c(normOutsideTemperature)))
List<-list(meanValuesHeatingDemand, meanValuesOutsideTemperature)
List2 <- vector("list", length(heatingPower)/aggregationLevel)
for (i in seq(1, length(meanValuesHeatingDemand),1)){
List2 [[i]]<-c(meanValuesHeatingDemand[i], meanValuesOutsideTemperature[i])
}
List3<-List2[order(sapply(List2, function(x) x[1], simplify=TRUE), decreasing=FALSE)]
firstTemperatureWithHeatingDemand<-0
firstHeatingDemand<-0
for (i in seq(1, length(List3), 1)) {
if(List3[[i]][1]>0) {
firstTemperatureWithHeatingDemand<-List3[[i]][2]
firstHeatingDemand<-List3[[i]][1]
break}
}
regression2ValuesX <- vector(, 5)
regression2ValuesY <- vector(, 5)
regression2ValuesX [1] <- firstTemperatureWithHeatingDemand
regression2ValuesY [1] <-firstHeatingDemand
List3<-List2[order(sapply(List2, function(x) x[1], simplify=TRUE), decreasing=TRUE)]
for (i in seq(1, length(regression2ValuesX) - 1, 1)) {
regression2ValuesX[i + 1]<-List3[[i]][2]
regression2ValuesY[i + 1]<-List3[[i]][1]
}
plot(regression2ValuesX, regression2ValuesY)
linearModel2 <-
lm(regression2ValuesY ~ regression2ValuesX)
abline(linearModel2, col = "blue")
pred <- predict(linearModel2, data.frame(regression2ValuesX = c(normOutsideTemperature)))
paste("Predicted heating demand:", round(pred))
}
When I run with the command
linearPowerScaling2.function(data_heat_test, 1, -12)
I get the error message:
Error in int_abline(a = a, b = b, h = h, v = v, untf = untf, ...) :
plot.new has not been called yet
3.
int_abline(a = a, b = b, h = h, v = v, untf = untf, ...)
2.
abline(linearModel, col = "red") at LinearPowerScaling2_Function.R#33
1.
linearPowerScaling2.function(data_heat_test, 1, -12)
The data itself should be okay. Can anyone tell me, what the problem is?
Without reproducible minimal example it's hard to test if this solves it, but the error message tells you that you are calling abline() before calling plot().
That's exactly what happens on line 33...
Hope this helps.
Check here to see how to make a minimal reproducible example.
I am trying to implement logistic regression and the function works manually, but for some reason I get the error "Error in nrow(X) : object 'X' not found ", even though X is defined before the nrow command. I use the UCI Data "Adult" to test it.
If i try to run the function manually there is no error. Can anyone explain that?
# Sigmoidfunction
sigmoid <- function(z){
g <- 1/(1+exp(-z))
return(g)
}
# Costfunction
cost <- function(theta){
n <- nrow(X)
g <- sigmoid(X %*% theta)
J <- (1/n)*sum((-Y*log(g)) - ((1-Y)*log(1-g)))
return(J)
}
log_reg <- function(datafr, m){
# Train- und Testdaten Split
sample <- sample(1:nrow(datafr), m)
df_train <- datafr[sample,]
df_test <- datafr[-sample,]
num_features <- ncol(datafr) - 1
num_label <- ncol(datafr)
label_levels <- levels(datafr[, num_label])
datafr[, num_features+1] <- ifelse(datafr[, num_label] == names(table(datafr[,num_label]))[1], 0, 1)
# Predictor variables
X <- as.matrix(df_train[, 1:num_features])
X_test <- as.matrix(df_test[, 1:num_features])
# Add ones to X
X <- cbind(rep(1, nrow(X)), X)
X_test <- cbind(rep(1, nrow(X_test)), X_test)
# Response variable
Y <- as.matrix(df_train[, num_label] )
Y <- ifelse(Y == names(table(Y))[1], 0, 1)
Y_test <- as.matrix(df_test[, num_label] )
Y_test <- ifelse(Y_test == names(table(Y_test))[1], 0, 1)
# Intial theta
initial_theta <- rep(0, ncol(X))
# Derive theta using gradient descent using optim function
theta_optim <- optim(par=initial_theta, fn=cost)
predictions <- ifelse(sigmoid(X_test%*%theta_optim$par)>=0.5, 1, 0)
# Generalization error
error_rate <- sum(predictions!=Y_test)/length(Y_test)
return(error_rate)
}
### Adult Data
data <- read.table('https://archive.ics.uci.edu/ml/machine-learning-databases/adult/adult.data',
sep = ',', fill = F, strip.white = T)
colnames(data) <- c('age', 'workclass', 'fnlwgt', 'education',
'education_num', 'marital_status', 'occupation', 'relationship', 'race', 'sex',
'capital_gain', 'capital_loss', 'hours_per_week', 'native_country', 'income')
# Featureselection
datafr <- data[, c("age", "education_num", "hours_per_week", "income")]
log_reg(datafr = datafr, m = 20)
You are calling cost() in which you refer to X, but X has not been defined in cost(). Either define it within log_reg() after you have defined X, or, better, make X a parameter for cost().
cost <- function(theta, X, Y){
n <- nrow(X)
g <- sigmoid(X %*% theta)
J <- (1/n)*sum((-Y*log(g)) - ((1-Y)*log(1-g)))
return(J)
}
And later
theta_optim <- optim(par=initial_theta, fn=cost, X=X, Y=Y)
In general, try to avoid having variables used in a function which are not defined explicitly as arguments to that function. Otherwise you will always end up with problems like this one.
Also, how did I find it out? I used traceback():
> traceback()
5: nrow(X) at #2
4: fn(par, ...)
3: (function (par)
fn(par, ...))(c(0, 0, 0, 0))
2: optim(par = initial_theta, fn = cost) at #33
1: log_reg(datafr = datafr, m = 20)
I am trying to optimise a likelihood function using package maxLik as follows.
library(fExtremes)
theta0 <- c(0.1, 1)
theta1 <- c(0.1, 2)
set.seed(20150518)
X <- matrix(0, nrow=1000, ncol=1000)
for(i in 1:1000){
X[i, ] <- c(rgpd(900, xi=-theta0[1], beta=theta0[2]),
rgpd(100, xi=-theta1[1], beta=theta1[2]))
}
library(maxLik)
loglik <- function(param){
shape <- param[1]
scale <- param[2]
sum(dgpd(x, xi=-shape, beta=scale, log=TRUE))
}
scale.mle <- rep(0, 1000)
for(i in 1:1000){
x <- X[i, ]
scale.mle[i] <- as.numeric(maxLik(logLik=loglik, start=c(theta0[1], theta0[2]), fixed=1)$estimate[2])
}
However, I keep getting the following error message:
Error in maxNRCompute(fn = logLikAttr, fnOrig = fn, gradOrig = grad, hessOrig = hess, :
NA in the initial gradient
How do I fix this? Is it even possible? Also what other R function can be used to optimise this?
I have a loop in R which tests every possible combination of ARIMA with specific conditions and tests the lags. However during the loop there is an error
Error in optim(init[mask], armafn, method = optim.method, hessian = TRUE, :
non-finite finite-difference value [1]
When this error occurs I want it to create a vector of "n" which will be put into a matrix with the rest of the models. I have tried tryCatch but this for some reason stops the rest of the iterations from happening.
Here is my code:
N<- c(155782.7, 159463.7, 172741.1, 204547.2, 126049.3, 139881.9, 140747.3, 251963.0, 182444.3, 207780.8, 189251.2, 318053.7, 230569.2, 247826.8, 237019.6, 383909.5, 265145.5, 264816.4, 239607.0, 436403.1, 276767.7, 286337.9, 270022.7, 444672.9, 263717.2, 343143.9, 271701.7)
aslog<-"n"
library(gtools)
library(forecast)
a<-permutations(n=3,r=6,v=c(0:2),repeats.allowed=TRUE)
a<-a[ifelse((a[,1]+a[,4]>2|a[,2]+a[,5]>2|a[,3]+a[,6]>2),FALSE,TRUE),]
namWA<-matrix(0,ncol=1,nrow=length(a[,1]))
namWS<-matrix(0,ncol=1,nrow=length(a[,1]))
Arimafit<-matrix(0,ncol=length(N),nrow=length(a[,1]),byrow=TRUE)
tota<-matrix(0,ncol=1,nrow=length(a[,1]))
totb<-matrix(0,ncol=1,nrow=length(a[,1]))
for(i in 1:length(a[,1])){
namWA[i]<-paste("orderWA",i,sep=".")
assign(namWA[i],a[i,c(1:3)])
namWS[i]<-paste("orderWS",i,sep=".")
assign(namWS[i],a[i,c(4:6)])
ArimaW1 <- Arima(N, order= a[i,c(1:3)], seasonal=list(order=a[i,c(4:6)]),method="ML")
if(aslog=="y"){Arimafit[i,]<-c(exp(fitted(ArimaW1)))}else{Arimafit[i,]<-c(fitted(ArimaW1))}
nnn<-c(N)
arimab<-c(Arimafit[i,])
fullres<-nnn-arimab
v<-acf(fullres,plot=FALSE)
w<-pacf(fullres,plot=FALSE)
if(v$acf[2]>0.4|v$acf[2]<(-0.4)|v$acf[3]>0.4|v$acf[3]<(-0.4)|v$acf[4]>0.4|v$acf[4]<(-0.4)|v$acf[5]>0.4|v$acf[5]<(-0.4)|v$acf[6]>0.4|v$acf[6]<(-0.4)|v$acf[7]>0.4|v$acf[7]<(-0.4)|w$acf[1]>0.4|w$acf[1]<(-0.4)|w$acf[2]>0.4|w$acf[2]<(-0.4)|w$acf[3]>0.4|w$acf[3]<(-0.4)|w$acf[4]>0.4|w$acf[4]<(-0.4)|w$acf[5]>0.4|w$acf[5]<(-0.4)|w$acf[6]>0.4|w$acf[6]<(-0.4))
tota[i]<-"n" else{
tota[i]<-sum(abs(v$acf[2:7]))
totb[i]<-sum(abs(w$acf[1:6]))}
}
I tried doing
ArimaW1<-tryCatch(Arima(N, order= a[i,c(1:3)], seasonal=list(order=a[i,c(4:6)]),method="ML"),error=function(e) NULL)
and this gave another error
Error in Arimafit[i, ] <- c(fitted(ArimaW1)) :
number of items to replace is not a multiple of replacement length
then i tried:
ArimaW1<-tryCatch(Arima(N, order= a[i,c(1:3)], seasonal=list(order=a[i,c(4:6)]),method="ML"),error=function(e) matrix("n",ncol=length(Arimafit[1,])))
but this gave an error:
Error: $ operator is invalid for atomic vectors
and also gave a matrix with all the fitted ARIMA values up to iteration 68, after that it gives everything as 0.0
is there a way to get the loop to continue the iterations, filling a vector with a value which goes into the matrix Arimafit like the iterations that do work so that i can carry on with the code?
I just found out the way to do what i wanted to do. This may help other people so I wont delete it, ill just post the solution :)
library(gtools)
a<-permutations(n=3,r=6,v=c(0:2),repeats.allowed=TRUE)
a<-a[ifelse((a[,1]+a[,4]>2|a[,2]+a[,5]>2|a[,3]+a[,6]>2),FALSE,TRUE),]
namWA<-matrix(0,ncol=1,nrow=length(a[,1]))
namWS<-matrix(0,ncol=1,nrow=length(a[,1]))
Arimafit<-matrix(0,ncol=length(N),nrow=length(a[,1]),byrow=TRUE)
tota<-matrix(0,ncol=1,nrow=length(a[,1]))
totb<-matrix(0,ncol=1,nrow=length(a[,1]))
arimaerror<-matrix(0,ncol=length(N),nrow=1)
for(i in 1:length(a[,1])){
namWA[i]<-paste("orderWA",i,sep=".")
assign(namWA[i],a[i,c(1:3)])
namWS[i]<-paste("orderWS",i,sep=".")
assign(namWS[i],a[i,c(4:6)])
ArimaW1 <- try(Arima(N, order= a[i,c(1:3)], seasonal=list(order=a[i,c(4:6)]),method="ML"))
if(is(ArimaW1,"try-error"))
ArimaW1<-arimaerror else
ArimaW1<-ArimaW1
arimafitted<-try(fitted(ArimaW1))
if(is(arimafitted,"try-error"))
fitarima<-arimaerror else
fitarima<-arimafitted
if(aslog=="y"){Arimafit[i,]<-c(exp(fitarima))}else{Arimafit[i,]<-c(fitarima)}
nnn<-c(N)
arimab<-c(Arimafit[i,])
fullres<-nnn-arimab
v<-acf(fullres,plot=FALSE)
w<-pacf(fullres,plot=FALSE)
if(v$acf[2]>0.4|v$acf[2]<(-0.4)|v$acf[3]>0.4|v$acf[3]<(-0.4)|v$acf[4]>0.4|v$acf[4]<(-0.4)|v$acf[5]>0.4|v$acf[5]<(-0.4)|v$acf[6]>0.4|v$acf[6]<(-0.4)|v$acf[7]>0.4|v$acf[7]<(-0.4)|w$acf[1]>0.4|w$acf[1]<(-0.4)|w$acf[2]>0.4|w$acf[2]<(-0.4)|w$acf[3]>0.4|w$acf[3]<(-0.4)|w$acf[4]>0.4|w$acf[4]<(-0.4)|w$acf[5]>0.4|w$acf[5]<(-0.4)|w$acf[6]>0.4|w$acf[6]<(-0.4))
tota[i]<-"n" else{
tota[i]<-sum(abs(v$acf[2:7]))
totb[i]<-sum(abs(w$acf[1:6]))}
}
Here is a further adaption to what i wanted to achieve
a <- permutations(n = 3, r = 6, v = c(0:2), repeats.allowed = TRUE)
a <- a[ifelse((a[, 1] + a[, 4] > 2 | a[, 2] + a[, 5] > 2 | a[, 3] + a[, 6] > 2),
FALSE, TRUE), ]
Arimafit <- matrix(0,
ncol = length(Data.new),
nrow = length(a[, 1]),
byrow = TRUE)
totb <- matrix(0, ncol = 1, nrow = length(a[, 1]))
arimaerror <- matrix(0, ncol = length(Data.new), nrow = 1)
for (i in 1:length(a[, 1])){
ArimaData.new <- try(Arima(Data.new,
order = a[i, c(1:3)],
seasonal = list(order = a[i, c(4:6)]),
method = "ML"),
silent = TRUE)
if (is(ArimaData.new, "try-error")){
ArimaData.new <- arimaerror
} else {
ArimaData.new <- ArimaData.new
}
arimafitted <- try(fitted(ArimaData.new), silent = TRUE)
if (is(arimafitted, "try-error")){
fitarima <- arimaerror
} else {
fitarima <- arimafitted
}
if (as.log == "log"){
Arimafit[i, ] <- c(exp(fitarima))
Datanew <- c(exp(Data.new))
} else {
if (as.log == "sqrt"){
Arimafit[i, ] <- c((fitarima)^2)
Datanew <- c((Data.new)^2)
} else {
Arimafit[i, ] <- c(fitarima)
Datanew <- c(Data.new)
}
}
data <- c(Datanew)
arima.fits <- c(Arimafit[i, ])
fullres <- data - arima.fits
v <- acf(fullres, plot = FALSE)
w <- pacf(fullres, plot = FALSE)
if (v$acf[2]>0.4|v$acf[2]<(-0.4)|v$acf[3]>0.4|v$acf[3]<(-0.4)|v$acf[4]>0.4|v$acf[4]<(-0.4)|v$acf[5]>0.4|v$acf[5]<(-0.4)|v$acf[6]>0.4|v$acf[6]<(-0.4)|v$acf[7]>0.4|v$acf[7]<(-0.4)|w$acf[1]>0.4|w$acf[1]<(-0.4)|w$acf[2]>0.4|w$acf[2]<(-0.4)|w$acf[3]>0.4|w$acf[3]<(-0.4)|w$acf[4]>0.4|w$acf[4]<(-0.4)|w$acf[5]>0.4|w$acf[5]<(-0.4)|w$acf[6]>0.4|w$acf[6]<(-0.4)){
totb[i] <- "n"
} else {
totb[i] <- sum(abs(w$acf[1:4]))
}
j <- match(min(totb), totb)
order.arima <- a[j, c(1:3)]
order.seasonal.arima <- a[j, c(4:6)]
}