Example of how to pull out summary metrics from smooth spline fit

smooth-spline-fit-an-extraction.R

ss <- function(tbl) {
    fit <- smooth.spline(x = tbl$x, y = tbl$y, cv = TRUE)
    # first derivative
    deriv1 <- predict(fit, deriv = 1)
    slope_max_pos <- which.max(deriv1$y)
    x_at_slope_max <- tbl$x[slope_max_pos]
    y_at_slope_max <- tbl$y[slope_max_pos]
    dy_at_slope_max <- deriv1$y[slope_max_pos]

    # translate into new vars
    mu <- dy_at_slope_max # max growth rate
    b <- y_at_slope_max - (dy_at_slope_max * x_at_slope_max) # intercept
    lambda <- - b / mu # length of lag
    # area under curve, aka efficiency/total growth:
    f <- function(x){
        p <- predict(fit, x)
        p$y
    }
    integral <- integrate(f,min(tbl$x),max(tbl$x))$value

    derived <- tibble(slope_max_pos,
                      x_at_slope_max,
                      y_at_slope_max,
                      mu, b, lambda, integral)

    # tidy for plotting
    points <- broom::augment(fit, tbl) %>%
        select(-.resid) %>%
        gather(y_type, y_val, y, .fitted)

    list(points = points, derived = derived)
}


res <- data %>%
    rename(x = time, y = y) %>%
    ss()

ggplot(data = res$points) +
    geom_line(aes(x,y_val, color = y_type)) +
    geom_point(aes(x,y_val, color = y_type), shape = 21, fill = "white") +
    geom_abline(aes(slope = mu, intercept = b), data = res$derived) +
    geom_point(aes(x =x_at_slope_max, y = y_at_slope_max), size = 4, data = res$derived) +
    geom_hline(yintercept = max(res$points$y_val)) +
    geom_vline(aes(xintercept = lambda), data = res$derived) +
    geom_vline(xintercept = min(res$points$x)) +
    # geom_ribbon(aes(x = x, ymax = y_val, ymin = 0), data = res$points %>% filter(x <= res$derived$lambda)) +
    scale_y_continuous(limits = c(0,1))