Here is my implementation:
library(purrr)
closest_points <- function(x1,y1){
diffs <- abs(x1 - y1)
names(diffs)<-y1
sort(as.integer(names(head(sort(diffs),2))))
}
new_point <- function(x,x0,y0,x1,y1){
((y1-y0)/(x1-x0))*(x-x0)+y0
}
ipolate <- function(x,y){
missings_to_fill <- which(is.na(y))
filled_points <- setdiff(seq_along(y),missings_to_fill)
step1 <- map(missings_to_fill,
~closest_points(.x,filled_points))
names(step1) <- missings_to_fill
step1
step2 <- imap(step1,
~{
xlocal <- as.integer(.y)
x0 <- .x[1]
x1 <- .x[2]
y0 <- y[x0]
y1 <- y[x1]
new_point(x = xlocal,
x0=x0,
x1=x1,
y0=y0,
y1=y1)
})
y[missings_to_fill] <- unlist(step2)
y
}
(spoiled <- structure(list(x = 2010:2019, y = c(53.142662, 53.565829, 54.623546, 56.682212, 59.495817, 43.86624, 53.134923, NA, 22.206799, NA)), row.names = c(NA, -10L), class = "data.frame"))
fixed <- spoiled
fixed$y <- ipolate(spoiled$x,spoiled$y)
fixed