Solved – Loop of regressions in R

I have a regression problem that I implement in R using for loop. Basically, I have an equation (as a result of a long procedure) as a function of temperature, with five unknown parameters. I have 12 different temperatures that I can use to drive the equations, so for each combination of the five parameters, I can have 12 points.

The 12 points are actually derived from two line segments that cross at a certain point. Depending on the values of the five unknown parameters, the two segments can run anywhere. With the right parameters I hope that the two segments form a straight line.

For that purpose, I need to run a linear regression on these points, and then over the whole combination of the five parameters, I need to find one set of parameters that results in the minimum residual sum of squares.

The problem is that it takes hours to solve the parameters with a fine resolution (by=0.05 instead of by=0.5 in the example below).

Is there a way to solve this problem faster? I think gradient descend can do this faster, but I do not know how to formulate it.

Any suggestions would be greatly appreciated.

Here is the code:

A1 = 1.25 A2 = 0.01136 A3 = -0.0433  a = seq(0,1,by=0.5) b = seq(0,1,by=0.5) c = seq(-3,3,by=0.5) d = seq(0,1,by=0.5) e = seq(-3,3,by=0.5)  Temp_F = c(28.99, 36.87, 42.92, 52.84, 58.31, 67.60, 76.17, 70.20, 63.26, 53.05, 39.28, 35.35)  df <- expand.grid(a=a, b=b, c=c, d=d, e=e) nrow(df)  for (i in 1:nrow(df) ) {     X.points = df$a[i]*A1 - (A2*df$b[i]*Temp_F) - df$c[i] + (A3*df$d[i]*Temp_F) + df$e[i]     	glm.X = glm(X.points ~ Temp_F)     	df$res[i]=sum(residuals(glm.X)^2) }  write.csv(df, file="df.csv") index=which(df$res == min(df$res[df$res > 0]))     df$a[index] df$b[index]     df$c[index] df$d[index]     df$e[index] 

You can rewrite this as an optimisation problem. You have function with 5 parameters and you want to minimise it.

Define

 optf <- function(p) {     a <- p[1]     b <- p[2]     c <- p[3]     d <- p[4]     e <- p[5]     X.points = a*A1 - (A2*b*Temp_F) - c + (A3*d*Temp_F) + e     sum(residuals(glm(X.points ~ Temp.F))^2)  } 

Now optimise:

 start <- c(0.5,0.5,0,0.5,0)  optim(optf,start) 

This should find the minimum of function optf if it exists. You can investigate different optimisation methods and try to play with starting values.

To speed things up use lsfit (lsfit(Temp.F,X.points) in your case) instead of glm, you have a linear problem and you do not need any extra calculations done by glm.

Similar Posts:

Rate this post

Leave a Comment