Linear Segmentation

In this example we fit a piecewise linear function to example data.
Please see here for a discussion of the methodology.

library("RcppDynProg")


set.seed(2018)
g <- 100
d <- data.frame(
  x = 0.05*(1:(3*g))) # ordered in x
d$y_ideal <- sin((0.3*d$x)^2)
d$y_observed <- d$y_ideal + 0.25*rnorm(length(d$y_ideal))


# plot
plot(d$x, d$y_observed,
     xlab = "x", ylab = "y",
     main = "raw data\ncircles: observed values, dashed line: unobserved true values")
lines(d$x, d$y_ideal,
     type = "l",
     lty = "dashed")


x_cuts <- solve_for_partition(d$x, d$y_observed, penalty = 1)
print(x_cuts)

d$estimate <- approx(x_cuts$x, x_cuts$pred, xout = d$x, method = "linear", rule = 2)$y
d$group <- as.character(findInterval(d$x, x_cuts[x_cuts$what=="left", "x"]))
print(sum((d$y_observed - d$y_ideal)^2))
print(sum((d$estimate - d$y_ideal)^2))
print(sum((d$estimate - d$y_observed)^2))
# plot
plot(d$x, d$y_observed,
     xlab = "x", ylab = "y",
     main = "RcppDynProg piecewise linear estimate\ndots: observed values, segments: estimated shape")
points(d$x, d$y_ideal,
     type = "l",
     lty = "dashed")
cmap <- c("#a6cee3",
          "#1f78b4",
          "#b2df8a",
          "#33a02c",
          "#fb9a99",
          "#e31a1c",
          "#fdbf6f",
          "#ff7f00",
          "#cab2d6",
          "#6a3d9a",
          "#ffff99",
          "#b15928")
names(cmap) <- as.character(seq_len(length(cmap)))
points(d$x, d$y_observed, col = cmap[d$group], pch=19)
groups <- sort(unique(d$group))
for(gi in groups) {
  di <- d[d$group==gi, , drop = FALSE]
  lines(di$x, di$estimate, col = cmap[di$group[[1]]], lwd=2)
}


Try the RcppDynProg package in your browser

Any scripts or data that you put into this service are public.

RcppDynProg documentation built on Aug. 20, 2023, 9:07 a.m.