R: Simplex error: NAs are not allowed in subscripted assignments - r

For the following minimization with objective function and constraints, boot.simplex returns an error:
Error in tab[-pr, ] <- tab[-pr, ] - (tab[-pr, pc]/pv) %o% tab[pr, ] :
NAs are not allowed in subscripted assignments
The code is here:
library(boot)
a = c(1, 1, 1)
A2 = rbind(c(2, 7.5, 3), c(20, 5, 10))
b2 = c(10000, 30000)
simplex(a=a, A2=A2, b2=b2, maxi=FALSE)
Note that the constraints are only of the greater-than-equal-to type.
But, if a bogus less-than-or-equal-to constraint is added as shown below, a valid result is returned.
A1 = c(1, 0, 0)
b1 = 1000000
simplex(a=a, A1=A1, b1=b1, A2=A2, b2=b2, maxi=FALSE)
The optimal solution to the second attempt is below
Optimal solution has the following values
x1 x2 x3
1250 1000 0
The optimal value of the objective function is 2250.
Why is there an error with the first attempt? Is it not allowed to only use >= type of constraints? What is a good way to approach this problem?

I changed the value of the default eps, and it works for me.
The default is eps=1e-10, try to increase it.
simplex(a=a, A2=A2, b2=b2, maxi=FALSE, eps=1e-6)

Related

Error delay differential equation deSolve (dede)

I am writing a delay differential equation in deSolve (R), and I am getting an error message I am unsure how to solve.
So for some background. I have a system with 12 differential equations, and 3 of those have a delay. I was successful in writing the system without deSolve, but I want to use deSolve because it gives me opportunity to easily work with other methods that are not a fixed-step euler.
However, now I put it in deSolve, and I am using the general solver for delay differential equations (dede), I get an error.
This is the delay and the differential equation that the error is about:
lag2=ifelse(t-tau2<0, 0, e2(lagvalue(t-tau2,3))*lagvalue(t-tau2,8))
dn9dt=lag2-IP2*ethaP2M*P2-mu2*sf0B(B2)*P2-DNB(N2,B2)*P2+DD*PD
The first and third delay differential equations are done the same as this one and don't seem to have an error. The error is:
Error in lagvalue(t - tau2, 3) : illegal input in lagvalue - lag, 0, too large, at time = 15.945
Important to note is that the delay (tau2) is 16 in this case, and the error occurs sligtly before time = 16.
I have already tried to change t-tau2<0 to t-tau2<=0, but this doesn't help, and I have tried to increase the size of the history array (control=list(mxhist = 1e6)), which also didn't help. I have also tried to rewrite the lag a couple of times, but everytime I get the same error.
I have tried searching online, but I can hardly find anything on dede in deSolve, so I hope someone here might be able to help.
The question did not contain a full reproducible example, but the error can be reproduced if a simulation is run with a large number of time steps and the history array is too small. The following example is an adapted version from the ?dede help page:
library("deSolve")
derivs <- function(t, y, parms) {
#cat(t, "\n") # uncomment this to see when the error occurs
lag1 <- ifelse(t - tau1 < 0, 0.1, lagvalue(t - tau1, 2))
lag2 <- ifelse(t - tau2 < 0, 0.1, lagvalue(t - tau2, 2))
dy1 <- -y[1] * lag1 + lag2
dy2 <- y[1] * lag1 - y[2]
dy3 <- y[2] - lag2
list(c(dy1, dy2, dy3))
}
yinit <- c(x=5, y=0.1, z=1)
times <- seq(0, 40, by = 0.1)
tau1 <- 1
tau2 <- 10
It runs successfuly with:
yout <- dede(y = yinit, times = times, func = derivs, parms = NULL)
but if we increase the number of time steps:
times <- seq(0, 40, by = 1e-3)
yout <- dede(y = yinit, times = times, func = derivs, parms = NULL)
we can get an error:
Error in lagvalue(t - tau2, 2) :
illegal input in lagvalue - lag, 0, too large, at time = 9.99986
It occurs after exceeding the threshold time (uncomment the cat above) when the algorithm starts to interpolate in the history array. As a solution, increase the history buffer:
yout <- dede(y = yinit, times = times, func = derivs,
parms = NULL, control = list(mxhist = 1e5))
It may also help to reduce the number of time steps.

Specify seasonal ARIMA

I am having some forecast::Arima-syntax issues. If I know that a seasonal ARIMA is statistically ok because it is the result of auto.arima, how can I fix the following Arima-function to have the same order as the auto.arima result:
library(forecast)
set.seed(1)
y <- sin((1:40)) * 10 + 20 + rnorm(40, 0, 2)
my_ts <- ts(y, start = c(2000, 1), freq = 12)
fit_auto <- auto.arima(my_ts, max.order = 2)
plot(forecast(fit_auto, h = 24))
# Arima(0,0,1)(1,0,0) with non-zero mean
fit_arima <- Arima(my_ts,
order = c(0, 0, 1),
seasonal = list(c(1, 0, 0)))
#Error in if ((order[2] + seasonal$order[2]) > 1 & include.drift) { :
# argument is of length zero
Thx & kind regards
The argument to seasonal must be either a numeric vector giving the seasonal order, or a list with two named elements: order, the numeric vector giving the seasonal order, and period, an integer giving the seasonal periodicity.
You gave a list with only the seasonal order, so Arima is complaining it couldn't find the period value. If you give a numeric vector, period will default to frequency(my_ts) like it says in the function's documentation. While it does make sense that giving just the order as a numeric or as a list should have the same result, it doesn't. Just a quirk of this function.
A rewrite of your call that works:
fit_arima <- Arima(my_ts,
order = c(0, 0, 1),
seasonal = c(1, 0, 0)) # vector, not a list

Some "train" columns aren't present in "test"

everyone.
I have a problem. I have to realize a kNN classification on R using LOO. I've found packages "knncat" and "loo" for this. And I've written the code(without LOO):
library(knncat)
x <- c(1, 2, 3, 4)
y <- c(5, 6, 7, 8)
train <- data.frame(x, y)
x1 <- c(9, 10, 11, 12)
y1 <- c(13, 14, 15, 16)
test <- data.frame(x1, y1)
answer <- knncat(train, test, classcol = 2)
And I've got an error "Some "train" columns aren't present in "test"". I don't understand, what am I doing wrong? How can I fix this error?
If something's wrong with my English, sorry, I'm from Russia:)
Well, there are some problems with your approach and knncat:
You have to specify class labels for the train and test data sets and set classcol accordingly.
Only class labels which appear in train must be present in test.
The columns names of train and test must be the same, or knncat will throw the error you've mentioned: "Some "train" columns aren't present in "test".
Moreover if you are using integer values as class labels, they have to start from zero or knncat will throw an error: "Number in class 0 is 0! Abort!".
Here is an working example:
train <- data.frame(x1=1:4, x2=5:8, y=c(0, 0, 1, 1))
test <- data.frame(x1=9:12, x2=13:16, y=c(1, 0, 0, 1))
knncat(train, test, classcol = 3)
With the result:
Test set misclass rate: 50%

Non-finite function value with integrate() R although solution exists

I would like to calculate the following integral in R:
print(integrate(function(x){((1.-x)^2)/(abs(1.-x))^(1/3)},lower = 0, upper = 1.6, abs.tol = 1E-7)$value)
And I get this error:
Error in integrate(function(x) { : non-finite function value
However, when I integrate up to 1.600001 or 1.599999, it works and yields 0.4710365 and 0.4710357.
But there is nothing special with this function at the point 1.6... So it should be some strange numerical problem in R.
Any ideas?
In line with #Bhas's answer, I would go for the following solution:
> f <- function(x){ifelse(x!=1,((1.-x)^2)/(abs(1.-x))^(1/3),0)} # Set f(1)=0 since it is the limit of 'f' at 1.
> integrate(f,lower=0,upper=1.6,abs.tol=1E-7)
0.4710361 with absolute error < 2.2e-08
'ifelse' avoids problems related to a vectorized 'x'
If you write your function like this
f <- function(x) {
r <- ((1.-x)^2)/(abs(1.-x))^(1/3)
cat("x=",x,"\n")
cat("r=",r,"\n")
r
}
you can get some idea of what's happening.
Try this
z <- integrate(f,lower = 0, upper = 1.6, abs.tol = 1E-7,subdivisions=50)
z
And you will see that integrate passes a value of 1 to functionf.
And dividing by 0 (from 1-x)) gives a NaN. This seems to be an artifact of integrate.
With the limits you specified you are jumping over a point where the function is undefined.
You can avoid that by doing
z1 <- integrate(f,lower = 0, upper = 1, abs.tol = 1E-7)
z1
z2 <- integrate(f,lower = 1, upper = 1.6, abs.tol = 1E-7)
z2
z1$value+z2$value
which gives a result of
[1] 0.4710361
I wouldn't know how to get around this other than by what you did or what I tried.

Maximum likelihood in R

I am new both to R and statistics. I am playing with maximum likelihood estimation, and I am getting some incorrect results. I want to model x with a simple linear function:
x<-apply(matrix(seq(1,10,1), nrow=1), 1, function(x) 10*x+runif(10,-3,3))
LL<-function(a,b){
R=apply(x,1,function(y) a*y+b)
-sum(log(R))
}
mle(LL, start=list(a=10, b=0))
I am getting the following result:
Coefficients:
a b
43571.957 1338.345
instead of a~10, b~0.
I modified the code according to the suggestions of Spacedman:
set.seed(99)
x<-apply(matrix(seq(1,10,1), nrow=1), 1, function(x) 10*x+runif(10,-3,3))
LL<-function(a,b){
R = x[,1] - a*(1:10) + b
-sum(R^2)
}
library(stats4)
mle(LL, start=list(a=11, b=0.3))
Error in solve.default(oout$hessian) :
Lapack routine dgesv: system is exactly singular: U[1,1] = 0
I do not know how to get rid of this error. Changing the sees and generating the x values again does not help.
There are a couple of things to notice here. To clarify we start by changing the distribution of the error-term from a uniform distribution runif(x, -3, 3) to the std. normal distribution: rnorm(x). We can now easily simulate your data, then set up your (minus) loglikelihood and maximize (minizime) by:
a <- 10
b <- 0
set.seed(99)
x <- apply(matrix(seq(1, 10, 1), nrow=1), 1, function(x) b + a * x + rnorm(10))
minuslogL <- function(a, b) -sum(dnorm(x[, 1] - (b + a * 1:10), log = TRUE))
library(stats4)
mle(minuslogL, start = list(a = 11, b = 0.3))
Call:
mle(minuslogl = minuslogL, start = list(a = 11, b = 0.3))
Coefficients:
a b
9.8732793 0.5922192
Notice that this works well, since the likelihood is smooth and mle() uses "BFGS" for the optimization, eg. a quasi-Newton, gradient approach. Lets try the same with uniform errors:
set.seed(99)
x <- apply(matrix(seq(1, 10, 1), nrow=1), 1, function(x) b + a * x + runif(10, -3, 3))
minuslogL2 <- function(a,b) -sum(dunif(x[, 1] -(a * 1:10 + b), -3, 3, log = TRUE))
mle(minuslogL2, start = list(a = 11, b = 0.3))
Error in optim(start, f, method = method, hessian = TRUE, ...) :
initial value in 'vmmin' is not finite
This fails! Why? Since the uniform-errors restrict the parameter space, you will not get a smooth likelihood. If you move your parameters a,b too far away from the true values, you will get Inf. If you move close enough, you will get the same likelihood (eg. many possible min. values):
> minuslogL2(11, 0.3)
[1] Inf
> minuslogL2(10, 0)
[1] 17.91759
> minuslogL2(10.02, 0.06)
[1] 17.91759
Maximizing this likelihood compares to finding the set: {a,b}: -logL(a, b) == -logL(10, 0), which can be found by a plain search algorithm.

Resources