Skip to content
Browse files

Adding dotchart.with.add.r file

  • Loading branch information...
1 parent e397a3e commit 0aa07a41066b5cb9104c52f280c2ae45877abd88 @talgalili committed May 9, 2012
Showing with 94 additions and 0 deletions.
  1. +93 −0 dotchart.with.add.r
  2. +1 −0 source_https.r.txt
View
93 dotchart.with.add.r
@@ -0,0 +1,93 @@
+dotchart <- function (x, labels = NULL, groups = NULL, gdata = NULL, cex = par("cex"),
+ pch = 21, gpch = 21, bg = par("bg"), color = par("fg"), gcolor = par("fg"),
+ lcolor = "gray", xlim = range(x[is.finite(x)]), main = NULL,
+ xlab = NULL, ylab = NULL, ...)
+{
+ opar <- par("mai", "mar", "cex", "yaxs")
+ on.exit(par(opar))
+ par(cex = cex, yaxs = "i")
+ if (!is.numeric(x))
+ stop("'x' must be a numeric vector or matrix")
+ n <- length(x)
+ if (is.matrix(x)) {
+ if (is.null(labels))
+ labels <- rownames(x)
+ if (is.null(labels))
+ labels <- as.character(1L:nrow(x))
+ labels <- rep(labels, length.out = n)
+ if (is.null(groups))
+ groups <- col(x, as.factor = TRUE)
+ glabels <- levels(groups)
+ }
+ else {
+ if (is.null(labels))
+ labels <- names(x)
+ glabels <- if (!is.null(groups))
+ levels(groups)
+ if (!is.vector(x)) {
+ warning("'x' is neither a vector nor a matrix: using as.numeric(x)")
+ x <- as.numeric(x)
+ }
+ }
+ plot.new()
+ linch <- if (!is.null(labels))
+ max(strwidth(labels, "inch"), na.rm = TRUE)
+ else 0
+ if (is.null(glabels)) {
+ ginch <- 0
+ goffset <- 0
+ }
+ else {
+ ginch <- max(strwidth(glabels, "inch"), na.rm = TRUE)
+ goffset <- 0.4
+ }
+ if (!(is.null(labels) && is.null(glabels))) {
+ nmai <- par("mai")
+ nmai[2L] <- nmai[4L] + max(linch + goffset, ginch) +
+ 0.1
+ par(mai = nmai)
+ }
+ if (is.null(groups)) {
+ o <- 1L:n
+ y <- o
+ ylim <- c(0, n + 1)
+ }
+ else {
+ o <- sort.list(as.numeric(groups), decreasing = TRUE)
+ x <- x[o]
+ groups <- groups[o]
+ color <- rep(color, length.out = length(groups))[o]
+ lcolor <- rep(lcolor, length.out = length(groups))[o]
+ offset <- cumsum(c(0, diff(as.numeric(groups)) != 0))
+ y <- 1L:n + 2 * offset
+ ylim <- range(0, y + 2)
+ }
+ plot.window(xlim = xlim, ylim = ylim, log = "")
+ lheight <- par("csi")
+ if (!is.null(labels)) {
+ linch <- max(strwidth(labels, "inch"), na.rm = TRUE)
+ loffset <- (linch + 0.1)/lheight
+ labs <- labels[o]
+ mtext(labs, side = 2, line = loffset, at = y, adj = 0,
+ col = color, las = 2, cex = cex, ...)
+ }
+ abline(h = y, lty = "dotted", col = lcolor)
+ points(x, y, pch = pch, col = color, bg = bg)
+ if (!is.null(groups)) {
+ gpos <- rev(cumsum(rev(tapply(groups, groups, length)) +
+ 2) - 1)
+ ginch <- max(strwidth(glabels, "inch"), na.rm = TRUE)
+ goffset <- (max(linch + 0.2, ginch, na.rm = TRUE) + 0.1)/lheight
+ mtext(glabels, side = 2, line = goffset, at = gpos, adj = 0,
+ col = gcolor, las = 2, cex = cex, ...)
+ if (!is.null(gdata)) {
+ abline(h = gpos, lty = "dotted")
+ points(gdata, gpos, pch = gpch, col = gcolor, bg = bg,
+ ...)
+ }
+ }
+ axis(1)
+ box()
+ title(main = main, xlab = xlab, ylab = ylab, ...)
+ invisible()
+}
View
1 source_https.r.txt
@@ -21,3 +21,4 @@ source_https <- function(u, unlink.tmp.certs = FALSE) {
# example:
# source_https("https://raw.github.com/talgalili/R-code-snippets/master/tabular.cast_df.r")
+

0 comments on commit 0aa07a4

Please sign in to comment.
Something went wrong with that request. Please try again.