R/star-plot.R

In twolodzko/twextras: twextras

#' Star plot
#' 
#' @param x         numeric vector
#' @param point.col colour of points
#' @param var.col   colour
#' @param cex       size of text
#' @param point.cex size of points
#' @param labels    labels
#' @param points    if \code{TRUE} points are plotted
#' @param \dots     additional parameters passed to plot
#' 
#' @references
#' \url{http://stats.stackexchange.com/a/58039/35989}
#' 
#' @importFrom graphics text points
#' @export

star <- function(x, point.col = "red", var.col = "gray", cex = 0.8,
                 point.cex = 0.8, labels = seq_along(x), points = FALSE, ...) {
   
   x.range <- apply(x, 2, range)
   z <- t((t(x) - x.range[1,]) / (x.range[2,] - x.range[1,]))
   
   d <- dim(z)[2]
   prj <- t(sapply((1:d)/d, function(i) c(cos(2*pi*i), sin(2*pi*i))))
   star <- z %*% prj
   
   plot(rbind(apply(star, 2, range), apply(prj*1.25, 2, range)), 
        type="n", bty="n", xaxt="n", yaxt="n", xlab="", ylab="", ...)
   
   tmp <- apply(prj, 1, function(v) lines(rbind(c(0,0), v)))
   text(prj * 1.1, labels=colnames(z), cex=cex, col=var.col, ...)
   
   if (points) {
      points(star, pch=19, col=point.col, cex=point.cex, ...)
   } else {
      text(star, labels=labels, col=point.col, cex=point.cex, ...)
   }
   
   invisible(star)
}