How do I use apply where the function is a polynomial?-CodePudding

est_poly <- function(x,y,slopes,n) {
  x_vals <- seq(x[1],x[2],length.out = n)
  p0 <- y[1]
  p1 <- slopes[1]
  p2 <- (3*(y[2]-y[1])/(x_vals[-1]-x_vals[1])-2*(slopes[1])-slopes[2])/(x_vals[-1]-x_vals[1])
  p3 <- (slopes[1] slopes[2]-2*(y[2]-y[1])/(x_vals[-1]-x_vals[1]))/(x_vals[-1]-x_vals[1])^2
  x1 <- x_vals[1]
  result <- c()
  for (i in x_vals) {
    poly <- p0 p1*(i-x1) p2*(i-x1)^2 p3*(i-x1)^3
    result <- append(result, poly[4])
  }
  return(matrix(data = c(x_vals,result), nrow = n))
}
x_eg2 <- c(0,1)
y_eg2 <- c(0,1)
slopes_eg <- c(0,2)
est_poly(x_eg2, y_eg2, slopes_eg, n=5)

Hi just want to know how to use apply or lapply to replace the for loop. Should get this as my output.

Thank you!

CodePudding user response：

Try this, see comments for explanations.

est_poly <- function(x, y, slopes, n) {
  ## using `seq.int` instead of `seq`
  x_vals <- seq.int(x[1], x[2], length.out=n)  
  p0 <- y[1]
  p1 <- slopes[1]
  p2 <- (3*(y[2] - y[1])/(x_vals[-1] - x_vals[1]) - 2*(slopes[1]) - slopes[2])/(x_vals[-1] - x_vals[1])
  p3 <- (slopes[1]   slopes[2] - 2*(y[2] - y[1])/(x_vals[-1] - x_vals[1]))/(x_vals[-1] - x_vals[1])^2
  x1 <- x_vals[1]
  ## using `vapply` instead of `for` loop
  result <- vapply(x_vals, \(i) (p0   p1*(i - x1)   p2*(i - x1)^2   p3*(i - x1)^3)[4], numeric(1L))
  ## alternatively `sapply`, but might be slower 
  # result <- sapply(x_vals, \(i) (p0   p1*(i - x1)   p2*(i - x1)^2   p3*(i - x1)^3)[4])
  return(matrix(data=c(x_vals, result), nrow=n))
}

x_eg2 <- c(0, 1)
y_eg2 <- c(0, 1)
slopes_eg <- c(0, 2)
est_poly(x=x_eg2, y=y_eg2, slopes=slopes_eg, n=5)
#      [,1]   [,2]
# [1,] 0.00 0.0000
# [2,] 0.25 0.0625
# [3,] 0.50 0.2500
# [4,] 0.75 0.5625
# [5,] 1.00 1.0000

CodePudding user response：

Use a function instead of an expression:

x_vals <- c(0, 0.25, 0.5, 0.75, 1)
x1 <- x_vals[1L]
poly <- function (x) p0   p1 * (x - x1)   p2 * (x - x1) ^ 2   p3 * (x - x1) ^ 3
result <- lapply(x_vals, poly)

That said, lapply returns a list; in your case, a vector is probably more appropriate. You can either use unlist on the result of lapply, or, instead:

result <- vapply(x_vals, poly, numeric(1L))

If your poly function returns multiple values and you want to retain only one, you can either adjust your poly function accordingly, or you can nest it into a further function which selects the value.

Following your code’s example:

result <- vapply(x_vals, \(x) poly(x)[4L], numeric(1L))

(In case you’re unfamiliar with it, \(…) is a shorthand for function (…).)