R/plot.kmeans.ct.R

In ctmva: Continuous-Time Multivariate Analysis

#'  Plot a kmeans.ct object
#'
#' Plots a continuous-time k-means clustering object generated by a call
#' to \code{\link{kmeans.ct}}.
#'
#' @param x  clustering object produced by \code{\link{kmeans.ct}}
#' @param type  either \code{"functions"} (the default), to display each variable
#' as a smooth function of time, or \code{"distance"}, to plot distances from the
#' k cluster means versus time.
#' @param mark.transitions  logical: Should transitions between clusters be marked
#' with vertical lines? Defaults to \code{TRUE}.
#' @param col  plot colors
#' @param lty  line type
#' @param xlab,ylab  x- and y-axis labels
#' @param legend either a logical variable (whether a legend should be included) or a character
#' vector to appear in the legend. Default is \code{TRUE}.
#' @param ncol.legend number of columns for legend
#' @param cex.legend character expansion factor for legend
#' @param \dots  other arguments passed to \code{\link{matplot}}
#' @return  None; a plot is generated.
#' @author Biplab Paul <paul.biplab497@gmail.com> and Philip Tzvi Reiss <reiss@stat.haifa.ac.il>
#'
#' @seealso  \code{\link{kmeans.ct}}, which includes an example
#'
#'
#' @export plot.kmeans.ct
#' @export
plot.kmeans.ct <-
  function(x, type="functions", mark.transitions=TRUE, col=NULL, lty=NULL, xlab="Time", ylab=NULL, legend=TRUE,
           ncol.legend=1, cex.legend=1, ...) {
    means <- x$means
    mtrx <- NULL
    rng <- x$fdobj$basis$range
    grid <- seq(rng[1], rng[2],length.out = 501)
    if (type=="functions") {
      if (is.null(col)) col <- 1:min(8, ncol(means))
      if (is.null(lty)) lty <- 1:min(5, ncol(means))
      if (is.null(ylab)) ylab <- ""
      matplot(grid, eval.fd(grid, x$fdobj), type="l", xlab=xlab, ylab=ylab, col=col, lty=lty, ...)

      legvec <- NULL
      if (is.character(legend)) {
        legvec <- legend
        legend <- TRUE
      }
      if (legend){
        if (is.null(legvec)) {
          legvec <- if (!is.null(x$fdobj$fdnames[[2]])) x$fdobj$fdnames[[2]]
                   else paste0("f", 1:ncol(x$fdobj$coefs))
        }
        legend("topright", legend=legvec, col=col, lty=lty,
                                          ncol = ncol.legend, cex = cex.legend)
      }
    } else if (type=="distance") {
      if (is.null(col)) col <- 1:nrow(means)
      if (is.null(lty)) lty <- 1:nrow(means)
      if (is.null(ylab)) ylab <- "Squared distance"
      for (i in 1:nrow(means)) {
        func <- Vectorize(function(t) sum((eval.fd(t,x$fdobj)-means[i,])^2))
        mtrx <- cbind(mtrx, func(grid))
      }
      matplot(grid, mtrx, type="l", xlab=xlab, ylab=ylab, col=col, lty=lty, ...)
      if (legend) legend("topright", title="Squared distance to...", legend=paste("Mean", 1:nrow(means)), col=col,
                         lty=lty, ncol = ncol.legend, cex = cex.legend)
    }
    if (mark.transitions) {
      for (pt in x$transitions) abline(v=pt, col="grey")
      midpts <- (c(rng[1],x$transitions) + c(x$transitions,rng[2])) / 2
      mtext(x$cluster, at=midpts)
    }
  }