I have some difficulties getting a specific curve to fit data to an nls model.
This is the formula for the data:
((b1 * ((b2 * x)^b4)) / (1 + ((b2 * x)^b4)))^(b3 / b4)
I use nls2 package with a random algorithm to find the inital values.
library(nls2)
#FORMULA
eq <- y ~ (b1 * ((b2 * x)^b4)) / (1 + ((b2 * x)^b4))^(b3 / b4)
#LIMITS
values <- data.frame(
b1 = c(60, 63)
b2 = c(0, 0.05)
b3 = c(0, 1)
b4 = c(0, 0.9)
fit <- nls2(eq,
data = .data,
start = values,
algorithm = "random",
control = mls.control(maxiter = 1000))
nls(eq, .data, start = coef(fit), alg = "port", lower = 0)
plot(.data)
The values should be:
b1 = 62.2060
b2 = 0.0438
b3 = 0.9692
b4 = 0.8693
However, when I try to run the codes, I always ended on an error message: Convergence Failure: Iteration limit reached without convergence (10)
How can I avoid the convergence failure error? Any help is highly appreciated. Thank You.
0. TLDR
You did not set the lower and upper bound in nls, so you didn't get a converging result. If you set them your will get a result near the boundary. See the code I wrote in the last paragraph.
Actually, even if you set the boundary, due to the bad data quality(sample size is small and do not consist with you formula), it's hard to fit a optimal value near your true b1,'b2','b3' and b4. See nontechnical reason.
1. Nontechnical reason of convergence failure
I think your code is right, and this convergence fail is due to your data quality or your misspecification of formula.
In general, it's hard for you to estimate 4 parameters with only 6 point. If you have good data which actully fits your model well, nlm will converge. In your case, either your data is wrong or you formula specification bias is huge.
I draw a plot to show your that:
Code
# generate a line using true parameters:b1,b2,b3,b4
b1 = 62.2060
b2 = 0.0438
b3 = 0.9692
b4 = 0.8693
x_points = seq(50,420,length.out = 200)
y_points = (b1 * ((b2 * x_points)^b4)) / (1 + ((b2 * x_points)^b4))^(b3 / b4)
# plot the function
plot(x = x_points ,y = y_points, type ='l',col ='black',lwd = 5,
xlim = c(min(yourdata$x)-5,max(yourdata$x)+5),
ylim = c(min(yourdata$y)-5,max(yourdata$y)+5))
# plot the data your got
points(yourdata$x,yourdata$y,cex = 2)
Output:
If we generate a data from your formula, we can fit them quite easily, like this:
## generate data
b1 = 62.2060
b2 = 0.0438
b3 = 0.9692
b4 = 0.8693
x <- runif(6,60,450)
y <- (b1 * ((b2 * x)^b4)) / (1 + ((b2 * x)^b4))^(b3 / b4)
data <- data.frame(x,y)
yourdata <- data.frame(x = c(409.56, 195.25, 60.53, 359.56, 188.79, 67.12),
y = c(39.76100, 20.11875, 7.23675, 41.01100, 20.28035, 7.07200))
#FORMULA
eq <- y ~ (b1 * ((b2 * x)^b4)) / (1 + ((b2 * x)^b4))^(b3 / b4)
#LIMITS
values <- data.frame(
b1 = c(60, 63),
b2 = c(0, 0.05),
b3 = c(0, 1),
b4 = c(0, 0.9))
fit <- nls2(eq,
data = data,
start = values,
algorithm = "random",
control = nls.control(maxiter = 1000))
nls(eq, data, start = coef(fit), alg = "port",
control = nls.control(maxiter = 1000,tol = 1e-05),
low = c(60,0,0,0),upper =c(63,0.05,1,0.9) ,trace = TRUE)
plot(x,y)
Output:
Nonlinear regression model
model: y ~ (b1 * ((b2 * x)^b4))/(1 + ((b2 * x)^b4))^(b3/b4)
data: data
b1 b2 b3 b4
62.2060 0.0438 0.9692 0.8693
residual sum-of-squares: 3.616e-24
Algorithm "port", convergence message: absolute function convergence (6)
Alse note that, in the above, I generate only6 numbers to fit the model. If you generate more data, for instance 60, you will have a better convergency!
2.Technical reason
After reading the PORT docs, I think that this error can mean
gradient is calculated incorrectly
stopping tolerances are too tight
gradient is discontinous near some iterate
And all these may have a relationship with you data and training task(your boundary and formula).
Try code below and you will get a better result:
Code:
yourdata <- data.frame(x = c(409.56, 195.25, 60.53, 359.56, 188.79, 67.12),
y = c(39.76100, 20.11875, 7.23675, 41.01100, 20.28035, 7.07200))
#FORMULA
eq <- y ~ (b1 * ((b2 * x)^b4)) / (1 + ((b2 * x)^b4))^(b3 / b4)
#LIMITS
values <- data.frame(
b1 = c(60, 63),
b2 = c(0, 0.05),
b3 = c(0, 1),
b4 = c(0, 0.9))
fit <- nls2(eq,
data = yourdata,
start = values,
algorithm = "random",
control = nls.control(maxiter = 1000))
nls(eq, yourdata, start = coef(fit), alg = "port",
control = nls.control(maxiter = 1000,tol = 1e-05),
low = c(60,0,0,0),upper =c(63,0.05,1,0.9) ,trace = TRUE)
plot(x,y)
Outputs:
Nonlinear regression model
model: y ~ (b1 * ((b2 * x)^b4))/(1 + ((b2 * x)^b4))^(b3/b4)
data: yourdata
b1 b2 b3 b4
63.00000 0.00155 0.00000 0.90000
residual sum-of-squares: 22.28
Algorithm "port", convergence message: both X-convergence and relative convergence (5)
As we can see, it converges to the boundary, which means that your data is unconsitant with your settings(formula or boundary).
Related
I am new to R and I'm working on a project, where we have to do some experiments with generating linear regression models.
Here is my code:
# regression coefficients
beta1 = 1
beta2 = 0
beta3 = 5
beta4 = 1
beta5 = 1
# generated data
df <- data.frame(y1 = rnorm(n, mean = 50, sd = 1),
sprem1 = rnorm(n, mean = 0, sd = 1),
sprem2 = rnorm(n, mean = 10, sd = 2),
sprem3 = rnorm(n, mean = 10, sd = 2),
sprem4 = rnorm(n, mean = 20, sd = 2),
sprem5 = rnorm(n, mean = 20, sd = 1))
fit.lm <- lm(formula = y1 ~ beta1 * sprem1 + beta2 * sprem2 + beta3 * sprem3 + beta4 * sprem4 + beta5 * sprem5, data = df)
But I get an error:
Error in model.frame.default(formula = y1 ~ beta1 * sprem1 + beta2 * sprem2 + : variable lengths differ (found for 'beta1')
Where is the problem?
Any help would be appreciated.
In the formula, * is interpreted as the interaction between each beta and the terms from df. This interaction is akin to an element-wise product, but the beta are scalar, whereas the sprem are vectors... so their length differ.
It's hard to tell what you want to do, but you're probably looking for something like this:
fit.lm <- lm(formula = y1 ~ I(beta1 * sprem1) + I(beta2 * sprem2) + I(beta3 * sprem3) + I(beta4 * sprem4) + I(beta5 * sprem5), data = df)
I made a code to simulate a dataset in R to see how backward selection works in machine learning. And I generated poly() function to write polynomial function and then wanted to choose the suitable polynomial using Cp, BIC, adjusted R^2.
The code is:
###Generating dataset
set.seed(1)
X = rnorm(100)
eps = rnorm(100)
beta0 = 3
beta1 = 2
beta2 = -3
beta3 = 0.3
Y = beta0 + beta1 * X + beta2 * X^2 + beta3 * X^3 + eps
library(leaps)
data.full = data.frame(y = Y, x = X)
mod.full = regsubsets(y ~ poly(x, 10, raw = T), data = data.full, nvmax = 10)
mod.summary = summary(mod.full)
### Find the model size for best cp, BIC and adjr2
which.min(mod.summary$cp)
For cp, BIC and adjusted R^2 I get model with polynomial 3 as it should be
However, now I want to simulate 100 datasets and see in how many datasets do I get the right model. I simulated 100 datasets but now I am not getting polynomial 3 for each of the measures. And I don't quite understand what I'm doing wrong. My code for simulation is:
###Generating 100 datasets
data <- replicate(100, rnorm(n=100))
epsilon <- replicate(100,rnorm(n=100))
###Formula (same as before)
Y = beta0 + beta1 * data + beta2 * data^2 + beta3 * data^3 + epsilon
data.full = data.frame(y = Y, x = data)
###Using polynomial terms
mod.bwd = regsubsets(data.full$y.1 ~ poly(data.full$x.1, 10, raw = T), data = data.full, nvmax = 10,
method = "backward")
bwd.summary = summary(mod.bwd)
which.min(bwd.summary$cp)
which.min(bwd.summary$bic)
which.max(bwd.summary$adjr2)
For a given subset cp, Bic, adjr2 are giving me different results. For example, using y.1 and x.1 (first dataset in simulation) gives following results:
which.min(bwd.summary$cp): 7
which.min(bwd.summary$bic): 4
which.max(bwd.summary$adjr2): 9
Can someone help me what I'm doing wrong in simulating these 100 datasets.
If I've read your code correctly you run the model on the same simulated dataset 100 times instead of all 100 simulated datasets, this should do the trick:
set.seed(42)
###Generating 100 datasets
data <- replicate(100, rnorm(n=100))
epsilon <- replicate(100,rnorm(n=100))
###Formula (same as before)
Y = beta0 + beta1 * data + beta2 * data^2 + beta3 * data^3 + epsilon
data.full = data.frame(y = Y, x = data)
res <- lapply(1:100, function(i){
###Using polynomial terms
mod.bwd = regsubsets(data.full[[i]] ~ poly(data.full[[100+i]], 10, raw = T), data = data.full, nvmax = 10,
method = "backward")
bwd.summary = summary(mod.bwd)
c(
which.min(bwd.summary$cp),
which.min(bwd.summary$bic),
which.max(bwd.summary$adjr2)
)
})
res <- do.call(rbind, res)
With this rng-seed this gives some lines where all cirteria select the correct model.
How do I use ggplot to plot the predator species against the prey species?
These are the equations I'm using;
dX/dt = a1X - b1XY, X(0) = X0 #Prey
dY/dt = a2XY - b2Y, Y(0) = Y0 #Predator
These are the values of my constants;
a1 = 1.247
b1 = .384
a2 = .123
b2 = .699
X0 = 5.415
Y0 = 6.923
K = 9.438
This piece of code below describes the right hand side of the equations, however I'm unsure if this is relevant to plotting the two species.
ydot.lv <- function(t,y,parms){
ydot <- rep(NA,2)
ydot[1] <- parms[1]*y[1] - parms[2]*y[1]*y[2]
ydot[2] <- parms[3]*y[1]*y[2] - parms[4]*y[2]
return(list(ydot))
}
I'm trying to fit data with nls() function where the nature of data gives me bounds for one coefficient and for sum of two coefficients. Let me introduce short example to see where is the problem. I want parameter b1 to be between 0 and 1 and I want sum of parameters b1 and b2 to be between 0 and 1 as well.
set.seed(123)
# example where everything is OK
x <- 1:200
g <- rbinom(200, 1, 0.5)
y <- 3 + (0.7 + 0.2 * g) * x
yeps <- y + rnorm(length(y), sd = 0.1)
# both parameter b1 and sum of parameters b1 and b2 are between 0 and 1
nls(yeps ~ a + (b1 + b2 * g) * x, start = list(a = 0.12345, b1 = 0.54321, b2 = 0.4213))
# using more extreme values
x <- 1:200
g <- rbinom(200, 1, 0.5)
y <- 3 + (0.9 - 0.99 * g) * x
yeps <- y + rnorm(length(y), sd = 15)
# b1 is OK, but b1 + b2 < 0
nls(yeps ~ a + (b1 + b2 * g) * x,
start = list(a = 0.12345, b1 = 0.54321, b2 = 0.4213))
# trying constraints, not good, sum is still out of range
nls(yeps ~ a + (b1 + b2 * g) * x,
start = list(a = 0.12345, b1 = 0.54321, b2 = 0.4213),
lower = list(a = -Inf, b1 = 0, b2 = -1),
upper = list(a = Inf, b1 = 1, b2 = 1),
algorithm = "port")
What I'm looking for is something like that (does not work):
nls(yeps ~ a + (b1 + b2 * g) * x,
start = list(a = 0.12345, b1 = 0.54321, b2 = 0.4213),
lower = list(a = -Inf, b1 = 0, b2 = -b1),
upper = list(a = Inf, b1 = 1, b2 = 1 - b1),
algorithm = "port")
Is it possible to set constraints with other parameters in nls() function? Thanks for any suggestions!
Let B2 = b1+b2 so b2 = B2-b1 and substituting B2-b1 for b2 we get a problem in terms of a, b1 and B2 of which the latter two are between 0 and 1 so:
fm <- nls(yeps ~ a + (b1 + (B2-b1) * g) * x, lower = c(-Inf, 0, 0), upper = c(Inf, 1, 1),
start = list(a = 0.1, b1 = 0.5, B2 = 0.1), alg = "port")
giving the following (hence b2 = B2 - b1 = 0 - 0.9788 = -0.9788)
> fm
Nonlinear regression model
model: yeps ~ a + (b1 + (B2 - b1) * g) * x
data: parent.frame()
a b1 B2
-5.3699 0.9788 0.0000
residual sum-of-squares: 42143
Algorithm "port", convergence message: both X-convergence and relative convergence (5)
and plotting:
plot(yeps ~ x)
points(fitted(fm) ~ x, pch = 20, col = "red")
I want to fit to a 1 - exp(x) function to a data set , but giving higher weight to the first values. However, the following code is not working in such way:
x <-sqrt((0.05)^2+(0.05)^2)*seq(from = 1, to = 20, by = 1)
y <- c(11,20,27,32,35,36,36.5,25,16,9,4,1,7.87e-16,2.07e-15,-9.36e-16,1.61e-15,-3.81e-16,3.92e-16,7.65e-16,-8.26e-16)
temp <- data.frame(cbind(x,y))
we <- 1/(log1p(seq_along(x)))
# fit non-linear model
mod <- nls(y ~ (1 - exp(a + b * x)), data = temp, start = list(a = 0, b = 0), weights = we)
#add fitted curve
lines(temp$x, predict(mod, list(x = temp$x)))
Here is the output:
Your specification of weights is correct. The bad fit you obtained is due to your faulty model assumption. You assumed:
y ~ 1 - exp(a + b * x)
Note that exp() gives strictly positive values, so y will be no larger than 1. However, y values in your data range up to 35.
My idea is not perfect, but it might give you a better starting point. Consider:
y ~ a * x * exp(b * x * x + c * x)
Using your data:
x <- c(0, sqrt((0.05)^2+(0.05)^2)*seq(from = 1, to = 20, by = 1))
y <- c(0, 11,20,27,32,35,36,36.5,25,16,9,4,1,7.87e-16,2.07e-15,-9.36e-16,1.61e-15,-3.81e-16,3.92e-16,7.65e-16,-8.26e-16)
fit <- nls(y ~ a * x * exp(b * x * x + c * x), start = list(a = 30, b= -1, c = -1))
plot(x, y)
lines(x, predict(fit, list(x)))