Functional Data Analysis on R Views

FDA and the Dynamics of Curves

Thu, 14 Oct 2021 00:00:00 +0000

An elegant application of Functional Data Analysis is to model longitudinal data as a curve and then study the curve’s dynamics. For example, in pharmacokinetics and other medical studies analyzing multiple measurements of drug or protein concentrations in blood samples, it may be interest to determine if the concentrations in subjects undergoing one type of treatment rise quicker than those undergoing an alternative treatment. In this post, I will generate some plausible fake data for measurements taken over time for two groups of subjects, use the techniques of Functional Data Analysis to represent these data as a continuous curve for each subject, and look at some of the dynamic properties of the curves, in particular their velocities and accelerations.

Synthetic Data

The fdaoutlier package contains functions to generate a number of stochastic models with a mechanism to generate reasonable outliers for each type of model. THe curves produced by model 4 look like they can serve plausible synthetic concentration curves. Instead of thinking of normal curves and outliers, I imagine the two related sets of curves to be the results of two different treatments influencing some measured concentration curve. In the example below, the curves associated with treatment 2 are of the form: \[X_i(t) = \mu t(1 - t)^m + e_i(t),\] while those associated with treatment 1 are of the form: \[X_i(t) = \mu(1 - t)t^m + e_i(t)\] where:

$t\in [0,1]$,
$e_i(t)$ is a Gaussian process with zero mean and covariance function of the form: \[\gamma(s,t) = \alpha\exp\{-\beta|t-s|^\nu\},\]
$m$ is a constant
$\mu$ is the mean value
$\alpha$, $\beta$, and $\nu$ are coefficients in the covariance function

library(fdaoutlier)
library(tidyverse)
library(fda)
library(gganimate)
library(gridExtra)

The following code generates two different sets of longitudinal data from Model 4 which is described in the vignette to the fdaoutlier package.

set.seed(95139)
n_curves <- 100
n_obs <- 50
mod4 <- simulation_model4(n = n_curves, p = n_obs, outlier_rate = .5, seed = 50, plot = FALSE)
index <- 1:n_curves
index1 <- mod4$true_outliers
# curves_mat is an n_curves x n_obs matrix
curves_mat <- mod4$data
treat <- rep(2,n_obs)
curves <- data.frame(index, treat, curves_mat)
curves <- curves %>% mutate(treat = if_else((index %in% index1),1,2))

There are 50 curves for each treatment and 50 points for each curve. This is probably the simplest case possible, and it is good enough to show how to explore the dynamics of curves. However, if you work with real longitudinal data you know that things are rarely this simple. But please be assured that FDA can deal with considerably more complexity, including a variable number of measurements for each subject, different measurement times for each subject, and situations where you have far fewer than 50 points for each subject. I have explored some of these situations in previous posts. For example, look here to see how to work with different time points, and here for some ideas for working with sparse data. The first link above also points to basic references that should help you to get started with your data.

Now, I reformat the data into a long form data frame and plot both sets of curves.

time <- 1:n_obs

curves_l <- pivot_longer(curves, cols = !c("index", "treat"), names_to = "Xval") %>%
            mutate(time = rep(time,100), .before = "treat", treat = as.factor(treat)) %>%
            dplyr::select(-Xval)

p <- curves_l %>% ggplot(aes(time,value, color = treat)) +
     geom_line(aes(group = index)) + 
     scale_color_manual(values=c("navy blue", "dark grey")) +
     ggtitle("Model 4 Curves")
p

So far we just have plots based on a relatively small number of data points. Nevertheless, our eyes extrapolate, and we imagine seeing two sets of continuous curves with one set clearly rising to its maximum value faster than the other set. But we really don’t have continuous curves yet, we just have points.

The next step is to invoke the mathematics of FDA to embed the points in an infinite dimensional vector space where the data for each subject is modeled by a continuous function (curve). Exactly how this happens is a bit involved, but the general idea is that we create a basis and then use the data and some techniques from the linear algebra of Hilbert spaces to estimate the time dependent coefficients that enable modeling each subject’s data points as a linear combination of the basis functions. So, from here on out we are not going to be working with the raw data anymore. We will be working with vector space models of the data. The upside is that we can now now have real curves (continuous function), and can calculate the values of the functions and other properties such as the first and second derivatives at any time point. If you are interested in the math, please have a look at the references listed at the bottom of my post on Functional PCA.

Modeling the data as functions with a B-Spline Basis

Here we use the function fda::create.bspline.basis() to create a B-Spline basis covering the interval of our observations. The plot of the curves above indicates that specifying a knot at every multiple of 5 ought to be adequate for representing our data. Note that using cubic splines n_order = 4 ensures that the splines will have continuous first and second derivatives at the knots.

knots    = c(seq(0,n_obs,5)) #Location of knots
n_knots   = length(knots) #Number of knots
n_order   = 4 # order of basis functions: for cubic b-splines: order = 3 + 1
n_basis   = length(knots) + n_order - 2;
spline_basis = create.bspline.basis(rangeval = c(0,n_obs), nbasis = n_basis, norder = n_order)
#plot(spline_basis)

The following code uses the function fda::Data2fda() and the spline-basis to convert the Model 4 data points into functions and produce one fda object for each of the two groups of treatments.

# df1 is an (n_curves/2) x (n_obs) matrix 
df1 <- curves_mat[index1,] # data for treatment 1
index2 <- index[!(index %in% index1)]
df2 <- curves_mat[index2,]  # data for treatment 2
# Use the b-spline basis to create represent the curves as vectors in the function space
df1_obj <- Data2fd(argvals = 1:n_obs, y = t(df1), basisobj = spline_basis, lambda = 0.5)
df2_obj <- Data2fd(argvals = 1:n_obs, y = t(df2), basisobj = spline_basis, lambda = 0.5)

Computing Derivatives

Here we evaluate each function along with its first and second derivatives at a finer time scale than we used to originally display our data.

tfine <- seq(0,50,by=.5)
# Each matrix is 101 x 50 rows are different times, columns are curves
pos1 <- as.vector(eval.fd(tfine, df1_obj));     pos2 <- as.vector(eval.fd(tfine, df2_obj))
vel1 <- as.vector(eval.fd(tfine, df1_obj,1));   vel2 <- as.vector(eval.fd(tfine, df2_obj,1)) 
acc1 <- as.vector(eval.fd(tfine, df1_obj,2));   acc2 <- as.vector(eval.fd(tfine, df2_obj,2))

Note that the velocities and accelerations computed above were returned as matrices. We convert them to vectors and put them into a data frame for plotting.

time <- rep(tfine,50)
id1 <- rep(1:50,each=101)
id2 <- rep(51:100,each=101)

derv1 <- data.frame(time, id1, pos1, vel1, acc1)
derv2 <- data.frame(time, id2, pos2, vel2, acc2)

pv1 <- derv1 %>% ggplot(aes(time,vel1,col=id1)) + geom_line(aes(group = id1)) + ggtitle("Velocity Treatment 1")
pv2 <- derv2 %>% ggplot(aes(time,vel2,col=id2)) + geom_line(aes(group = id2)) + ggtitle("Velocity Treatment 2")
pa1 <- derv1 %>% ggplot(aes(time,acc1,col=id1)) + geom_line(aes(group = id1)) +ggtitle("Acceleration Treatment 1")
pa2 <- derv2 %>% ggplot(aes(time,acc2,col=id2)) + geom_line(aes(group = id2)) + ggtitle("Acceleration Treatment 2")

grid.arrange(pv1, pa1, pv2, pa2, nrow = 2,ncol = 2, padding = unit(1, "line"))

The velocities for treatment 1 head upwards before they decrease while the velocities for treatment 2 go straight down, and the curve up again. The accelerations for treatment 1 slope downward slightly while those of treatment two slope upward. So the plots indicate that the two sets of curves look like they behave differently.

Testing for Differences

We can test for differences using the function fda::tperm.fd() which implements a resampling method to do pointwise t-tests. The functional data representing the curves for the two samples are combined in a single array and the labels for the curves are randomly shuffled. Recalculating the maximum value of the t-statistic for each point enables computing a null distribution. Then, at each time point, the observed data are compared with the 1 - $\alpha$ quantile of the null distribution.

The plot below shows the result of performing the t-test to compare the first derivatives of the two treatments. I use the function fda.deriv.fd() to calculate the first derivative for each treatment on the fly, just to show another way of doing things in the fda package. You can easily modify the code to compare accelerations.

dfdt1 <- deriv.fd(df1_obj,1)
dfdt2 <- deriv.fd(df2_obj,1)
tres <- tperm.fd(dfdt1,dfdt2,plotres=FALSE)

max_q <- tres$qval
tres_dat <-tibble(time = tres$argvals, t_values = tres$Tvals,
                  q_vals = tres$qvals.pts)

p <- tres_dat %>% ggplot(aes(time,t_values, colour = "t_value")) + geom_line() +
    geom_line(aes(time, q_vals, colour = "q_vals")) +
    geom_line(aes(time, max_q,colour = "max_q"), linetype= "dashed") + 
    labs(x = "time", y = "") +
    ggtitle("Statistics for Pointwise t-test")
p

The blue curve shows the t-statistic for the observed values. The green curve represents the 95% quantiles, and the dashed red line is the 95% quantile of the maximum of null distribution t-statistics. The t-test confirms that the derivatives are indeed different except in the regions of overlap around time = 10 and time = 40.

Examine Phase Plots

Phase plots are useful for evaluating how the curves develop in the abstract phase space created by looking at position versus velocity, or velocity versus acceleration. Here we pick three curves from each treatment and plot velocity versus acceleration.

phase1 <- derv1 %>% filter(id1 %in% 15:17)
phase2 <- derv2 %>% filter(id2 %in% 51:53)
pph1 <- phase1 %>% ggplot(aes(vel1,acc1,col=id1)) + geom_point() + ggtitle("Treat 1 v vs. acc")
pph2 <- phase2 %>% ggplot(aes(vel2,acc2,col=id2)) + geom_point() + ggtitle("Treat 2 v vs. acc")

grid.arrange(pph1, pph2, ncol = 2, padding = unit(1, "line"))

Based on this small sample, it certainly appears that the curves associated with the two different treatments inhabit different regions of phase space.

Finally, it is easy and helpful to animate a phase diagram to show how a function develops in phase space over time. The animation below shows the first curve for treatment 1.

pos <- eval.fd(tfine, df2_obj[1])
vel <- eval.fd(tfine, df2_obj[1],1)
acc <- eval.fd(tfine, df2_obj[1],2)
phase_dat <- tibble(tfine, vel, acc)

p <- ggplot(phase_dat, aes(vel,acc)) +  geom_point() + ggtitle("Trajectory in Phase Space")

anim <- p + transition_time(tfine) + shadow_mark()
anim_save("anim.gif", anim)
#anim

Functional PCA with R

Thu, 10 Jun 2021 00:00:00 +0000

In two previous posts, Introduction to Functional Data Analysis with R and Basic FDA Descriptive Statistics with R, I began looking into FDA from a beginners perspective. In this post, I would like to continue where I left off and investigate Functional Principal Components Analysis (FPCA), the analog of ordinary Principal Components Analysis in multivariate statistics. I’ll begin with the math, and then show how to compute FPCs with R.

As I have discussed previously, although the theoretical foundations of FDA depend on some pretty advanced mathematics, it is not necessary to master this math to do basic analyses. The R functions in the various packages insulate the user from most of the underlying theory. Nevertheless, attaining a deep understanding of what the R functions are doing, or looking into any of the background references requires some level of comfort with the notation and fundamental mathematical ideas.

I will define some of the basic concepts and then provide a high level roadmap of the mathematical argument required to develop FPCA from first principals. It is my hope that if you are a total newcomer to Functional Data Analysis you will find this roadmap useful in apprehending the big picture. This synopsis closely follows the presentation by Kokoszka and Reimherr (Reference 1. below).

We are working in $\mathscr{H}$, a separable Hilbert space of square integrable random functions where each random function, $X(\omega,t)$, where $\omega \in \Omega$ the underlying space of probabilistic outcomes, and $t \in [0,1]$. (After the definitions below, I will suppress the independent variables and in most equations assume $EX = 0$.)

Definitions

A Hilbert Space $\mathscr{H}$ is an infinite dimensional vector space with an inner product denoted by $<.,.>$. In our case, the vectors are functions.
$\mathscr{H}$ is separable if there exists an orthonormal basis. That is, there is an orthogonal collection of functions $(e_i)$ in $\mathscr{H}$ such that $<e_i,e_j>\; = 0$ if $i = j$ and 0 otherwise, and every function in $\mathscr{H}$ can be represented as a linear combination of these functions.
The inner product of two functions $X$ and $Y$ in $\mathscr{H}$ is defined as $<X,Y>\; = \int X(\omega,t) Y(\omega,t)dt$.
The norm of $X$ is defined in terms of the inner product: $\parallel X(\omega) \parallel ^2\; = \int X(\omega, t)^2 dt < \infty$.
$X$ is said to be square integrable if $E\parallel X(\omega) \parallel ^2 < \infty$.
The covariance operator $C(y): \mathscr{H} \Rightarrow \mathscr{H}$ for any square integrable function $X$ is given by: $C(y) = E[<X - EX,y>(X - EX)]$

The Road to Functional Principal Components

As we have seen, the fundamental idea of Functional Data Analysis is to represent a function $X$ by a linear combination of basis elements. In the previous posts we showed how to accomplish this using a basis constructed from more or less arbitrarily selected B-spline vectors. But, is there a an empirical, some would say natural basis that can be estimated from the data? The answer is yes, and that is what FPCA is all about.

A good way to start is to look at the distance between a vector $X$ and its projection down into the space spanned by some finite, p-dimensional basis $(u_k)$ which is expressed in the following equation,

$D = E\parallel X - \sum_{k=1}^{p}<X, u_k>u_k\parallel^2$ $(*)$

This expands out to:

$= E [< (X - \sum_{k=1}^{p}<X, u_k>u_k, X - \sum_{k=1}^{p}<X, u_k>u_k)>]$

and with a little algebra this:

$= E\parallel X \parallel^2 - \sum_{k=1}^{p}E<X, u_k>^2$

It should be clear that we would want to find a basis that makes $D$ as small as possible, and that minimizing $D$ is equivalent to maximizing the term to be subtracted in the line above.

A little algebra shows that, $E<X, u_k>^2 \;=\; <C(u_k),u_k>$ where $C(u_k)$ is the covariance operator defined above.

Now, we are almost at our destination. There is a theorem (e.g. Theorem 11.4.1 in reference 1.) that says for any fixed number of basis elements p, the distance D above is minimized if $u_j = v_j$ where the $v_j$ are the eigenfunctions of $C(y)$ with respect to the unit norm. From this it follows that $E<X, v_j>^2 \;=\; <C(v_,),v_j>\; =\; <\lambda_j, v_j>\; =\; \lambda_j$.

Going back to equation $(*)$, we can expand $X$ in terms of the basis $(v_j)$ so $D = 0$ and we have what is called the Karhunen–Loève expansion: $X = \mu + \sum_{j=1}^{\infty}\xi_jv_j$

where:

$\mu = EX$
The deterministic basis functions $(v_j)$ are called the functional principal components
The $(v_j)$ have unit norm and are unique up to their signs. (You can work with $v_j$ or $-v_j$.)
The eigenvalues are such that: $\lambda_1 > \lambda_2 > . . . \lambda_p$
The random variables $\xi_j =\; <X - \mu,v_j>$ are called the scores.
$E\xi_j = 0$, $E\xi_j^2 = \lambda_j$ and $E|\xi_i\xi_j| = 0,\; if\; i\;\neq\;j$.

And finally, with one more line:
$\sum_{j=1}^{\infty}\lambda_j \: = \: \sum_{j=1}^{\infty}E[<X,v_j>^2] = E\sum_{j=1}^{\infty}<X,v_j>^2 \; = \; E\parallel X \parallel^2 \; < \infty$

we arrive at our destination, the variance decomposition: $E\parallel X - \mu \parallel^2 \;= \;\sum_{j=1}^{\infty}\lambda_j$

Let’s Calculate

Now that we have enough math to set the context, let’s calculate. We will use the same simulated Brownian motion data that we used in the previous posts, and also construct the same B-spline basis that we used before and save it in the fda object W.obj. I won’t repeat the code here.

The following plot shows 120 simulated curves, each having 1000 points scattered over the interval [0, 100]. Each curve has unique observation times over that interval.

For first attempt at calculating functional principal components we’ll use the pca.fd() function from the fda package. So set up wise, we are picking up our calculations exactly where we left off in the previous post. As before, the basis representations of these curves are packed into the fda object W.obj. The function pca.fd() takes W.obj as input. It needs the non-orthogonal B-spline basis to seed its computations and the estimate the covariance matrix and the orthogonal eigenvector basis $v_j$. The nharm = 5 parameter requests computing 5 eigenvalues.

The method of calculation roughly follows the theory outlined above. It starts with a basis representation of the functions, computes the covariance matrix, and calculates the eigenfunctions.

fun_pca <- pca.fd(W.obj, nharm = 5)

The object produced by pca.fd() is fairly complicated. For example, the list fun_pca$harmonics does not contain the eignevectors themselves, but rather coefficients that enable the eigenvectors to be computed from the original basis. However, because there is a special plot method for plot.pca.fd() it is easy to plot the eigenvectors.

plot(fun_pca$harmonics, lwd = 3)

## [1] "done"

It is also to obtain the eivenvalues $\lambda_j$,

fun_pca$values

##  [1] 37.232207  3.724524  1.703604  0.763120  0.547976  0.389431  0.196101
##  [8]  0.163289  0.144052  0.116587  0.089307  0.057999  0.054246  0.050683
## [15]  0.042738  0.035107  0.031283  0.024905  0.019079  0.016428  0.011657
## [22]  0.007392  0.002664

and, the proportion of the variance explained by each eigenvalue.

fun_pca$varprop

## [1] 0.81965 0.08199 0.03750 0.01680 0.01206

A Different Approach

So far in this short series of FDA posts, I have been mostly using the fda package to calculate. In 2003 when it was released, it was ground breaking work. It is still the package that you are most likely to find when doing internet searches, and is the foundation for many subsequent R packages. However, as the CRAN Task View on Functional Data Analysis indicates, new work in FDA has resulted in several new R packages. The more recent fdapace takes a different approach to calculating principal components. The package takes its name from the (PACE) Principal Components by Conditional Expectation algorithm described in the paper by Yao, Müller and Wang (Reference 4. below). The package vignette is exemplary. It describes the methods of calculation, develops clear examples and provides a list of references to guide your reading about PACE and FDA in general.

A very notable feature of the PACE algorithm is that it is designed specifically to work with sparse data. The vignette describes the two different methods of calculation that package functions employ for sparse and non-sparse data. In this post, In this post we are not working with sparse data, but hope to do so in the future. See the vignette for examples of FPCA with sparse data.

library(fdapace)

The fdapace package requires data for the functions (curves) and associated times be organized in lists. We begin by using the fdapace::CheckData() function to check the data set up in the tibble df. (See previous post on descriptive statistics for the details on the data construction.)

CheckData(df$Curve,df$Time)

No error message is generated, so we move on th having the FPCA() function calculate the FPCA outputs including:

W_fpca <- FPCA(df$Curve,df$Time)

the eigenvalues:

W_fpca$lambda

## [1] 37.5386  3.2098  1.0210  0.3533

the cumulative percentage of variance explained by the eigenvalue

W_fpca$cumFVE

## [1] 0.8875 0.9634 0.9875 0.9959

and the scores:

head(W_fpca$xiEst)

##         [,1]    [,2]     [,3]     [,4]
## [1,]  0.8187  1.1971 -1.77755  0.20087
## [2,] -8.7396  2.4165 -0.33768 -0.10565
## [3,] -2.7517 -0.4879 -0.06747 -0.13953
## [4,]  3.9218  0.9419  0.39098 -0.25449
## [5,] -1.4400  0.7691  2.11549 -0.59947
## [6,]  7.3952  0.5114 -2.16391  0.05199

All of these are in fairly good agreement with what we computed above. I am, however, a little surprised by the discrepancy in the value of the second eigenvalue. The default plot method for FPCA() produces a plot indicating the density of the data, a plot of the mean of the functions reconstructed from the eigenfunction expansion, a scree plot of the eigenvalues and a plot of the first three eigenfunctions.

plot(W_fpca)

Finally, it has probably already occurred to you that if you know the eigenvalues and scores, the Karhunen–Loève expansion can be used to simulate random functions. It can be shown that for the Wiener process:

$v_j(t) = \sqrt2 sin(( j - \frac{1}{2})\pi t)$ and $\lambda_j = \frac{1}{(j - \frac{1}{2})^2\pi^2}$

This gives us:

$W(t) = \sum_{j=1}^{\infty} \frac {\sqrt2}{(j - \frac{1}{2})\pi)} N_j sin(( j - \frac{1}{2})\pi t$

where the $N_j \:are\; iid \;N(0,1)$.

The fdapace function fdapace::Wiener() uses this information to simulate an alternative, smoothed version of the Brownian motion, Wiener process.

set.seed(123)
w <- Wiener(n = 1, pts = seq(0,1, length = 100))
t <- 1:100
df_w <- tibble(t, as.vector(w))
ggplot(df_w, aes(x = t, y = w)) + geom_line()

In future posts, I hope to continue exploring the fdapace package, including its ability to work with sparse data.

References

I found the following references particularly helpful.

Kokoszka, P. and Reimherr, M. (2017). Introduction to Functional Data Analysis. CRC.
Hsing, T and Eubank, R. (2015). Theoretical Foundations of Functional Data Analysis, with an Introduction to Linear Operators Wiley
Wang, J., Chiou, J. and Müller, H. (2015). Review of Functional Data Analysis
Yao, F., Müller, H, Wang, J. (2012). Functional Data Analysis for Sparse Longitudinal Data JASA J100, I 470

Basic FDA Descriptive Statistics with R

Fri, 14 May 2021 00:00:00 +0000

In a previous post, I introduced the topic of Functional Data Analysis (FDA). In that post, I provided some background on Functional Analysis, the mathematical theory that makes FDA possible, identified FDA resources that might be of interest R users, and showed how to turn a series of data points into an FDA object. In this post, I will pick up where I left off and move on to doing some very basic FDA descriptive statistics.

Let’s continue with the same motivating example from last time. We will use synthetic data generated by a Brownian motion process and pretend that it is observed longitudinal data. However, before getting to the statistics, I would like to take a tiny, tidy diversion. The functions in fda and other fundamental FDA R packages require data structured in matrices. Consequently, the examples in the basic FDA reference works (listed below) construct matrices using code that seems to be convenient for the occasion. I think this makes adapting sample code to user data a little harder than it needs to be. There ought to be standard data structures for working with FDA data. I propose tibbles or data frames with function values packed into lists.

The following function generates n_points data points for each of n_curve Brownian motion curves that represent the longitudinal data collected from n_curve subjects.

library(fda)
library(tidyverse)
library(plotly)

# Function to simulate data
fake_curves <- function(n_curves = 100, n_points = 80, max_time = 100){
  ID <- 1:n_curves
  x <- vector(mode = "list", length = n_curves)
  t <- vector(mode = "list", length = n_curves)
  
  for (i in 1:n_curves){
    t[i] <- list(sort(runif(n_points,0,max_time)))
    x[i] <- list(cumsum(rnorm(n_points)) / sqrt(n_points))
  }
  df <- tibble(ID,t,x)
  names(df) <- c("ID", "Time", "Curve")
  return(df)
}

Notice that each curve is associated with a unique set of random time points that lie in the interval [0, max_time]. Not being restricted to situations where data from all subjects must be observed at the same times is a big deal. However, in practice you may encounter problems that will require curve alignment procedures. We will ignore this for now. Note that the variables Time and Curve contain lists of data points in each cell.

set.seed(123)
n_curves <- 40
n_points <- 80
max_time <- 100
df <- fake_curves(n_curves = n_curves,n_points = n_points, max_time = max_time)
head(df)

## # A tibble: 6 x 3
##      ID Time       Curve     
##   <int> <list>     <list>    
## 1     1 <dbl [80]> <dbl [80]>
## 2     2 <dbl [80]> <dbl [80]>
## 3     3 <dbl [80]> <dbl [80]>
## 4     4 <dbl [80]> <dbl [80]>
## 5     5 <dbl [80]> <dbl [80]>
## 6     6 <dbl [80]> <dbl [80]>

Later on, this kind of structure will be convenient for data sets that contain both FDA curves and other scalar covariates. Note that if you are using the RStudio IDE running the function View(df) will show you an expanded view of the tibble under a tab labeled df that should look something like this:

Next, we unpack the data into a long form tibble and plot.

df_1 <- df %>% select(!c(ID,Curve)) %>% unnest_longer(Time) 
df_2 <- df %>% select(!c(ID,Time)) %>% unnest_longer(Curve)
ID <- sort(rep(1:n_curves,n_points))
df_l <- cbind(ID,df_1,df_2)
p <- ggplot(df_l, aes(x = Time, y = Curve, group = ID, col = ID)) +
      geom_line()
p

Now that we have the data, remember that FDA treats each curve as a basic data element living in an infinite dimensional vector space. The vectors, $X$, are random functions: $X: \Omega \Rightarrow \mathscr{H}$ where $\Omega$ is an underlying probability space and $\mathscr{H}$ is typically a complete Hilbert Space of square integrable functions. That is, for each $\omega \in \Omega$, $\parallel X(\omega) \parallel ^2 = \int X((\omega)(t))^2 dt < \infty$. In multivariate statistics we work with random variables that live in a Euclidean space, here we are dealing with random functions that live in a Hilbert space. In this context, square integrable means $E \parallel X \parallel ^2 < \infty$. You will find lucid elaborations of all of this in the references below which I have reproduced below from the previous post.

The bridge from the theory to practice is the ability to represent the random functions as a linear combination of basis vectors. This was the topic of the previous post. Here is some compact code to construct the basis.

knots    = c(seq(0,max_time,5)) #Location of knots
n_knots   = length(knots) #Number of knots
n_order   = 4 # order of basis functions: for cubic b-splines: order = 3 + 1
n_basis   = length(knots) + n_order - 2;
basis = create.bspline.basis(rangeval = c(0,max_time), n_basis)
plot(basis)

This next bit of code formats the data in the long form tibble into the matrix input expected by the fda functions and creates an fda object that contains the coefficients and basis functions used to smooth data. Note the smoothing constant of lambda = .5.

argvals <- matrix(df_l$Time, nrow = n_points, ncol = n_curves)
y_mat <- matrix(df_l$Curve, nrow = n_points, ncol = n_curves)

W.obj <- Data2fd(argvals = argvals, y = y_mat, basisobj = basis, lambda = 0.5)

Next somewhat anticlimactically after all of the preparation and theory, we use the fda functions mean.fd() and std.fd() to calculate the pointwise mean and standard deviation from information contained in fda object. In order to use these objects to calculate the pointwise confidence interval for the mean it is necessary to construct a couple of new fda objects for the upper and lower curves. Then, we plot the smoothed curves for our data along with the pointwise mean and pointwise 95% confidence bands for the mean.

W_mean <- mean.fd(W.obj)
W_sd <- std.fd(W.obj)
# Create objects for the standard upper and lower standard deviation
SE_u <- fd(basisobj = basis)
SE_l <- fd(basisobj = basis)
# Fill in the sd values
SE_u$coefs <- W_mean$coefs +  1.96 * W_sd$coefs/sqrt(n_curves) 
SE_l$coefs <- W_mean$coefs -  1.96 * W_sd$coefs/sqrt(n_curves)

plot(W.obj, xlab="Time", ylab="", lty = 1)

## [1] "done"

title(main = "Smoothed Curves")
lines(SE_u, lwd = 3, lty = 3)
lines(SE_l, lwd = 3, lty = 3)
lines(W_mean,  lwd = 3)

Finally, we compute the covariance/correlation matrix for our sample of smoothed curves and use plotly to create an interactive plot of the three dimensional correlation surface along with a contour map.

days <- seq(0,100, by=2)
cov_W <- var.fd(W.obj)
var_mat <-  eval.bifd(days,days,cov_W)

fig <- plot_ly(x = days, y = days, z = ~var_mat) %>% 
  add_surface(contours = list(
    z = list(show=TRUE,usecolormap=TRUE, highlightcolor="#ff0000", project=list(z=TRUE))))

fig <- fig %>% 
  layout(scene = list(camera=list(eye = list(x=1.87, y=0.88, z=-0.64))))

fig

This covariance surface for the Brownian motion random walk we are using for data is interesting in its own right. There is a theoretical result that says that the estimate for the covariance function for this process is $\hat{c}(t,s) = min(t,s)$. You can find the proof in the book by Kokoszka and Reimherr referenced below. Using the mouse to hover over some points in the graph makes this result seem plausible.

References

Books

Kokoszka, P. and Reimherr, M. (2017). Introduction to Functional Data Analysis. CRC.
Ramsay, J.O. and Silverman, B.W. (2005). Functional Data Analysis. Springer.
Ramsay, J.0., Hooker, G. and Graves, S. (2009) Functional Data Analysis with R and MATLAB Springer.

Online Resources

Cao, J. (2019). Functional Data Analysis Course
Staicu, A. and Park, Y. (2016) Short Course on Applied Functional Data Analysis

Introduction to Functional Data Analysis with R

Tue, 04 May 2021 00:00:00 +0000

Suppose you have data that looks something like this.

This plot might depict 80 measurements for a participant in a clinical trial where each data point represents the change in the level of some protein level. Or it could represent any series of longitudinal data where the measurements are taken at irregular intervals. The curve looks like a time series with obvious correlations among the points, but there are not enough measurements to model the data with the usual time series methods. In a scenario like this, you might find Functional Data Analysis (FDA) to be a viable alternative to the usual multi-level, mixed model approach.

This post is meant to be a “gentle” introduction to doing FDA with R for someone who is totally new to the subject. I’ll show some “first steps” code, but most of the post will be about providing background and motivation for looking into FDA. I will also point out some of the available resources that a newcommer to FDA should find helpful.

FDA is a branch of statistics that deals with data that can be conceptualized as a function of an underlying, continuous variable. The data in FDA are smooth curves (or surfaces) in time or space. To fix a mental model of this idea, first consider an ordinary time series. For example, you might think of the daily closing prices of your favorite stock. The data that make up a time series are the individual points which are considered to be random draws from an underlying stochastic process.

Now, go up a level of abstraction, and consider a space where the whole time series, or rather an imaginary continuous curve that runs through all of your data points is the basic item of analysis. In this conceptual model, the curve comprises an infinite number of points, not just the few you observed. Moreover, unlike in basic time series analysis, the observed points do not need to be equally spaced, and the various curves that make up your data set do not need to be sampled at the same time points.

Mathematically, the curves are modeled as functions that live in an infinite dimensional vector space, what the mathematicians call a Hilbert Space. One way to think of this is that you are dealing with the ultimate large p small n problem. Each curve has infinitely many points, not just the 3 or 30 or 3,000 you happen to have.

The theory of Hilbert Spaces is part of the area of mathematical analysis called Functional Analysis, a subject usually introduced as part of a second or third course in mathematical analysis, or perhaps in a course on Quantum Mechanics.

It would be a heavy lift to expect someone new to Functional Data Analysis to start with the mathematics. Fortunately, this is not really necessary. The practical applications of FDA and the necessary supporting software have been sufficiently developed so that anyone familiar with the basics of ordinary vector spaces should have sufficient background to get started. The salient points to remember are:

Hilbert space is an infinite dimensional linear vector space
The vectors in Hilbert space are functions
The inner product of two functions in the Hilbert space is defined as the integral of two functions, but it behaves very much like the familiar dot product.

Moreover, for the last twenty years or so mathematical statisticians have been writing R packages to put FDA within the reach of anyone with motivation and minimal R skills. The CRAN Task View on Functional Data Analysis categorizes and provides brief explanations for forty packages that collectively cover most of the established work on FDA. The following graph built with functions from the cranly package shows part of the network for two core FDA packages.

The fda package emphasized in the network plot above is the logical place for an R user to begin investigating FDA. With thirty-two reverse depends, thirty-eight reverse imports and thirteen reverse suggest, fda is at the root of Functional Data Analysis software for R. Moreover, in a very real sense, it is at the root of modern FDA itself. fda was written to explicate the theory developed in the 2005 book by Ramsay and Silverman$^{1}$. Kokoszka and Reimnerr state that the first edition of this book published in 1997: “is largely credited with solidifying FDA as an official subbranch of statistics” (p xiv)$^{2}$. The refund package is used extensively throughout the book by Kokoszka and Reimnerr.

First Steps

The synthetic data in the figure above were generated by a Wiener, Brownian Motion process, which for the purposes of this post, is just a convenient way to generate a variety of reasonable looking curves. We suppose that the data points shown represent noisy observations generated by a smooth curve f(t). We estimate this curve with the model: $y_{i} = f(t_{i}) + \epsilon_{i}$ where the $\epsilon_{i}$ are normally distributed with mean 0 and variance $\sigma^{2}$.

Notice that the measurement times are randomly selected within the 100 day window and not uniformly spaced.

set.seed(999)
n_obs <- 80
time_span <- 100
time <- sort(runif(n_obs,0,time_span))
Wiener <- cumsum(rnorm(n_obs)) / sqrt(n_obs)
y_obs <- Wiener + rnorm(n_obs,0,.05)

Remember that the task ahead is to represent the entire curve of infinitely many points and not just the handful of observed values. Here is where the linear algebra comes in. The curve is treated as a vector in an infinite dimensional vector space, and what we want is something that will serve as a basis for this curve projected down into the subspace where the measurements live. The standard way to do this for non-periodic data is to construct a B-spline basis. (B-splines or basis splines are splines designed to have properties that make them suitable for representing vectors.) The code that follows is mostly borrowed from Jiguo Cao’s Youtube Video Course$^{3}$ which I very highly recommend for anyone just starting with FDA. In his first five videos, Cao explains B-splines and the placement of knots in great detail and derives the formula used in the code to calculates the number of basis elements from the number of knots and the order of the splines.

Note that we are placing the knots at times equally spaced over the 100 day time span.

times_basis = seq(0,time_span,1)
knots    = c(seq(0,time_span,5)) #Location of knots
n_knots   = length(knots) #Number of knots
n_order   = 4 # order of basis functions: cubic bspline: order = 3 + 1
n_basis   = length(knots) + n_order - 2;
basis = create.bspline.basis(c(min(times_basis),max(times_basis)),n_basis,n_order,knots)
n_basis

## [1] 23

and there are 23 basis vectors.

Next, we use the function eval.basis() to evaluate the basis functions at the times where our data curve was observed The matrix PHI contains the values of the 23 basis functions $\phi_j(t)$ evaluated at 80 points.

PHI = eval.basis(time, basis) 
dim(PHI)

## [1] 80 23

We plot the basis functions and locations of the knots.

matplot(time,PHI,type='l',lwd=1,lty=1, xlab='time',ylab='basis',cex.lab=1,cex.axis=1)
for (i in 1:n_knots)
{
  abline(v=knots[i], lty=2, lwd=1)
}

The plot shows that for interior points, four basis functions contribute to computing the value of any point. The endpoints, however, are computed from a single basis function.

Estimating the Basis Coefficients

As in ordinary regression, we express the function in terms of the coefficients $c_j$ and basis functions $\phi_j$ using the formula: $f(t) = \sum c_j \phi_j(t)$. Later we will see how to use built-in fda functions to estimate the coefficients, but now we follow Cao’s lead and calculate everything from first principles.

The following code uses matrix least squares equation $\hat{c} = (\Phi^t\Phi)^{-1} \Phi^{t}y$ to estimate the coefficients.

# Least squares estimate
# estimate basis coefficient
M = ginv(t(PHI) %*% PHI) %*% t(PHI)
c_hat = M %*% Wiener

We compute $\hat{y}$, the estimates of our observed values, and plot.

y_hat = PHI %*% c_hat
# Augment data frame for plotting
df <- df %>% mutate(y_hat = y_hat)
p2 <- df %>% ggplot() + 
      geom_line(aes(x = time, y = Wiener), col = "grey") +
      geom_point(aes(x = time, y = y_obs)) +
      geom_line(aes(x = time, y = y_hat), col = "red")
p2 + ggtitle("Original curve and least squares estimate") + 
      xlab("time") + ylab("f(time)")

The gray curve in the plot represents the underlying Brownian motion process, the dots are the observed values (the same as in the first plot), and the red curve represents the least squares “smoothed” estimates.

Now, we work through the matrix calculations to estimate the variance of the noise and the error bars for $\hat{y}$.

# estimate the variance of noise
## SSE = (Y - Xb)'(Y - Xb)
SSE = t(y_hat-y_obs)%*%(y_hat-y_obs)
sigma2 = SSE/(n_obs-n_basis)

# estimate the variance of the fitted curve
# H is the Hat matrix H
# H = X*inv(X'X)*X``
H = PHI %*% M
varYhat = diag(H %*% H * matrix(sigma2,n_obs,n_obs))

# 95% confidence interval

y_hat025 = y_hat-1.96*sqrt(varYhat)
y_hat975 = y_hat+1.96*sqrt(varYhat)

And, we plot. We have a satisfying smoothed representation of our original curve that looks like it would be and adequate starting point for further study. Note that process of using regression to produce a curve from the basis functions is often referred to as “regression smoothing”

df <- mutate(df, y_hat025 = y_hat025,
                 y_hat975 = y_hat975)
#names(df) <- c("time","Wiener","y_hat", "y_hat025", "y_hat975")
p3 <- df %>% ggplot() + 
      geom_line(aes(x = time, y = Wiener), col = "grey") +
      geom_point(aes(x = time, y = y_obs)) +
      geom_line(aes(x = time, y = y_hat), col = "red") +
      geom_line(aes(x = time, y_hat025), col = "green") +
      geom_line(aes(x = time, y_hat975), col = "green") 
p3 + ggtitle("Estimated curve with error bars") + 
     xlab("time") + ylab("f(time)")

We finish for today, by showing how to do the hard work of estimating coefficients and function values with a single line of code using the fda function smooth.basis(). The function takes the arguments argvals the times we want to use for evaluation as a vector (or matrix or array), y the observed values, and fdParobj, an fda object containing the basis elements.

Wiener_obj <- smooth.basis(argvals = time, y = y_obs, fdParobj = basis)

Here we plot our “hand calculated” curve in red and show the smooth.basis() curve in blue. They are reasonably close, except at the end points, where there is not much data to construct the basis.

plot(time, Wiener, type = "l", xlab = "time", ylab = "f(time)", 
     main = "Comparison of fda package and naive smoothing estimates", col = "grey")
lines(time,y_hat,type = "l",col="red")
lines(Wiener_obj, lwd = 1, col = "blue")

Note that we have shown the simplest use of smooth.basis() which is capable of computing penalized regression estimates and more. The examples of using the smooth.basis() function in the fda pdf are extensive and worth multiple blog posts. In general, the pdf level documentation for fda is superb. However, the package lacks vignettes. For a price, the book Functional Data Analysis with R and Matlab$^{4}$ supplies the equivalent of several the missing vignettes.

Next Steps

Once you have a basis representation, what’s next? You may be interested in the following:

More exploratory work such as Functional Principal Components Analysis, the analog of principal components analysis.
Clustering curves. See the funHDDC package.
Setting up regression models where either the dependent variable, or some of the independent variables, or both are functional objects. See the refund package and the book by Kokoszka and Reimnerr$^{2}$
Studying the shape of the curves themselves. For example, the shape of a protein concentration curve may convey some clinical meaning. FDA permits studying the velocity and acceleration of curves, offering the possibility of obtaining more information than the standard practice of looking at the area under the curves. You can explore this with the fda package (But be sure to check that the order of your basis functions is adequate to compute derivatives.). See the book by Ramsay, Hooker and Graves$^{4}$.
Learning what to do when you have sparse data. See the paper by Yao et al. below$^{5}$ and look into the fdapace package.
Working with two and three dimensional medical images$^{6}$.

I would like to make Functional Data Analysis a regular feature on R Views. If you are working with FDA and would like to post, please let me (joseph.rickert@rstudio.com) know.

References

Books

$^{2}$Kokoszka, P. and Reimherr, M. (2017). Introduction to Functional Data Analysis. CRC.
$^{1}$Ramsay, J.O. and Silverman, B.W. (2005). Functional Data Analysis. Springer.
$^{4}$Ramsay, J.0., Hooker, G. and Graves, S. (2009) Functional Data Analysis with R and MATLAB Springer.

Online Resources

$^{3}$Cao, J. (2019). Functional Data Analysis Course
Staicu, A. and Park, Y. (2016) Short Course on Applied Functional Data Analysis

Functional Data Analysis on R Views

FDA and the Dynamics of Curves

Synthetic Data

Modeling the data as functions with a B-Spline Basis

Computing Derivatives

Testing for Differences

Examine Phase Plots

Functional PCA with R

Definitions

The Road to Functional Principal Components

Let’s Calculate

A Different Approach

References

Basic FDA Descriptive Statistics with R

References

Books

Online Resources

Recommended Papers

Introduction to Functional Data Analysis with R

First Steps

Estimating the Basis Coefficients

Next Steps

References

Books

Online Resources

Recommended Papers