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

user_19825372 0
Viewed 38
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.

enter image description here

Thank you!

data-analysis lapply apply r
2 Answers

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 (…).)

user_19680

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
user_65740380
Related