I'm trying to fit a nonlinear curve to three data points. Later on, I'll need to integrate this snippet into a larger software that would try fitting the curve to these three points automatically. As it can be seen below, I'm trying to estimate the curve in the form a*x^power1 + b*x^power2. I know that the following function satisfies the condition 0.666*x^(-0.18) - 0.016*x^0.36. However, I am, for some reason, not able at all to reproduce it using nlsLM() from minpack.lm. No matter what combination I try to add at the start parameter, I end up with the same warning message of Warning message: In nls.lm(par = start, fn = FCT, jac = jac, control = control, lower = lower, : lmdif: info = 0. Improper input parameters.
And even though it is "only" a warning message, it seems to entirely mess up my code. Due to the improper input parameters, my variable m which I pass the results to, gets corrupted and nothing works afterwards that include the variable m.
Here is the reproducible example:
library(ggplot2)
library(minpack.lm)
dataset <- read.table(text='
x y
1 0.1 1
2 30 0.3
3 1000 0', header=T)
ds <- data.frame(dataset)
str(ds)
plot(ds, main = "bla")
nlmInitial <- c(a = 0.5, power1 = -0.2, b = -0.02, power2 = 0.3)
m <- nlsLM(y ~ a*I(x^power1) + b*I(x^power2),
data = ds,
start = nlmInitial,
trace = T)
summary(m)$coefficients
You want to estimate to many coefficients with too less observations. You say that 0.666*x^(-0.18) - 0.016*x^0.36 will be a solution. R comes to:
m <- nlsLM(y ~ 0.666*I(x^power1) + b*I(x^power2), data = ds, trace = T
, start = c(power1 = -0.2, b = -0.02, power2 = 0.3))
0.666*x^(-0.18053) - 0.01975*x^0.32879. But also
m <- nlsLM(y ~ 0.7*I(x^power1) + b*I(x^power2), data = ds, trace = T
, start = c(power1 = -0.2, b = -0.02, power2 = 0.3))
0.7*x^(-0.16599) - 0.04428*x^0.23363 will be a solution.
So you either have to increase the number of observations or reduce the number of coefficients to estimate.
Related
I am trying to use exact=TRUE feature in glmnet. But I am getting an error message.
> fit = glmnet(as.matrix(((x_values))), (as.matrix(y_values)),penalty=variable.list$penalty)
> coef.exact = coef(fit, s = 0.03, exact = TRUE)
Error: used coef.glmnet() or predict.glmnet() with `exact=TRUE` so must in addition supply original argument(s) x and y and penalty.factor in order to safely rerun glmnet
How can I supply penalty.factor to coef.exact?
Options tried:-
> coef.exact = coef(as.matrix(((x_values))), (as.matrix(y_values)),penalty=variable.list$penalty, s = 0.03, exact = TRUE)
Error: $ operator is invalid for atomic vectors
>
> coef.exact = coef((as.matrix(((x_values))), (as.matrix(y_values)),penalty=variable.list$penalty), s = 0.03, exact = TRUE)
Error: unexpected ',' in "coef.exact = coef((as.matrix(((x_values))),"
>
> coef.exact = coef((as.matrix(((x_values))) (as.matrix(y_values)) penalty=variable.list$penalty), s = 0.03, exact = TRUE)
Error: unexpected symbol in "coef.exact = coef((as.matrix(((x_values))) (as.matrix(y_values)) penalty"
>
> coef.exact = coef(fit(as.matrix(((x_values))), (as.matrix(y_values)),penalty=variable.list$penalty), s = 0.03, exact = TRUE)
Error in fit(as.matrix(((x_values))), (as.matrix(y_values)), penalty = variable.list$penalty) :
could not find function "fit"
>
> coef.exact = coef(glmnet(as.matrix(((x_values))), (as.matrix(y_values)),penalty=variable.list$penalty), s = 0.03, exact = TRUE)
Error: used coef.glmnet() or predict.glmnet() with `exact=TRUE` so must in addition supply original argument(s) x and y and penalty.factor in order to safely rerun glmnet
>
Here is an example using mtcars as sample data. Note it's always advisable to provide a minimal & reproducible code example including sample data when posting on SO.
# Fit mpg ~ wt + disp
x <- as.matrix(mtcars[c("wt", "disp")]);
y <- mtcars[, "mpg"];
fit <- glmnet(x, y, penalty = 0.1);
# s is our regularisation parameter, and since we want exact results
# for s=0.035, we need to refit the model using the full data (x,y)
coef.exact <- coef(fit, s = 0.035, exact = TRUE, x = x, y = y, penalty.factor = 0.1);
coef.exact;
#3 x 1 sparse Matrix of class "dgCMatrix"
# 1
#(Intercept) 34.40289989
#wt -3.00225110
#disp -0.02016836
The reason why you explicitly need to provide x and y again is given in ?coef.glmnet (also see #FelipeAlvarenga post).
So in your case, the following should work:
fit = glmnet(x = as.matrix(x_values), y = y_values, penalty=variable.list$penalty)
coef.exact = coef(
fit,
s = 0.03,
exact = TRUE,
x = as.matrix(x_values),
y = y_values,
penalty.factor = variable.list$penalty)
Some comments
Perhaps the confusion arises from the difference between the model's overall regularisaton parameter (s or lambda) and the penalty.factors that you can apply to every coefficient. The latter allows for differential regularisation of individual parameters, whereas s controls the effect of overall L1/L2 regularisation.
In coef the parameter s corresponds to the penalty parameter. In the help files:
s Value(s) of the penalty parameter lambda at which predictions are
required. Default is the entire sequence used to create the model.
[...]
With exact=TRUE, these different values of s are merged (and sorted)
with object$lambda, and the model is refit before predictions are
made. In this case, it is required to supply the original data x= and
y= as additional named arguments to predict() or coef(). The workhorse
predict.glmnet() needs to update the model, and so needs the data used
to create it. The same is true of weights, offset, penalty.factor,
lower.limits, upper.limits if these were used in the original call.
Failure to do so will result in an error.
Therefore, to use exact = T you must assign your original penalties, x, y and any other parameter you inputted in your original model
I'm trying to fit an ODE model to some data and solve for the values of the parameters in the model.
I know there is a package called FME in R which is designed to solve this kind of problem. However, when I tried to write the code like the manual of this package, the program could not run with the following traceback information:
Error in lsoda(y, times, func, parms, ...) : illegal input detected before taking any integration steps - see written message
The code is the following:
x <- c(0.1257,0.2586,0.5091,0.7826,1.311,1.8636,2.7898,3.8773)
y <- c(11.3573,13.0092,15.1907,17.6093,19.7197,22.4207,24.3998,26.2158)
time <- 0:7
# Initial Values of the Parameters
parms <- c(r = 4, b11 = 1, b12 = 0.2, a111 = 0.5, a112 = 0.1, a122 = 0.1)
# Definition of the Derivative Functions
# Parameters in pars; Initial Values in y
derivs <- function(time, y, pars){
with(as.list(c(pars, y)),{
dx <- r + b11*x + b12*y - a111*x^2 - a122*y^2 - a112*x*y
dy <- r + b12*x + b11*y - a122*x^2 - a111*y^2 - a112*x*y
list(c(dx,dy))
})
}
initial <- c(x = x[1], y = y[1])
data <- data.frame(time = time, x = x, y = y)
# Cost Computation, the Object Function to be Minimized
model_cost <- function(pars){
out <- ode(y = initial, time = time, func = derivs, parms = pars)
cost <- modCost(model = out, obs = data, x = "time")
return(cost)
}
# Model Fitting
model_fit <- modFit(f = model_cost, p = parms, lower = c(-Inf,rep(0,5)))
Is there anyone that knows how to use the FME package and fix the problem?
Your code-syntax is right and it works until the last line.
you can check your code with
model_cost(parms)
This works fine and you can see with
model_cost(parms)$model
that your "initial guess" is far away from the observed data (compare "obs" and "mod"). Perhaps here is a failure so that the fitting procedure will not reach the observed data.
So much for the while ... I also checked different methods with parameter "methods = ..." but still does not work.
Best wishes,
Johannes
edit: If you use:
model_fit <- modFit(f = model_cost, p = parms)
without any lower bounds, then you will get an result (even there are warnings), but then a112 is negative what you wanted to omit.
I am trying to fit a non-linear model, but can not find any good examples
online.
Does this function have a name?
Can it be linearized?
I've attempted to estimate the parameters a, b, and c with a random effect g (as in group) as a function of time t, below. I can fit the model using nls without a random effect, but am having trouble getting the model to converge. Suggestions welcome (preferably within R, but any suitable package will do)?
## time, repeated 16 times for 4 replicates from each of 4 groups
t <- rep(1:20, 16)
## g, group
g <- rep(1:4, each = 80)
## starting to create an example dataset,
## to see if I can recover known parameters
a <- rep(c(3.5, 4, 4.1, 5), each = 80)
b <- rep(c(1.1, 1.4, 1.8, 2.5), each = 80)
c <- rep(c(0.125, 0.25), each = 160)
## error to add to above parameters
set.seed(1)
e_a <- runif(320, -0.5, 0.5)
e_b <- runif(320, -0.1, -0.1)
e_c <- runif(320, -0.02, 0.02)
## this is my function
f <- function(t, a, b, c) a * (t^b) * exp(-c * t)
## simulate y
y <- f(t = t, a + e_a, b + e_b, c + e_c)
mydata <- data.frame(t = t, y = y, g = g)
library(nlme)
## now fit the model to estimate a, b, c
fm1 <- nlme(y ~ a * (t^b) * exp(-c * t),
data = mydata,
fixed = a + b + c~1,
random = a + b + c ~ 1|g,
start = c(a = 4, b = 1, c = 0.25),
method = "REML")
In physics (and some other areas) I've seen this or variants of it called a Hoerl curve or Hoerl function e.g. here, though it has other names. If c is negative and a and b are positive it's a scaled gamma density.
When you ask about linearizing it, you have to be careful; the equation y = at^b . exp(ct) is not actually what you mean - the observations, y(i), are not exactly equal to a . t(i)^b . exp(ct(i)) (otherwise almost any 3 observations would give you the exact parameter values).
So the noise has to enter your model for y somehow. Is it additive? multiplicative, or something else? (Also important, but for other reasons: does its size change in some way as t changes, or not? Are the noise terms for different observations independent?)
If your actual model is y(i) = at(i)^b . exp(ct(i))+ε(i), that's not linearizable.
If your actual model is y(i) = at(i)^b . exp(ct(i)) . ε(i), and ε(i)=exp(η(i)) for some (hopefully zero-mean) η(i), that is linearizable.
Taking the second form,
log(y(i)) = log(a) + b log(t(i)) + c t(i) + log(ε(i))
or
y*(i) = a* + b.log(t(i)) + c.t(i) + η(i)
which is linear in the parameters a* = log(a), b and c, and the error term η(i); so if you're prepared to make that sort of an assumption about the error you should be able to fit it with methods suitable for such linear models; you may wish in that case to ponder the parenthetical questions about the error term above which may affect how you model it.
I appreciate any help to make segmented.lm (or any other function) find the obvious breakpoints in this example:
data = list(x=c(50,60,70,80,90) , y= c(703.786,705.857,708.153,711.056,709.257))
plot(data, type='b')
require(segmented)
model.lm = segmented(lm(y~x,data = data),seg.Z = ~x, psi = NA)
It returns with the following error:
Error in solve.default(crossprod(x1), crossprod(x1, y1)) :
system is computationally singular: reciprocal condition number = 1.51417e-20
If I change K:
model.lm = segmented(lm(y~x,data = data),seg.Z = ~x, psi = NA, control = seg.control(K=1))
I get another error:
Error in segmented.lm(lm(y ~ x, data = data), seg.Z = ~x, psi = NA, control = seg.control(K = 1)) :
only 1 datum in an interval: breakpoint(s) at the boundary or too close each other
A nice objective method to determine the break point is described in Crawley (2007: 427).
First, define a vector breaks for a range of potential break points:
breaks <- data$x[data$x >= 70 & data$x <= 90]
Then run a for loop for piecewise regressions for all potential break points and yank out the minimal residual standard error (mse) for each model from the summary output:
mse <- numeric(length(breaks))
for(i in 1:length(breaks)){
piecewise <- lm(data$y ~ data$y*(data$x < breaks[i]) + data$y*(data$x >= breaks[i]))
mse[i] <- summary(piecewise)[6]
}
mse <- as.numeric(mse)
Finally, identify the break point with the least mse:
breaks[which(mse==min(mse))]
Hope this helps.
I'm trying to perform a CV on my linear model, which has seasonal dummy variables, so i can't take a random sample.
y = rnorm(120,0,3) + 20*sin(2*pi*(1:120)/12)
x = months(ISOdate(2012,1:12,1))
reg.data = data.frame(y, x)
model = lm(y ~ x, data = reg.data)
My CV function is:
cross.valid = function(model, min.fit = as.integer(nrow(model$model)*0.7), h = 1)
{
dados = model$model
n.rows = nrow(dados)
results = data.frame(pred = numeric(), actual = numeric())
for (i in seq(1, n.rows - min.fit - h + 1, by = h))
{
dados.train = dados[1:(i + min.fit - 1), ]
model <- update(model, data = dados.train)
dados.pred = dados[(i + min.fit):(i + min.fit + h - 1), -1, drop = FALSE]
predic = predict(model, newdata = dados.pred, interval = 'prediction')
actual = dados[(i + min.fit):(i + min.fit + h - 1), 1]
results = rbind(results, data.frame(pred = predic[1:h, 'fit'], actual = actual))
}
results
}
Example:
cv1 = cross.valid(model, h = 1)
mae = with(cv1, mean(abs(actual - pred )))
print(mae)
The MAE values for different horizons (h) are too close. Is the code itself valid? Is there a better solution/package for doing this?
Thanks!
I don't think there is anything incorrect about your function. Investigate the forecast package; I suspect that it will provide many functions that you need.
I have rewritten your function concisely:
set.seed(1)
y = rnorm(120,0,3) + 20*sin(2*pi*(1:120)/12)
x = months(ISOdate(2012,1:12,1))
reg.data = data.frame(y, x)
pred.set<-function(i,h) {
train<-reg.data[1:(i + min.fit - 1),]
test<-reg.data[(i + min.fit):(i + min.fit + h - 1),]
pred<-predict(lm(y~x, data=train), newdata=test)
abs(test$y - pred)
}
pred.by.horiz<-function(h)
mean(sapply(seq(1, nrows - min.fit - h + 1, by = h),pred.set,h=h))
pred.by.horiz matches the output of your function (and post-processing) exactly.
As you mentioned, the horizon does not appear to affect the MAE:
mae.by.h<-sapply(seq(nrows-min.fit),pred.by.horiz)
plot(mae.by.h,type='l',col='red',lwd=2,xlab='Horizon',ylab='Mean absolute error')
Perhaps you expected the the mean error would increase as the prediction horizon increases. For many time-series models this would be true, but in your linear model of months adding more data doesn't help you predict the next point in the series (unless you add 12 months or more).
For example, consider what happens when h is 1. You begin with 84 months of data, 7 points of data for each month. Now, you add one point of data, which will be the next January, and attempt to predict the result of February. But your additional point of data will only help you predict the next January, that is how your linear function works. Look at the summary of the model:
lm(y ~ x, data = reg.data)
Coefficients:
(Intercept) xAugust xDecember xFebruary xJanuary
17.11380 -32.74962 -17.81076 -0.03235 -6.63998
xJuly xJune xMarch xMay xNovember
-26.69203 -17.41170 2.96735 -7.11166 -25.43532
xOctober xSeptember
-33.56517 -36.93474
Each prediction is made solely on the basis of two variables, the intercept, and the predicted month. So predicting one point ahead isn't any easier than predicting five points ahead. That is why the MAE isn't rising as the horizon increases the problem is in the way you modeled the data, not the MAE function.
One thing I didn't completely understand about your function is why you decided to increment the size of the train set by h on each iteration. It is revealing to look at what happens when you try to increment by 1:
# Code to increment by 1
pred.by.horiz2<-
function(h) mean(sapply(seq(1, nrows - min.fit - h + 1, by = 1),pred.set,h=h))
mae.by.h2<-sapply(seq(nrows-min.fit),pred.by.horiz2)
plot(mae.by.h2,type='l',col='red',lwd=2,xlab='Horizon',ylab='Mean absolute error')
The pattern here is complex, but you'll note that the MAE starts to decrease at 12, when the horizon is large enough that the next point can be used.