| SOCR ≫ | DSPA ≫ | DSPA2 Topics ≫ |
This DSPA2 appendix demonstrates useful protocols for spatiotemporal interpolation, regularization, and uniform sampling of univariate and multivariate, spatial and temporal (longitudinal) data. The process of interpolation used to regularize irregularly sampled data, impute missing values, and facilitate homologies between cases, studies, cohorts, participants, populations, clusters, etc.
Let’s use the R package akima to illustrate the regularization of a process, or function \(z=f(x,y)\), that is only observed on irregularly sampled points \((x,y)\in \mathbb{R}^2\), distributed throughout the 2D \((x,y)\in \mathbb{R}^2\) plane. Note that each of the axes can represent space or time, one of the axes can be time and the other one can be space, or alternatively the signal can represent irregularly sampled kimesurface, \(z=f(x,y)\) over complex time (kime), \(\kappa\equiv z\in\mathbb{C}\cong\mathbb{R}^2\ni (x,y)\), where the kime-magnitude \(t=|\kappa|=\sqrt{x^2+y^2}\) and the kime-phase \(\phi\) are irregularly sampled and \(\kappa=t e^{i\phi}\in\mathbb{C}\).
In general, function interpolation returns a list of points smoothly interpolating the observed (irregularly-sampled) data points.
x <- 1:10
y <- c(rnorm(5), c(1,1,1,1,3))
xnew <- seq(-1, 11, 0.1)
# plot(x, y, ylim=c(-3, 3), xlim=range(xnew))
# lines(spline(x, y, xmin=min(xnew), xmax=max(xnew), n=200), col="blue")
spl <- spline(x, y, xmin=min(xnew), xmax=max(xnew), n=200)
plot_ly(x=x, y=y, type="scatter", mode="markers", name="Raw Obs") %>%
add_trace(x=spl$x, y=spl$y, type="scatter", mode="lines", name="Spline Model") %>%
layout(title="Spline Modeling of a 1D Process (Uniform Sampling)",
legend = list(orientation = 'h')) %>%
hide_colorbar()x <- sort(runif(10, max=10))
y <- c(rnorm(5), c(1,1,1,1,3))
spl_1 <- aspline(x, y, xnew)
spl_2 <- aspline(x, y, xnew, method="improved")
spl_3 <- aspline(x, y, xnew, method="improved", degree=10)
plot_ly(x=x, y=y, type="scatter", mode="markers", name="Raw Obs") %>%
add_trace(x=spl$x, y=spl$y, type="scatter", mode="lines", name="Spline Model") %>%
add_trace(x=spl_1$x, y=spl_1$y, type="scatter", mode="lines", name="Spline Model 1") %>%
add_trace(x=spl_2$x, y=spl_2$y, type="scatter", mode="lines", name="Spline Model 2") %>%
add_trace(x=spl_3$x, y=spl_3$y, type="scatter", mode="lines", name="Spline Model 3") %>%
layout(title="Four Spline Models of a 1D Process (Uniform Sampling)",
legend = list(orientation = 'h')) %>%
hide_colorbar()x <- c(-3, -2, -1, 0, 1, 2, 2.5, 3)
y <- c( 0, 0, 0, 0, -1, -1, 0, 2)
spl <- spline(x, y, n=200)
spl_1 <- aspline(x, y, n=200)
spl_2 <- aspline(x, y, n=200, method="improved")
spl_3 <- aspline(x, y, n=200, method="improved", degree=10)
plot_ly(x=x, y=y, type="scatter", mode="markers", name="Raw Obs") %>%
add_trace(x=spl$x, y=spl$y, type="scatter", mode="lines", name="Spline Model") %>%
add_trace(x=spl_1$x, y=spl_1$y, type="scatter", mode="lines", name="Spline Model 1") %>%
add_trace(x=spl_2$x, y=spl_2$y, type="scatter", mode="lines", name="Spline Model 2") %>%
add_trace(x=spl_3$x, y=spl_3$y, type="scatter", mode="lines", name="Spline Model 3") %>%
layout(title="Four Spline Models of a 1D Process (Irregular Sampling)",
legend = list(orientation = 'h')) %>%
hide_colorbar()data(akima760)
# interpolate at the diagonal of the grid [0,8]x[0,10]
akima.bic <- bicubic(akima760$x, akima760$y, akima760$z, seq(0,8,length=50), seq(0,10,length=50))
x <- sqrt(akima.bic$x^2+akima.bic$y^2)
y <- akima.bic$z
plot_ly(x=x, y=y, type="scatter", mode="markers+lines", name="Raw Obs") %>%
layout(title="Bicubic Bivariate Interpolation (Irregular Sampling)",
xaxis=list(title="Argument Magnitude (||(x,y)||)"),
yaxis=list(title="Functional Value (z=f(x,y))"),
legend = list(orientation = 'h')) %>%
hide_colorbar()x <- akima760$x
y <- akima760$y
z <- akima760$z
plot_ly(x=x, y=y, z=z, type="surface", name="Raw Obs") %>%
layout(title="Bicubic Bivariate Interpolation (Irregular Sampling)",
xaxis=list(title="Argument Magnitude (||(x,y)||)"),
yaxis=list(title="Functional Value (z=f(x,y))"),
legend = list(orientation = 'h')) %>%
hide_colorbar()Interpolation of a bivariate function, \(z=f(x,y)\), on a rectangular grid in the
x-y plane, based on the revised Akima method
bicubic.grid(x,y,z,xlim,ylim,dx,dy).
data(akima760)
# interpolate at a grid [0,8]x[0,10]
akima.bic <- bicubic.grid(akima760$x, akima760$y, akima760$z, c(0,8),c(0,10),0.1,0.1)
# ==================
# interp: Gridded Bivariate Interpolation for Irregular Data
# ==========================
# implement bivariate interpolation onto a grid for irregularly spaced input data.
# Bilinear or bicubic spline interpolation is applied using different versions of algorithms from Akima
data(akima)
# plot(y ~ x, data = akima, main = "akima example data")
# with(akima, text(x, y, formatC(z,dig=2), adj = -0.1))
values <- formatC(akima$z,dig=2)
plot_ly(as.data.frame(akima), x=~x, y=~y, type="scatter", mode="markers", name="Raw Obs") %>%
add_text(x=~x, y=~y, text=values, name=values, textposition = 'middle top') %>%
layout(title="Bicubic Bivariate Interpolation (Irregular Sampling)",
xaxis=list(title="x"),
yaxis=list(title="y"),
legend = list(orientation = 'h')) %>%
hide_colorbar()## linear interpolation
akima_df <- as.data.frame(akima)
akima_df <- akima_df %>% replace(is.na(.), 0)
# interpolation
akima_lin_interpol <-
interp(akima_df$x, akima_df$y, akima_df$z,
xo=seq(min(akima_df$x), max(akima_df$x), length = 200),
yo=seq(min(akima_df$y), max(akima_df$y), length = 200))
akima_lin_interpol$z <- akima_lin_interpol$z %>% replace(is.na(.), 0)
df <- as.data.frame(akima)
plot_ly() %>% add_contour(x=~akima_lin_interpol$x, y=~akima_lin_interpol$y,
z=~akima_lin_interpol$z, name="Bivariate Linear Model") %>%
add_trace(x=~df$x, y=~df$y, type="scatter", mode="markers", name="Raw Obs") %>%
layout(title="Linear Bivariate Interpolation (Irregular Sampling)",
xaxis=list(title="x"),yaxis=list(title="y"),
legend = list(orientation = 'h')) %>%
hide_colorbar()