From noreply at r-forge.r-project.org Tue Mar 8 17:18:33 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Mar 2016 17:18:33 +0100 (CET) Subject: [R-gregmisc-commits] r2081 - pkg/gplots/R Message-ID: <20160308161833.CE3291847C3@r-forge.r-project.org> Author: warnes Date: 2016-03-08 17:18:31 +0100 (Tue, 08 Mar 2016) New Revision: 2081 Modified: pkg/gplots/R/heatmap.2.R Log: Set srtCol default if missing and colCol is set Modified: pkg/gplots/R/heatmap.2.R =================================================================== --- pkg/gplots/R/heatmap.2.R 2016-02-26 20:00:36 UTC (rev 2080) +++ pkg/gplots/R/heatmap.2.R 2016-03-08 16:18:31 UTC (rev 2081) @@ -457,7 +457,10 @@ { if(missing(adjCol) || is.null(adjCol)) adjCol=c(1,NA) - + + if(is.null(srtCol)) + srtCol <- 90 + xpd.orig <- par("xpd") par(xpd=NA) xpos <- axis(1, 1:nc, labels=rep("", nc), las=2, tick=0) From noreply at r-forge.r-project.org Tue Mar 8 17:20:02 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Mar 2016 17:20:02 +0100 (CET) Subject: [R-gregmisc-commits] r2082 - pkg/gplots/R Message-ID: <20160308162002.B56C7187F3C@r-forge.r-project.org> Author: warnes Date: 2016-03-08 17:20:02 +0100 (Tue, 08 Mar 2016) New Revision: 2082 Modified: pkg/gplots/R/lowess.R Log: Remove old code for S-Plus and modernize formula handling code. Modified: pkg/gplots/R/lowess.R =================================================================== --- pkg/gplots/R/lowess.R 2016-03-08 16:18:31 UTC (rev 2081) +++ pkg/gplots/R/lowess.R 2016-03-08 16:20:02 UTC (rev 2082) @@ -1,50 +1,49 @@ -# $Id$ +# make stats::lowess into a generic base-function +lowess.default <- stats::lowess -if(is.R()) - { - # make original lowess into the default method - if(R.version$major == 1 && R.version$minor < 9) - lowess.default <- base::lowess - else - lowess.default <- stats::lowess +# add "..." to the argument list to match the generic +formals(lowess.default) <- c(formals(lowess.default),alist(...= )) - lowess <- function(x,...) - UseMethod("lowess") +lowess <- function(x,...) + UseMethod("lowess") - # add "..." to the argument list to match the generic - formals(lowess.default) <- c(formals(lowess.default),alist(...= )) - NULL - - } else - { - - # make original lowess into the default method - lowess.default <- getFunction("lowess",where="main") - - lowess <- function(x,...) - UseMethod("lowess") - - NULL - } - - - "lowess.formula" <- function (formula, - data = parent.frame(), subset, na.action, - f=2/3, iter=3, - delta=.01*diff(range(mf[-response])), ... ) + data = parent.frame(), + ..., + subset, + f=2/3, + iter=3, + delta=.01*diff(range(mf[-response])) + ) { if (missing(formula) || (length(formula) != 3)) stop("formula missing or incorrect") - if (missing(na.action)) - na.action <- getOption("na.action") + m <- match.call(expand.dots = FALSE) - if (is.matrix(eval(m$data, parent.frame()))) - m$data <- as.data.frame(data) + eframe <- parent.frame() + md <- eval(m$data, eframe) + if (is.matrix(md)) + m$data <- md <- as.data.frame(data) + dots <- lapply(m$..., eval, md, eframe) + nmdots <- names(dots) m$... <- m$f <- m$iter <- m$delta <- NULL - m[[1]] <- as.name("model.frame") - mf <- eval(m, parent.frame()) - response <- attr(attr(mf, "terms"), "response") + subset.expr <- m$subset + m$subset <- NULL + m <- as.list(m) + m[[1L]] <- stats::model.frame.default + m <- as.call(c(m, list(na.action = NULL))) + mf <- eval(m, eframe) + if (!missing(subset)) { + s <- eval(subset.expr, data, eframe) + l <- nrow(mf) + dosub <- function(x) if (length(x) == l) + x[s] + else x + dots <- lapply(dots, dosub) + mf <- mf[s, ] + } + + response <- attr(attr(mf, "terms"), "response" ) lowess.default(mf[[-response]], mf[[response]], f=f, iter=iter, delta=delta) } From noreply at r-forge.r-project.org Tue Mar 8 17:21:16 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Mar 2016 17:21:16 +0100 (CET) Subject: [R-gregmisc-commits] r2083 - pkg/gplots/R Message-ID: <20160308162116.2265B1847C3@r-forge.r-project.org> Author: warnes Date: 2016-03-08 17:21:15 +0100 (Tue, 08 Mar 2016) New Revision: 2083 Added: pkg/gplots/R/plot.lowess.R Log: Add function to plot points and lowess using formula interface. Added: pkg/gplots/R/plot.lowess.R =================================================================== --- pkg/gplots/R/plot.lowess.R (rev 0) +++ pkg/gplots/R/plot.lowess.R 2016-03-08 16:21:15 UTC (rev 2083) @@ -0,0 +1,10 @@ +plot.lowess <- function (formula, data = parent.frame(), ..., subset=parent.frame(), col.lowess="red", lty.lowess=2 ) +{ + m <- match.call(expand.dots=TRUE) + m[[1]] <- as.name("plot") + eval(m) + m[[1]] <- as.name("lowess") + lw <- eval(m) + lines(lw, col=col.lowess, lty=lty.lowess) + grid() +} From noreply at r-forge.r-project.org Thu Mar 24 14:28:41 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Mar 2016 14:28:41 +0100 (CET) Subject: [R-gregmisc-commits] r2084 - pkg/gplots Message-ID: <20160324132841.9F9DD18706A@r-forge.r-project.org> Author: warnes Date: 2016-03-24 14:28:41 +0100 (Thu, 24 Mar 2016) New Revision: 2084 Modified: pkg/gplots/DESCRIPTION Log: Correct spelling Modified: pkg/gplots/DESCRIPTION =================================================================== --- pkg/gplots/DESCRIPTION 2016-03-08 16:21:15 UTC (rev 2083) +++ pkg/gplots/DESCRIPTION 2016-03-24 13:28:41 UTC (rev 2084) @@ -1,7 +1,7 @@ Package: gplots Title: Various R Programming Tools for Plotting Data Description: Various R programming tools for plotting data, including: - - calculating and plotting locally smoothed summary functionals + - calculating and plotting locally smoothed summary functionas ('bandplot', 'wapply'), - enhanced versions of standard plots ('barplot2', 'boxplot2', 'heatmap.2', 'smartlegend'), @@ -14,11 +14,11 @@ - displaying textual data in plots ('textplot', 'sinkplot'), - plotting a matrix where each cell contains a dot whose size reflects the relative magnitude of the elements ('balloonplot'), - - plotting Venn diagrams ('venn'), - - displaying Open-Office style plots ('ooplot'), - - plotting multiple data sets on same region, with separate axes + - plotting venn diagrams ('venn'), + - displaying Open-Office syle plots ('ooplot'), + - plotting multiple datasets on same region, with separate axes ('overplot'), - - plotting means and confidence intervals ('plotCI', 'plotmeans'), + - plotting means and cofidence intervals ('plotCI', 'plotmeans'), - spacing points in an x-y plot so they don't overlap ('space'). Depends: R (>= 3.0) Imports: gtools, gdata, stats, caTools, KernSmooth From noreply at r-forge.r-project.org Thu Mar 24 14:30:03 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Mar 2016 14:30:03 +0100 (CET) Subject: [R-gregmisc-commits] r2085 - pkg/gplots/R Message-ID: <20160324133003.3DC75187DC6@r-forge.r-project.org> Author: warnes Date: 2016-03-24 14:30:02 +0100 (Thu, 24 Mar 2016) New Revision: 2085 Modified: pkg/gplots/R/heatmap.2.R Log: Add layout infromation to object returned from heatmap.2() (patch provided by Jenny Drnevich). Modified: pkg/gplots/R/heatmap.2.R =================================================================== --- pkg/gplots/R/heatmap.2.R 2016-03-24 13:28:41 UTC (rev 2084) +++ pkg/gplots/R/heatmap.2.R 2016-03-24 13:30:02 UTC (rev 2085) @@ -457,10 +457,10 @@ { if(missing(adjCol) || is.null(adjCol)) adjCol=c(1,NA) - + if(is.null(srtCol)) srtCol <- 90 - + xpd.orig <- par("xpd") par(xpd=NA) xpos <- axis(1, 1:nc, labels=rep("", nc), las=2, tick=0) @@ -770,6 +770,13 @@ color=retval$col ) + # Store layout information, suggested by Jenny Drnevich + retval$layout <- list(lmat = lmat, + lhei = lhei, + lwid = lwid + ) + + ## If user has provided an extra function, call it. if(!is.null(extrafun)) extrafun() From noreply at r-forge.r-project.org Thu Mar 24 14:31:48 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Mar 2016 14:31:48 +0100 (CET) Subject: [R-gregmisc-commits] r2086 - pkg/gplots/R Message-ID: <20160324133149.045381878D1@r-forge.r-project.org> Author: warnes Date: 2016-03-24 14:31:48 +0100 (Thu, 24 Mar 2016) New Revision: 2086 Modified: pkg/gplots/R/lowess.R Log: Remove observations with missing values when lowess is called using the formula interface. Modified: pkg/gplots/R/lowess.R =================================================================== --- pkg/gplots/R/lowess.R 2016-03-24 13:30:02 UTC (rev 2085) +++ pkg/gplots/R/lowess.R 2016-03-24 13:31:48 UTC (rev 2086) @@ -44,6 +44,8 @@ mf <- mf[s, ] } + mf <- na.omit(mf) + response <- attr(attr(mf, "terms"), "response" ) lowess.default(mf[[-response]], mf[[response]], f=f, iter=iter, delta=delta) } From noreply at r-forge.r-project.org Thu Mar 24 14:35:50 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Mar 2016 14:35:50 +0100 (CET) Subject: [R-gregmisc-commits] r2087 - pkg/gplots/man Message-ID: <20160324133551.0E065186EBD@r-forge.r-project.org> Author: warnes Date: 2016-03-24 14:35:50 +0100 (Thu, 24 Mar 2016) New Revision: 2087 Modified: pkg/gplots/man/heatmap.2.Rd Log: Update heatmap.2() man page to reflect addition of to the returned object. Modified: pkg/gplots/man/heatmap.2.Rd =================================================================== --- pkg/gplots/man/heatmap.2.Rd 2016-03-24 13:31:48 UTC (rev 2086) +++ pkg/gplots/man/heatmap.2.Rd 2016-03-24 13:35:50 UTC (rev 2087) @@ -322,6 +322,8 @@ \code{trace="both"} or \code{trace="row"} } \item{colorTable}{A three-column data frame providing the lower and upper bound and color for each bin} + \item{layout}{A named numeric vector containing the values used for + \code{lmat}, \code{lhei}, and \code{lwid}. } } \author{Andy Liaw, original; R. Gentleman, M. Maechler, W. Huber, G. Warnes, revisions.} From noreply at r-forge.r-project.org Thu Mar 24 14:38:47 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Mar 2016 14:38:47 +0100 (CET) Subject: [R-gregmisc-commits] r2088 - pkg/gplots/R Message-ID: <20160324133847.54806186EBD@r-forge.r-project.org> Author: warnes Date: 2016-03-24 14:38:46 +0100 (Thu, 24 Mar 2016) New Revision: 2088 Modified: pkg/gplots/R/lmplot2.R Log: Indentation changes Modified: pkg/gplots/R/lmplot2.R =================================================================== --- pkg/gplots/R/lmplot2.R 2016-03-24 13:35:50 UTC (rev 2087) +++ pkg/gplots/R/lmplot2.R 2016-03-24 13:38:46 UTC (rev 2088) @@ -2,7 +2,7 @@ x, which = 1:5, caption = c("Residuals vs Fitted", "Normal Q-Q plot", - "Scale-Location plot", "Cook's distance plot"), + "Scale-Location plot", "Cook's distance plot"), panel = panel.smooth, sub.caption = deparse(x$call), main = "", @@ -17,163 +17,167 @@ max.n=5000 ) { - .Defunct("lmplot", "gplots") + .Defunct("lmplot", "gplots") } lmplot2 <- function( - x, - which = 1:5, - caption = c("Residuals vs Fitted", "Normal Q-Q plot", - "Scale-Location plot", "Cook's distance plot"), - panel = panel.smooth, - sub.caption = deparse(x$call), - main = "", - ask = interactive() && nb.fig < length(which) - && .Device != "postscript", - ..., - id.n = 3, - labels.id = names(residuals(x)), - cex.id = 0.75, - band=TRUE, - rug=TRUE, - width=1/10, - max.n=5000 - ) + x, + which = 1:5, + caption = c("Residuals vs Fitted", "Normal Q-Q plot", + "Scale-Location plot", "Cook's distance plot"), + panel = panel.smooth, + sub.caption = deparse(x$call), + main = "", + ask = interactive() && nb.fig < length(which) + && .Device != "postscript", + ..., + id.n = 3, + labels.id = names(residuals(x)), + cex.id = 0.75, + band=TRUE, + rug=TRUE, + width=1/10, + max.n=5000 + ) { - if (!inherits(x, "lm")) - stop("Use only with 'lm' objects") - show <- rep(FALSE, 5) - if(!is.numeric(which) || any(which < 1) || any(which > 5)) - stop("`which' must be in 1:5") - show[which] <- TRUE - r <- residuals(x) - n <- length(r) - if(inherits(x,"glm")) - yh <- predict(x) # != fitted() for glm - else - yh <- fitted(x) - if (any(show[2:4])) - s <- if(inherits(x, "rlm")) x$s else sqrt(deviance(x)/df.residual(x)) - if (any(show[2:3])) { - ylab23 <- if(inherits(x, "glm")) - "Std. deviance resid." else "Standardized residuals" - hii <- lm.influence(x)$hat - w <- weights(x) - # r.w := weighted.residuals(x): - r.w <- if(is.null(w)) r else (sqrt(w)*r)[w!=0] - rs <- r.w/(s * sqrt(1 - hii)) + if (!inherits(x, "lm")) + stop("Use only with 'lm' objects") + show <- rep(FALSE, 5) + if(!is.numeric(which) || any(which < 1) || any(which > 5)) + stop("`which' must be in 1:5") + show[which] <- TRUE + r <- residuals(x) + n <- length(r) + if(inherits(x,"glm")) + yh <- predict(x) # != fitted() for glm + else + yh <- fitted(x) + if (any(show[2:4])) + s <- if(inherits(x, "rlm")) x$s else sqrt(deviance(x)/df.residual(x)) + if (any(show[2:3])) + { + ylab23 <- if(inherits(x, "glm")) + "Std. deviance resid." else "Standardized residuals" + hii <- lm.influence(x)$hat + w <- weights(x) + # r.w := weighted.residuals(x): + r.w <- if(is.null(w)) r else (sqrt(w)*r)[w!=0] + rs <- r.w/(s * sqrt(1 - hii)) } - if (any(show[c(1,3)])) - l.fit <- if(inherits(x,"glm")) - "Predicted values" else "Fitted values" - if (is.null(id.n)) - id.n <- 0 - else { - id.n <- as.integer(id.n) - if(id.n < 0 || id.n > n) - stop(paste("`id.n' must be in { 1,..,",n,"}")) - } + if (any(show[c(1,3)])) + l.fit <- if(inherits(x,"glm")) + "Predicted values" else "Fitted values" + if (is.null(id.n)) + id.n <- 0 + else { + id.n <- as.integer(id.n) + if(id.n < 0 || id.n > n) + stop(paste("`id.n' must be in { 1,..,",n,"}")) + } + if(id.n > 0) { + if(is.null(labels.id)) + labels.id <- paste(1:n) + iid <- 1:id.n + show.r <- order(-abs(r))[iid] + if(any(show[2:3])) + show.rs <- order(-abs(rs))[iid] + text.id <- function(x,y, ind, adj.x = FALSE) + text(x - if(adj.x) strwidth(" ")*cex.id else 0, y, labels.id[ind], + cex = cex.id, xpd = TRUE, adj = if(adj.x) 1) + } + nb.fig <- prod(par("mfcol")) + one.fig <- prod(par("mfcol")) == 1 + if (ask) { + op <- par(ask = TRUE) + on.exit(par(op)) + } + + ##---------- Do the individual plots : ---------- + if (show[1]) { + ylim <- range(r) + if(id.n > 0) + ylim <- ylim + c(-1,1)* 0.08 * diff(ylim) + plot(yh, r, xlab = l.fit, ylab = "Residuals", main = main, + ylim = ylim, type = "n", ...) + panel(yh, r, ...) + if(rug) rug(yh) ## GRW 2001-06-08 + if(band) bandplot(yh,r,add=TRUE,width=width) ## GRW 2001-06-08 + if (one.fig) + title(sub = sub.caption, ...) + mtext(caption[1], 3, 0.25) if(id.n > 0) { - if(is.null(labels.id)) - labels.id <- paste(1:n) - iid <- 1:id.n - show.r <- order(-abs(r))[iid] - if(any(show[2:3])) - show.rs <- order(-abs(rs))[iid] - text.id <- function(x,y, ind, adj.x = FALSE) - text(x - if(adj.x) strwidth(" ")*cex.id else 0, y, labels.id[ind], - cex = cex.id, xpd = TRUE, adj = if(adj.x) 1) + y.id <- r[show.r] + y.id[y.id < 0] <- y.id[y.id < 0] - strheight(" ")/3 + text.id(yh[show.r], y.id, show.r, adj.x = TRUE) } - nb.fig <- prod(par("mfcol")) - one.fig <- prod(par("mfcol")) == 1 - if (ask) { - op <- par(ask = TRUE) - on.exit(par(op)) - } - ##---------- Do the individual plots : ---------- - if (show[1]) { - ylim <- range(r) - if(id.n > 0) - ylim <- ylim + c(-1,1)* 0.08 * diff(ylim) - plot(yh, r, xlab = l.fit, ylab = "Residuals", main = main, - ylim = ylim, type = "n", ...) - panel(yh, r, ...) - if(rug) rug(yh) ## GRW 2001-06-08 - if(band) bandplot(yh,r,add=TRUE,width=width) ## GRW 2001-06-08 - if (one.fig) - title(sub = sub.caption, ...) - mtext(caption[1], 3, 0.25) - if(id.n > 0) { - y.id <- r[show.r] - y.id[y.id < 0] <- y.id[y.id < 0] - strheight(" ")/3 - text.id(yh[show.r], y.id, show.r, adj.x = TRUE) - } - abline(h = 0, lty = 3, col = "gray") - } - if (show[2]) { - ylim <- range(rs) - ylim[2] <- ylim[2] + diff(ylim) * 0.075 - qq <- qqnorm(rs, main = main, ylab = ylab23, ylim = ylim, ...) - qqline(rs) - if (one.fig) - title(sub = sub.caption, ...) - mtext(caption[2], 3, 0.25) - if(id.n > 0) - text.id(qq$x[show.rs], qq$y[show.rs], show.rs, adj.x = TRUE) - } - if (show[3]) { - sqrtabsr <- sqrt(abs(rs)) - ylim <- c(0, max(sqrtabsr)) - yl <- as.expression(substitute(sqrt(abs(YL)), list(YL=as.name(ylab23)))) - yhn0 <- if(is.null(w)) yh else yh[w!=0] - plot(yhn0, sqrtabsr, xlab = l.fit, ylab = yl, main = main, - ylim = ylim, type = "n", ...) - panel(yhn0, sqrtabsr, ...) + abline(h = 0, lty = 3, col = "gray") + } + if (show[2]) { + ylim <- range(rs) + ylim[2] <- ylim[2] + diff(ylim) * 0.075 + qq <- qqnorm(rs, main = main, ylab = ylab23, ylim = ylim, ...) + qqline(rs) + if (one.fig) + title(sub = sub.caption, ...) + mtext(caption[2], 3, 0.25) + if(id.n > 0) + text.id(qq$x[show.rs], qq$y[show.rs], show.rs, adj.x = TRUE) + } + if (show[3]) { + sqrtabsr <- sqrt(abs(rs)) + ylim <- c(0, max(sqrtabsr)) + yl <- as.expression(substitute(sqrt(abs(YL)), list(YL=as.name(ylab23)))) + yhn0 <- if(is.null(w)) yh else yh[w!=0] + plot(yhn0, sqrtabsr, xlab = l.fit, ylab = yl, main = main, + ylim = ylim, type = "n", ...) + panel(yhn0, sqrtabsr, ...) - abline(h=mean(sqrtabsr),lty = 3, col = "gray") - if(rug) rug(yh) ## GRW 2001-06-08 - if(band) bandplot(yhn0,sqrtabsr,add=TRUE) ## GRW 2001-06-08 + abline(h=mean(sqrtabsr),lty = 3, col = "gray") + if(rug) rug(yh) ## GRW 2001-06-08 + if(band) bandplot(yhn0,sqrtabsr,add=TRUE) ## GRW 2001-06-08 - if (one.fig) - title(sub = sub.caption, ...) - mtext(caption[3], 3, 0.25) - if(id.n > 0) - text.id(yhn0[show.rs], sqrtabsr[show.rs], show.rs, adj.x = TRUE) - } - if (show[4]) { - cook <- cooks.distance(x, sd=s) - if(id.n > 0) { - show.r <- order(-cook)[iid]# index of largest `id.n' ones - ymx <- cook[show.r[1]] * 1.075 - } else ymx <- max(cook) - plot(cook, type = "h", ylim = c(0, ymx), main = main, - xlab = "Obs. number", ylab = "Cook's distance", ...) - if (one.fig) - title(sub = sub.caption, ...) - mtext(caption[4], 3, 0.25) - if(id.n > 0) - text.id(show.r, cook[show.r] + 0.4*cex.id * strheight(" "), show.r) - } - if (show[5]) + if (one.fig) + title(sub = sub.caption, ...) + mtext(caption[3], 3, 0.25) + if(id.n > 0) + text.id(yhn0[show.rs], sqrtabsr[show.rs], show.rs, adj.x = TRUE) + } + if (show[4]) { + cook <- cooks.distance(x, sd=s) + if(id.n > 0) { + show.r <- order(-cook)[iid]# index of largest `id.n' ones + ymx <- cook[show.r[1]] * 1.075 + } else ymx <- max(cook) + plot(cook, type = "h", ylim = c(0, ymx), main = main, + xlab = "Obs. number", ylab = "Cook's distance", ...) + if (one.fig) + title(sub = sub.caption, ...) + mtext(caption[4], 3, 0.25) + if(id.n > 0) + text.id(show.r, cook[show.r] + 0.4*cex.id * strheight(" "), show.r) + } + + if (show[5]) + { + ## plot residuals against each predictor ## + data <- model.frame(x) + for( i in 1:ncol(data) ) + { + test <- try( { - ## plot residuals against each predictor ## - data <- model.frame(x) - for( i in 2:ncol(data) ) - { - test <- try( - { - plot.default( x=data[,i], y=r, - xlab=names(data)[i], ylab="Residuals", type="n") - panel( data[,i], r, ... ) - if(rug) rug(data[,i]) - if(band) bandplot(data[,i],r,add=TRUE) - abline(h=0,lty = 3, col = "gray") - } - ) - } + plot.default( x=data[,i], y=r, + xlab=names(data)[i], ylab="Residuals", type="n") + panel( data[,i], r, ... ) + if(rug) rug(data[,i]) + if(band) bandplot(data[,i],r,add=TRUE) + abline(h=0,lty = 3, col = "gray") } - if (!one.fig && par("oma")[3] >= 1) - mtext(sub.caption, outer = TRUE, cex = 1.25) - invisible() + ) + } + } + + if (!one.fig && par("oma")[3] >= 1) + mtext(sub.caption, outer = TRUE, cex = 1.25) + invisible() } From noreply at r-forge.r-project.org Thu Mar 24 14:47:48 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Mar 2016 14:47:48 +0100 (CET) Subject: [R-gregmisc-commits] r2089 - in pkg/gplots: R man Message-ID: <20160324134748.D891E185671@r-forge.r-project.org> Author: warnes Date: 2016-03-24 14:47:48 +0100 (Thu, 24 Mar 2016) New Revision: 2089 Modified: pkg/gplots/R/smartlegend.R pkg/gplots/man/gplots-defunct.Rd pkg/gplots/man/gplots-deprecated.Rd Log: The smartlegend() function has been made defunct and is no longer available. Modified: pkg/gplots/R/smartlegend.R =================================================================== --- pkg/gplots/R/smartlegend.R 2016-03-24 13:38:46 UTC (rev 2088) +++ pkg/gplots/R/smartlegend.R 2016-03-24 13:47:48 UTC (rev 2089) @@ -3,54 +3,6 @@ smartlegend <- function(x=c("left","center","right"), y=c("top","center","bottom"), ..., inset=0.05 ) - { + .Defunct('legend', 'gplots') - .Deprecated('legend', 'graphics') - x <- match.arg(x) - y <- match.arg(y) - - usr <- par("usr") - inset.x <- inset * (usr[2] - usr[1]) - inset.y <- inset * (usr[4] - usr[3]) - - if(x=="left") - { - x.pos <- usr[1] + inset.x - xjust = 0 - } - else if(x=="center") - { - x.pos <- (usr[1] + usr[2])/2 - xjust = 0.5 - } - else # y=="right" - { - x.pos <- usr[2] - inset.x - xjust = 1 - } - - if(y=="bottom") - { - y.pos <- usr[3] + inset.y - yjust = 0 - } - else if(y=="center") - { - y.pos <- (usr[3] + usr[4])/2 - yjust = 0.5 - } - else - { - y.pos <- usr[4] - inset.y - yjust = 1 - } - - - if(par("xlog")) x.pos <- 10^x.pos - if(par("ylog")) y.pos <- 10^y.pos - - legend( x=x.pos, y=y.pos, ..., xjust=xjust, yjust=yjust) - } - - Modified: pkg/gplots/man/gplots-defunct.Rd =================================================================== --- pkg/gplots/man/gplots-defunct.Rd 2016-03-24 13:38:46 UTC (rev 2088) +++ pkg/gplots/man/gplots-defunct.Rd 2016-03-24 13:47:48 UTC (rev 2089) @@ -1,9 +1,10 @@ \name{gplots-defunct} \alias{boxplot.n} \alias{plot.lm2} +\alias{smartlegend} \title{Defunct functions} \description{ - These funcntion are defunct and have been removed from the gplots package. + These functions are defunct and have been removed from the gplots package. } \usage{ boxplot.n(..., top=FALSE, shrink=1, textcolor=NULL) @@ -25,6 +26,10 @@ width=1/10, max.n=5000 ) + smartlegend(x = c("left", "center", "right"), + y = c("top", "center", "bottom"), + ..., + inset = 0.05) } \arguments{ \item{\dots}{see man page for the corresponding replacement function} @@ -33,6 +38,7 @@ \item{x, which, caption, panel, sub.caption, main, ask, id.n, labels.id, cex.id, band, rug, width, max.n}{See man page for \code{\link{lmplot2}}.} + \item{x, y, inset, \dots}{see man page for the corresponding replacement function} } \details{ These functions are no longer available. Please refer to the manual page @@ -40,12 +46,15 @@ \itemize{ \item \code{boxplot.n} has been replaced by \code{\link{boxplot2}} \item \code{plot.lm2} has been replaced by \code{\link{lmplot2}} + \item \code{smartlegend} is no longer needed because relative + positioning has been implemented in \code{\link[graphics]{legend}}. } } \author{Gregory R. Warnes \email{greg at warnes.net}} \seealso{ \code{\link{boxplot2}}, \code{\link{lmplot2}}, + \code{\link[graphics]{legend}}, \code{\link[base]{Defunct}} } \keyword{misc} Modified: pkg/gplots/man/gplots-deprecated.Rd =================================================================== --- pkg/gplots/man/gplots-deprecated.Rd 2016-03-24 13:38:46 UTC (rev 2088) +++ pkg/gplots/man/gplots-deprecated.Rd 2016-03-24 13:47:48 UTC (rev 2089) @@ -1,31 +1,24 @@ \name{gplots-deprecated} \alias{deprecated} -\alias{smartlegend} \title{Deprecated functions} \description{ - These funcntion have been deprecated and will be removed in future + These functions have been deprecated and will be removed in future releases of gplots. } \usage{ -smartlegend(x = c("left", "center", "right"), - y = c("top", "center", "bottom"), - ..., - inset = 0.05) + (No deprecated functions at this time) } \arguments{ - \item{x, y, inset, \dots}{see man page for the corresponding replacement function} } \details{ These functions have been deprecated. Please refer to the manual page for the replacement function: \itemize{ - \item \code{smartlegend} is no longer needed because relative - positioning has been implemented in graphics::legend(). + \item (No deprecated functions at this time) } } \author{Gregory R. Warnes \email{greg at warnes.net}} \seealso{ - \code{\link{legend}}, \code{\link[base]{Deprecated}} } \keyword{misc} From noreply at r-forge.r-project.org Thu Mar 24 16:01:03 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Mar 2016 16:01:03 +0100 (CET) Subject: [R-gregmisc-commits] r2090 - in pkg/gplots: R man Message-ID: <20160324150103.6EF45186EBD@r-forge.r-project.org> Author: warnes Date: 2016-03-24 16:01:02 +0100 (Thu, 24 Mar 2016) New Revision: 2090 Added: pkg/gplots/R/vennMembers.R Modified: pkg/gplots/R/venn.R pkg/gplots/man/venn.Rd Log: The 'intersections' attribute returned from venn() has been improved to use set names instead of indicators, and is ordered from simplest to most complex set interactions. Modified: pkg/gplots/R/venn.R =================================================================== --- pkg/gplots/R/venn.R 2016-03-24 13:47:48 UTC (rev 2089) +++ pkg/gplots/R/venn.R 2016-03-24 15:01:02 UTC (rev 2090) @@ -34,121 +34,121 @@ # l offers a list of arrays, their values are to # be tested for the size of their intersects. getVennCounts.list<-function(l, universe=NA, verbose=F, intersections=TRUE) { - if (verbose) cat("Interpreting data as list.\n") - numSets<-length(l) - result.table<-NULL - result.table.names<-NULL + if (verbose) cat("Interpreting data as list.\n") + numSets<-length(l) + result.table<-NULL + result.table.names<-NULL - memberList <- list() + memberList <- list() - # Iteration over all possible intersections involving all sets - # or the complement (negation) of those sets. - for (i in 0:(-1 + 2^numSets)) { - # i2 is a binary representation of that number - i2<-baseOf(i,2,numSets) + # Iteration over all possible intersections involving all sets + # or the complement (negation) of those sets. + for (i in 0:(-1 + 2^numSets)) { + # i2 is a binary representation of that number + i2<-baseOf(i,2,numSets) - # some debug output - #print(paste(i,":",paste(i2,collapse="",sep=""))) + # some debug output + #print(paste(i,":",paste(i2,collapse="",sep=""))) - # p.pos determines the position in number - # which is also the set that is inspected + # p.pos determines the position in number + # which is also the set that is inspected - sel<-universe + sel<-universe - # positive selection first - for (p.pos in which(1 == i2) ) { - current.set<-l[[p.pos]] - if (!is.null(dim(current.set))) { - # circumventing strange experiences with data.frames - warning(paste("List element [[",p.pos,"]] has dimensions, but all elements are considered.\n",sep="")) - current.set<-as.character(as.matrix(current.set)) - dim(current.set)<-NULL - } - #print(paste("set ",p.pos,", val=1: ",paste(current.set,collapse=","))) - if (is.null(sel)) { - #print("Sel is null") - } else if (1 == length(sel) && is.na(sel)) { - sel<-current.set - } - else { - w<-which(sel %in% current.set) - if (length(w)>0) { - sel<-sel[w] - } - else { - sel<-NULL - } - } - } + # positive selection first + for (p.pos in which(1 == i2) ) { + current.set<-l[[p.pos]] + if (!is.null(dim(current.set))) { + # circumventing strange experiences with data.frames + warning(paste("List element [[",p.pos,"]] has dimensions, but all elements are considered.\n",sep="")) + current.set<-as.character(as.matrix(current.set)) + dim(current.set)<-NULL + } + #print(paste("set ",p.pos,", val=1: ",paste(current.set,collapse=","))) + if (is.null(sel)) { + #print("Sel is null") + } else if (1 == length(sel) && is.na(sel)) { + sel<-current.set + } + else { + w<-which(sel %in% current.set) + if (length(w)>0) { + sel<-sel[w] + } + else { + sel<-NULL + } + } + } - # something should be in sel now, otherwise - # the number will be 0 + # something should be in sel now, otherwise + # the number will be 0 - # negative selection - for (p.pos in which(0 == i2) ) { - if (is.null(sel) || ( 1 == length(sel) && is.na(sel))) { - # The complement is not known, hence no checks done - } - else { - current.set<-l[[p.pos]] - if (!is.null(dim(current.set))) { - warning(paste("List element [[",p.pos,"]] has dimensions, but all elements are considered.\n",sep="")) - current.set<-as.character(as.matrix(current.set)) - dim(current.set)<-NULL - } - w<-which( ! sel %in% current.set) - #print(paste("set ",p.pos,", val=1: ",paste(current.set,collapse=","))) - if (length(w)>0) { - sel<-sel[w] - } - else { - sel<-NULL - } - } - } - #print(paste("sel:",paste(sel,collapse=","))) + # negative selection + for (p.pos in which(0 == i2) ) { + if (is.null(sel) || ( 1 == length(sel) && is.na(sel))) { + # The complement is not known, hence no checks done + } + else { + current.set<-l[[p.pos]] + if (!is.null(dim(current.set))) { + warning(paste("List element [[",p.pos,"]] has dimensions, but all elements are considered.\n",sep="")) + current.set<-as.character(as.matrix(current.set)) + dim(current.set)<-NULL + } + w<-which( ! sel %in% current.set) + #print(paste("set ",p.pos,", val=1: ",paste(current.set,collapse=","))) + if (length(w)>0) { + sel<-sel[w] + } + else { + sel<-NULL + } + } + } + #print(paste("sel:",paste(sel,collapse=","))) - if(is.null(sel) || (1 == length(sel) && is.na(sel))) { - sel<-NULL - } + if(is.null(sel) || (1 == length(sel) && is.na(sel))) { + sel<-NULL + } - r.name<-paste(i2,collapse="") - if (intersections) { - memberList[[r.name]] <- sel - } + r.name<-paste(i2,collapse="") + if (intersections) { + memberList[[r.name]] <- sel + } - r<-length(sel) - result.row<-c(r,i2) - dim(result.row)<-c(1,length(result.row)) - rownames(result.row)<-c(r.name) - #print(paste("Adding ",r.name)) - if (is.null(result.table)) { - result.table<-result.row - } - else { - result.table<-rbind(result.table,result.row) - } - #if (is.null(result.table)) { - # result.table<-r - # result.table.names<-r.name - #} - #else { - # result.table<-c(result.table,r) - # result.table.names<-c(result.table.names,r.name) - #} - } - #names(result.table)<-result.table.names - if (is.null(names(l))) { - colnames(result.table)<-c("num",LETTERS[1:numSets]) - } - else{ - colnames(result.table)<-c("num",names(l)) - } - if (intersections) { - attr(result.table,"intersections") <- memberList - } - class(result.table) <- "venn" - return(result.table) + r<-length(sel) + result.row<-c(r,i2) + dim(result.row)<-c(1,length(result.row)) + rownames(result.row)<-c(r.name) + #print(paste("Adding ",r.name)) + if (is.null(result.table)) { + result.table<-result.row + } + else { + result.table<-rbind(result.table,result.row) + } + #if (is.null(result.table)) { + # result.table<-r + # result.table.names<-r.name + #} + #else { + # result.table<-c(result.table,r) + # result.table.names<-c(result.table.names,r.name) + #} + } + #names(result.table)<-result.table.names + if (is.null(names(l))) { + colnames(result.table)<-c("num",LETTERS[1:numSets]) + } + else{ + colnames(result.table)<-c("num",names(l)) + } + if (intersections) { + attr(result.table,"intersections") <- memberList + } + class(result.table) <- "venn" + return(result.table) } #print(getVennCounts(list(A,B,C,D))) @@ -160,17 +160,30 @@ showSetLogicLabel=FALSE, simplify=FALSE, show.plot=TRUE, - intersections=TRUE) + intersections=TRUE, + names, + ... + ) { - counts <- getVennCounts(data, universe=universe, intersections=intersections) - + counts <- getVennCounts(data, + universe=universe, + intersections=intersections + ) + if(show.plot) drawVennDiagram(data=counts, small=small, showSetLogicLabel=showSetLogicLabel, - simplify=simplify + simplify=simplify, + ... ) + # use VennMemberNames to properly label and order the 'intersection' table + if(intersections) + attr(counts, "intersections") <- vennMembers(l=data, + universe=universe, + names=names + ) invisible(counts) } Added: pkg/gplots/R/vennMembers.R =================================================================== --- pkg/gplots/R/vennMembers.R (rev 0) +++ pkg/gplots/R/vennMembers.R 2016-03-24 15:01:02 UTC (rev 2090) @@ -0,0 +1,41 @@ +# Extract intersections +vennMembers <- function(l, universe=NA, names, ...) +{ + venn_object <- getVennCounts(l, universe, intersections=TRUE, ...) + map <- attr(venn_object, "intersections") + if(missing(names)) + names <- colnames(venn_object)[-1] + + if(is.matrix(l) || is.data.frame(l)) + { + ids <- rownames(l) + retval <- list() + for(i in names(map)) + retval[[i]] <- ids[map[[i]]] + } + else if(is.list(l)) + retval <- map + + + flags <- do.call(rbind, strsplit(names(map), character(0), fixed=TRUE)) + rownames(flags) <- names(map) + colnames(flags) <- names + nameList <- list() + for(i in 1:nrow(flags)) nameList[[i]] <- ifelse(flags[i,]=="1", colnames(flags), "") + nameList <- do.call(data.frame,nameList) + nameList <- apply(nameList, 2, paste, collapse=":") + nameList <- gsub('::+', ':', nameList) + nameList <- gsub('^:+', '', nameList) + nameList <- gsub(':+$', '', nameList) + + names(retval) <- nameList + + sortTab <- cbind(sapply(nameList, nchar), nameList) + ord <- order(sortTab[,1], sortTab[,2]) + + retval <- retval[ord] + + retval <- lapply(retval, as.character) + + retval +} Modified: pkg/gplots/man/venn.Rd =================================================================== --- pkg/gplots/man/venn.Rd 2016-03-24 13:47:48 UTC (rev 2089) +++ pkg/gplots/man/venn.Rd 2016-03-24 15:01:02 UTC (rev 2090) @@ -7,7 +7,7 @@ } \usage{ venn(data, universe=NA, small=0.7, showSetLogicLabel=FALSE, - simplify=FALSE, show.plot=TRUE, intersections=TRUE) + simplify=FALSE, show.plot=TRUE, intersections=TRUE, names) \method{plot}{venn}(x, y, ..., small=0.7, showSetLogicLabel=FALSE, simplify=FALSE) } @@ -40,10 +40,16 @@ names. } \value{ - Invisibly returns an object of class "venn", containing a matrix of - all possible sets of groups, and the observed count of items belonging - to each The fist column contains observed counts, subsequent columns - contain 0-1 indicators of group intersectionship. + Invisibly returns an object of class "venn", containing: + \itemize{ + \item A matrix of all possible sets of groups, and the observed count + of items belonging to each The fist column contains observed + counts, subsequent columns contain 0-1 indicators of group + intersectionship. + \item If \code{intersections=TRUE}, the attribute \code{intersections} + will be a list of vectors containing the names of the elements + belonging to each subset. + } } \author{ Steffen Moeller \email{steffen\_moeller at gmx.de}, @@ -114,34 +120,34 @@ ## ## Example to determine which elements are in A and B but not in -## C and D: first determine the universe, then form indicator columns -## and perform intersections on these. R allows using the set operations -## directly, but some might find this approach more intuitive. +## C and D using the 'intersections' attribute. ## +tmp <- venn(input, intersection=TRUE) +isect <- attr(tmp, "intersection") -universe <- unique(c(GroupA,GroupB,GroupC,GroupD)) -GroupA.l <-universe \%in\% GroupA -GroupB.l <-universe \%in\% GroupB -GroupC.l <-universe \%in\% GroupC -GroupD.l <-universe \%in\% GroupD +# Look at all of the subsets +str(isect) -## Genes that are in GroupA and in GroupB but not in GroupD (unification -## of sets III0 and II00 in the venn diagram: -universe[GroupA.l & GroupB.l & !GroupD.l] +# Extract and combine the subsets of interest.. +AandB <- unique(c(int$A, int$B, int$'A:B')) -## -## Alternatively: construct a function to test for the pattern you want. -## -test <- function(x) (x \%in\% GroupA) & (x \%in\% GroupB) & !(x \%in\% GroupC) -universe[ test(universe) ] +# and look at the results +str(AandB) ## -## Intriduced with gplots 2.16, the names of individuals for everz intersection -## is offered as an attribute to the retrun value. +## The full set of elements of each intersection is provided in the +## "interesections" attribute. ## a<-venn(list(1:5,3:8), show.plot=FALSE) intersections<-attr(a,"intersections") print(intersections) - +# $A +# [1] "1" "2" +# +# $B +# [1] "6" "7" "8" +# +# $`A:B` +# [1] "3" "4" "5" } \keyword{hplot} From noreply at r-forge.r-project.org Thu Mar 24 17:07:06 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Mar 2016 17:07:06 +0100 (CET) Subject: [R-gregmisc-commits] r2091 - pkg/gplots/R Message-ID: <20160324160706.E9B80187CFC@r-forge.r-project.org> Author: warnes Date: 2016-03-24 17:07:06 +0100 (Thu, 24 Mar 2016) New Revision: 2091 Modified: pkg/gplots/R/lowess.R pkg/gplots/R/plot.lowess.R Log: Rename plot.lowess to plotLowess to avoid confusions with plot() method for class 'lowess', create a plot() method for class 'lowess' and modify the lowess.default() and lowess.formula() to add the 'lowess' class to the returned object, along with a 'call' list element. Modified: pkg/gplots/R/lowess.R =================================================================== --- pkg/gplots/R/lowess.R 2016-03-24 15:01:02 UTC (rev 2090) +++ pkg/gplots/R/lowess.R 2016-03-24 16:07:06 UTC (rev 2091) @@ -1,6 +1,19 @@ # make stats::lowess into a generic base-function -lowess.default <- stats::lowess +lowess.default <- function (x, y = NULL, + f = 2/3, + iter = 3L, + delta = 0.01 * diff(range(x)), + ...) + { + m <- match.call() + m[[1L]] <- quote(stats::lowess) + retval <- eval(m, envir=parent.frame()) + class(retval) <- "lowess" + retval$call <- match.call() + retval + } + # add "..." to the argument list to match the generic formals(lowess.default) <- c(formals(lowess.default),alist(...= )) @@ -9,12 +22,12 @@ "lowess.formula" <- function (formula, - data = parent.frame(), + data = parent.frame(), ..., - subset, - f=2/3, + subset, + f=2/3, iter=3, - delta=.01*diff(range(mf[-response])) + delta=.01*diff(range(mf[-response])) ) { if (missing(formula) || (length(formula) != 3)) @@ -23,7 +36,7 @@ m <- match.call(expand.dots = FALSE) eframe <- parent.frame() md <- eval(m$data, eframe) - if (is.matrix(md)) + if (is.matrix(md)) m$data <- md <- as.data.frame(data) dots <- lapply(m$..., eval, md, eframe) nmdots <- names(dots) @@ -37,15 +50,19 @@ if (!missing(subset)) { s <- eval(subset.expr, data, eframe) l <- nrow(mf) - dosub <- function(x) if (length(x) == l) + dosub <- function(x) if (length(x) == l) x[s] else x dots <- lapply(dots, dosub) mf <- mf[s, ] } - + mf <- na.omit(mf) - + response <- attr(attr(mf, "terms"), "response" ) - lowess.default(mf[[-response]], mf[[response]], f=f, iter=iter, delta=delta) + retval <- stats::lowess(mf[[-response]], mf[[response]], f=f, iter=iter, delta=delta) + class(retval) <- "lowess" + retval$call <- match.call() + + retval } Modified: pkg/gplots/R/plot.lowess.R =================================================================== --- pkg/gplots/R/plot.lowess.R 2016-03-24 15:01:02 UTC (rev 2090) +++ pkg/gplots/R/plot.lowess.R 2016-03-24 16:07:06 UTC (rev 2091) @@ -1,10 +1,22 @@ -plot.lowess <- function (formula, data = parent.frame(), ..., subset=parent.frame(), col.lowess="red", lty.lowess=2 ) +plotLowess <- function (formula, data = parent.frame(), ..., subset=parent.frame(), + col.lowess="red", + lty.lowess=2 ) { m <- match.call(expand.dots=TRUE) m[[1]] <- as.name("plot") eval(m) m[[1]] <- as.name("lowess") lw <- eval(m) - lines(lw, col=col.lowess, lty=lty.lowess) + lines(lw, col=col.lowess, lty=lty.lowess) grid() } + +plot.lowess <- function(x, y, ..., col.lowess="red", lty.lowess=2) +{ + m <- x$call + m[[1]] <- quote(plot) + eval(m, envir = parent.frame()) + + lines(x$x, x$y, col=col.lowess, lty=lty.lowess) + grid() +} From noreply at r-forge.r-project.org Fri Mar 25 14:40:04 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 14:40:04 +0100 (CET) Subject: [R-gregmisc-commits] r2092 - pkg/gplots/R Message-ID: <20160325134004.A7069184A5B@r-forge.r-project.org> Author: warnes Date: 2016-03-25 14:40:03 +0100 (Fri, 25 Mar 2016) New Revision: 2092 Modified: pkg/gplots/R/heatmap.2.R Log: Corrected a bug causing "Error in plot.new() : figure margins too large" to occur when 'key=FALSE'. (Reported and patch provided by Sveinung Gundersen.) Modified: pkg/gplots/R/heatmap.2.R =================================================================== --- pkg/gplots/R/heatmap.2.R 2016-03-24 16:07:06 UTC (rev 2091) +++ pkg/gplots/R/heatmap.2.R 2016-03-25 13:40:03 UTC (rev 2092) @@ -761,8 +761,10 @@ } else - plot.new() - + { + par(mar=c(0, 0, 0, 0)) + plot.new() + } ## Create a table showing how colors match to (transformed) data ranges retval$colorTable <- data.frame( low=retval$breaks[-length(retval$breaks)], From noreply at r-forge.r-project.org Fri Mar 25 14:41:07 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 14:41:07 +0100 (CET) Subject: [R-gregmisc-commits] r2093 - pkg/gplots/R Message-ID: <20160325134107.DDA6A184A5B@r-forge.r-project.org> Author: warnes Date: 2016-03-25 14:41:06 +0100 (Fri, 25 Mar 2016) New Revision: 2093 Modified: pkg/gplots/R/plot.lowess.R Log: Ensure extra arguments are properly passed to the plot call. Modified: pkg/gplots/R/plot.lowess.R =================================================================== --- pkg/gplots/R/plot.lowess.R 2016-03-25 13:40:03 UTC (rev 2092) +++ pkg/gplots/R/plot.lowess.R 2016-03-25 13:41:06 UTC (rev 2093) @@ -15,6 +15,7 @@ { m <- x$call m[[1]] <- quote(plot) + m <- as.call(append(as.list(m), list(...))) eval(m, envir = parent.frame()) lines(x$x, x$y, col=col.lowess, lty=lty.lowess) From noreply at r-forge.r-project.org Fri Mar 25 14:41:59 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 14:41:59 +0100 (CET) Subject: [R-gregmisc-commits] r2094 - pkg/gplots/man Message-ID: <20160325134159.6D0B2184A5B@r-forge.r-project.org> Author: warnes Date: 2016-03-25 14:41:59 +0100 (Fri, 25 Mar 2016) New Revision: 2094 Modified: pkg/gplots/man/lowess.Rd Log: Update man page for lowess to reflect new lowess method for plot(). Modified: pkg/gplots/man/lowess.Rd =================================================================== --- pkg/gplots/man/lowess.Rd 2016-03-25 13:41:06 UTC (rev 2093) +++ pkg/gplots/man/lowess.Rd 2016-03-25 13:41:59 UTC (rev 2094) @@ -19,13 +19,15 @@ \alias{lowess} \alias{lowess.default} \alias{lowess.formula} +\alias{plot.lowess} \title{Scatter Plot Smoothing} \usage{ lowess(x, ...) \method{lowess}{default}(x, y = NULL, f = 2/3, iter = 3, delta = 0.01 * diff(range(x)), ...) -\method{lowess}{formula}(formula,data = parent.frame(), subset, na.action, +\method{lowess}{formula}(formula,data = parent.frame(), subset, na.action, f=2/3, iter=3, delta=.01*diff(range(mf[-response])), ... ) +\method{plot}{lowess}(x, y, ..., col.lowess = "red", lty.lowess = 2) } \alias{lowess} \arguments{ @@ -52,14 +54,17 @@ of `options', and is `na.fail' if that is unset. The ``factory-fresh'' default is `na.omit'.} \item{...}{parameters for methods.} + \item{col.lowess, lty.lowess}{color and line type for plotted line} } \description{ This function performs the computations for the \emph{LOWESS} smoother (see the reference below). - \code{lowess} returns a list containing components + \code{lowess} returns a an object containing components \code{x} and \code{y} which give the coordinates of the smooth. - The smooth should be added to a plot of the original - points with the function \code{lines}. + The smooth can be added to a plot of the original + points with the function \code{lines}, or \code{plot} can be + directly on the lowess object to generate a scatterplot with + the lowess line superimposed. } \references{ Cleveland, W. S. (1979) @@ -88,5 +93,13 @@ lines(lowess(dist ~ speed, data=cars, f=.2), col = 3) legend(5, 120, c(paste("f = ", c("2/3", ".2"))), lty = 1, col = 2:3) +# plot example +plot(lowess(dist ~ speed, data=cars), main = "lowess(cars)") +# is equivalent to +plot(dist ~ speed, data=cars, main = "lowess(cars)") +lines(lowess(dist ~ speed, data=cars), col = 2) +grid() + + } \keyword{smooth} From noreply at r-forge.r-project.org Fri Mar 25 15:17:30 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 15:17:30 +0100 (CET) Subject: [R-gregmisc-commits] r2095 - pkg/gplots/R Message-ID: <20160325141730.DA0F118698D@r-forge.r-project.org> Author: warnes Date: 2016-03-25 15:17:30 +0100 (Fri, 25 Mar 2016) New Revision: 2095 Modified: pkg/gplots/R/plot.lowess.R Log: Ensure lowess plot methods (invisibly) return the lowess object. Modified: pkg/gplots/R/plot.lowess.R =================================================================== --- pkg/gplots/R/plot.lowess.R 2016-03-25 13:41:59 UTC (rev 2094) +++ pkg/gplots/R/plot.lowess.R 2016-03-25 14:17:30 UTC (rev 2095) @@ -9,6 +9,8 @@ lw <- eval(m) lines(lw, col=col.lowess, lty=lty.lowess) grid() + + invisible(lw) } plot.lowess <- function(x, y, ..., col.lowess="red", lty.lowess=2) @@ -20,4 +22,6 @@ lines(x$x, x$y, col=col.lowess, lty=lty.lowess) grid() + + invisible(x) } From noreply at r-forge.r-project.org Fri Mar 25 15:18:42 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 15:18:42 +0100 (CET) Subject: [R-gregmisc-commits] r2096 - pkg/gplots Message-ID: <20160325141842.D734318760D@r-forge.r-project.org> Author: warnes Date: 2016-03-25 15:18:41 +0100 (Fri, 25 Mar 2016) New Revision: 2096 Modified: pkg/gplots/NAMESPACE Log: Add plotLowess() and plot.lowess() to the NAMESPACE Modified: pkg/gplots/NAMESPACE =================================================================== --- pkg/gplots/NAMESPACE 2016-03-25 14:17:30 UTC (rev 2095) +++ pkg/gplots/NAMESPACE 2016-03-25 14:18:41 UTC (rev 2096) @@ -1,4 +1,5 @@ export( + angleAxis, balloonplot, bandplot, barplot2, @@ -19,6 +20,7 @@ plot.lm2, plot.venn, plotCI, + plotLowess, plotmeans, qqnorm.aov, redblue, @@ -59,7 +61,10 @@ S3method(lowess, formula) S3method(ooplot, default) + +S3method(plot, lowess) S3method(plot, venn) + S3method(print, ci2d) S3method(print, hist2d) From noreply at r-forge.r-project.org Fri Mar 25 17:13:16 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 17:13:16 +0100 (CET) Subject: [R-gregmisc-commits] r2097 - pkg/gplots/man Message-ID: <20160325161316.4A6A6187E43@r-forge.r-project.org> Author: warnes Date: 2016-03-25 17:13:15 +0100 (Fri, 25 Mar 2016) New Revision: 2097 Modified: pkg/gplots/man/lowess.Rd Log: Improve lowess() man page Modified: pkg/gplots/man/lowess.Rd =================================================================== --- pkg/gplots/man/lowess.Rd 2016-03-25 14:18:41 UTC (rev 2096) +++ pkg/gplots/man/lowess.Rd 2016-03-25 16:13:15 UTC (rev 2097) @@ -20,6 +20,7 @@ \alias{lowess.default} \alias{lowess.formula} \alias{plot.lowess} +\alias{plotLowess} \title{Scatter Plot Smoothing} \usage{ lowess(x, ...) @@ -27,7 +28,11 @@ diff(range(x)), ...) \method{lowess}{formula}(formula,data = parent.frame(), subset, na.action, f=2/3, iter=3, delta=.01*diff(range(mf[-response])), ... ) + \method{plot}{lowess}(x, y, ..., col.lowess = "red", lty.lowess = 2) + +plotLowess(formula, data = parent.frame(), ..., subset=parent.frame(), + col.lowess="red", lty.lowess=2 ) } \alias{lowess} \arguments{ @@ -35,36 +40,44 @@ an single independent variable (x) to use as coordinates in the scatter plot.} \item{data}{a data.frame (or list) from which the variables in `formula' - should be taken.} - \item{subset}{ an optional vector specifying a subset of observations to be - used in the fitting process. } - \item{x, y}{vectors giving the coordinates of the points in the scatter plot. - Alternatively a single plotting structure can be specified.} + should be taken.} + \item{subset}{ an optional vector specifying a subset of observations + to be used in the fitting process. } + \item{x, y}{vectors giving the coordinates of the points in the scatter + plot. Alternatively a single plotting structure can be specified.} \item{f}{the smoother span. This gives the proportion of points in the plot which influence the smooth at each value. Larger values give more smoothness.} \item{iter}{the number of robustifying iterations which should be performed. - Using smaller values of \code{iter} will make \code{lowess} run faster.} + Using smaller values of \code{iter} will make \code{lowess} run + faster.} \item{delta}{values of \code{x} which lie within \code{delta} of each other replaced by a single value in the output from \code{lowess}.} - \item{na.action}{a function which indicates what should happen when the data - contain `NA's. The default is set by the `na.action' setting - of `options', and is `na.fail' if that is unset. The - ``factory-fresh'' default is `na.omit'.} + \item{na.action}{a function which indicates what should happen when the + data contain `NA's. The default is set by the `na.action' setting + of `options', and is `na.fail' if that is unset. The ``factory-fresh'' + default is `na.omit'.} \item{...}{parameters for methods.} \item{col.lowess, lty.lowess}{color and line type for plotted line} } \description{ - This function performs the computations for the + The \code{lowess} function performs the computations for the \emph{LOWESS} smoother (see the reference below). \code{lowess} returns a an object containing components \code{x} and \code{y} which give the coordinates of the smooth. - The smooth can be added to a plot of the original - points with the function \code{lines}, or \code{plot} can be - directly on the lowess object to generate a scatterplot with - the lowess line superimposed. + The smooth can then be added to a plot of the original + points with the function \code{lines}. + + Alternatively, \code{plot} can be called directly on the object + returned from \code{lowess} and the 'lowess' method for \code{plot} + will generate a scatterplot of the original data with a \code{lowess} + line superimposed. + + Finally, the \code{plotLowess} function both calculates the + \code{lowess} smooth and plots the original data with a \code{lowess} + smooth. } \references{ Cleveland, W. S. (1979) @@ -81,25 +94,33 @@ \examples{ data(cars) -# default method -plot(cars, main = "lowess(cars)") -lines(lowess(cars), col = 2) -lines(lowess(cars, f=.2), col = 3) +# +# x,y method +# +plot(cars$speed, cars$dist, main = "lowess(cars)") +lines(lowess(cars$speed, cars$dist), col = 2) +lines(lowess(cars$speed, cars$dist, f=.2), col = 3) legend(5, 120, c(paste("f = ", c("2/3", ".2"))), lty = 1, col = 2:3) -# formula method +# +# formula method: plot, then calculate the lowess smoother, +# then add smooth to the plot +# plot(dist ~ speed, data=cars, main = "lowess(cars)") -lines(lowess(dist ~ speed, data=cars), col = 2) -lines(lowess(dist ~ speed, data=cars, f=.2), col = 3) +lines(lowess(dist ~ speed, data=cars), col = 2, lty=2) +lines(lowess(dist ~ speed, data=cars, f=.2), col = 3) # smaller bandwith legend(5, 120, c(paste("f = ", c("2/3", ".2"))), lty = 1, col = 2:3) -# plot example -plot(lowess(dist ~ speed, data=cars), main = "lowess(cars)") -# is equivalent to -plot(dist ~ speed, data=cars, main = "lowess(cars)") -lines(lowess(dist ~ speed, data=cars), col = 2) -grid() +# +# formula method: calculate lowess() smoother, then call plot() +# on the lowess object +# +lw <- lowess(dist ~ speed, data=cars) +plot(lw, main = "lowess(cars)" ) - +# +# formula method: calculate and plot in a single command +# +plotLowess(dist ~ speed, data=cars, main = "lowess(cars)") } \keyword{smooth} From noreply at r-forge.r-project.org Fri Mar 25 17:27:48 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 17:27:48 +0100 (CET) Subject: [R-gregmisc-commits] r2098 - pkg/gplots/R Message-ID: <20160325162748.8AD89187E43@r-forge.r-project.org> Author: warnes Date: 2016-03-25 17:27:48 +0100 (Fri, 25 Mar 2016) New Revision: 2098 Modified: pkg/gplots/R/lmplot2.R Log: Fix name of replacement functon in defuct message generated by plot.lm2 Modified: pkg/gplots/R/lmplot2.R =================================================================== --- pkg/gplots/R/lmplot2.R 2016-03-25 16:13:15 UTC (rev 2097) +++ pkg/gplots/R/lmplot2.R 2016-03-25 16:27:48 UTC (rev 2098) @@ -17,7 +17,7 @@ max.n=5000 ) { - .Defunct("lmplot", "gplots") + .Defunct("lmplot2", "gplots") } @@ -157,7 +157,7 @@ if(id.n > 0) text.id(show.r, cook[show.r] + 0.4*cex.id * strheight(" "), show.r) } - + if (show[5]) { ## plot residuals against each predictor ## @@ -176,7 +176,7 @@ ) } } - + if (!one.fig && par("oma")[3] >= 1) mtext(sub.caption, outer = TRUE, cex = 1.25) invisible() From noreply at r-forge.r-project.org Fri Mar 25 17:31:45 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 17:31:45 +0100 (CET) Subject: [R-gregmisc-commits] r2099 - pkg/gplots/man Message-ID: <20160325163145.C0F9B18760D@r-forge.r-project.org> Author: warnes Date: 2016-03-25 17:31:45 +0100 (Fri, 25 Mar 2016) New Revision: 2099 Modified: pkg/gplots/man/lowess.Rd Log: Correct differences between calls on man page and in code Modified: pkg/gplots/man/lowess.Rd =================================================================== --- pkg/gplots/man/lowess.Rd 2016-03-25 16:27:48 UTC (rev 2098) +++ pkg/gplots/man/lowess.Rd 2016-03-25 16:31:45 UTC (rev 2099) @@ -24,14 +24,16 @@ \title{Scatter Plot Smoothing} \usage{ lowess(x, ...) -\method{lowess}{default}(x, y = NULL, f = 2/3, iter = 3, delta = 0.01 * - diff(range(x)), ...) -\method{lowess}{formula}(formula,data = parent.frame(), subset, na.action, - f=2/3, iter=3, delta=.01*diff(range(mf[-response])), ... ) -\method{plot}{lowess}(x, y, ..., col.lowess = "red", lty.lowess = 2) +\method{lowess}{default}(x, y=NULL, f=2/3, iter=3L, delta=0.01 * + diff(range(x)), ...) -plotLowess(formula, data = parent.frame(), ..., subset=parent.frame(), +\method{lowess}{formula}(formula,data=parent.frame(), subset, f=2/3, + iter=3L, delta=.01*diff(range(mf[-response])), ... ) + +\method{plot}{lowess}(x, y, ..., col.lowess="red", lty.lowess=2) + +plotLowess(formula, data=parent.frame(), ..., subset=parent.frame(), col.lowess="red", lty.lowess=2 ) } \alias{lowess} @@ -97,30 +99,30 @@ # # x,y method # -plot(cars$speed, cars$dist, main = "lowess(cars)") -lines(lowess(cars$speed, cars$dist), col = 2) -lines(lowess(cars$speed, cars$dist, f=.2), col = 3) -legend(5, 120, c(paste("f = ", c("2/3", ".2"))), lty = 1, col = 2:3) +plot(cars$speed, cars$dist, main="lowess(cars)") +lines(lowess(cars$speed, cars$dist), col=2) +lines(lowess(cars$speed, cars$dist, f=.2), col=3) +legend(5, 120, c(paste("f=", c("2/3", ".2"))), lty=1, col=2:3) # # formula method: plot, then calculate the lowess smoother, # then add smooth to the plot # -plot(dist ~ speed, data=cars, main = "lowess(cars)") -lines(lowess(dist ~ speed, data=cars), col = 2, lty=2) -lines(lowess(dist ~ speed, data=cars, f=.2), col = 3) # smaller bandwith -legend(5, 120, c(paste("f = ", c("2/3", ".2"))), lty = 1, col = 2:3) +plot(dist ~ speed, data=cars, main="lowess(cars)") +lines(lowess(dist ~ speed, data=cars), col=2, lty=2) +lines(lowess(dist ~ speed, data=cars, f=.2), col=3) # smaller bandwith +legend(5, 120, c(paste("f=", c("2/3", ".2"))), lty=1, col=2:3) # # formula method: calculate lowess() smoother, then call plot() # on the lowess object # lw <- lowess(dist ~ speed, data=cars) -plot(lw, main = "lowess(cars)" ) +plot(lw, main="lowess(cars)" ) # # formula method: calculate and plot in a single command # -plotLowess(dist ~ speed, data=cars, main = "lowess(cars)") +plotLowess(dist ~ speed, data=cars, main="lowess(cars)") } \keyword{smooth} From noreply at r-forge.r-project.org Fri Mar 25 17:33:51 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 17:33:51 +0100 (CET) Subject: [R-gregmisc-commits] r2100 - pkg/gplots/man Message-ID: <20160325163351.ECE6418760D@r-forge.r-project.org> Author: warnes Date: 2016-03-25 17:33:51 +0100 (Fri, 25 Mar 2016) New Revision: 2100 Modified: pkg/gplots/man/venn.Rd Log: Correct discrepencies in man page Modified: pkg/gplots/man/venn.Rd =================================================================== --- pkg/gplots/man/venn.Rd 2016-03-25 16:31:45 UTC (rev 2099) +++ pkg/gplots/man/venn.Rd 2016-03-25 16:33:51 UTC (rev 2100) @@ -7,9 +7,11 @@ } \usage{ venn(data, universe=NA, small=0.7, showSetLogicLabel=FALSE, - simplify=FALSE, show.plot=TRUE, intersections=TRUE, names) + simplify=FALSE, show.plot=TRUE, intersections=TRUE, names, + ...) + \method{plot}{venn}(x, y, ..., small=0.7, showSetLogicLabel=FALSE, - simplify=FALSE) + simplify=FALSE) } \arguments{ \item{data,x}{Either a list list containing vectors of names or indices From noreply at r-forge.r-project.org Fri Mar 25 17:35:08 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 17:35:08 +0100 (CET) Subject: [R-gregmisc-commits] r2101 - pkg/gplots/man Message-ID: <20160325163508.E523318760D@r-forge.r-project.org> Author: warnes Date: 2016-03-25 17:35:08 +0100 (Fri, 25 Mar 2016) New Revision: 2101 Modified: pkg/gplots/man/venn.Rd Log: Correct discrepencies in man page Modified: pkg/gplots/man/venn.Rd =================================================================== --- pkg/gplots/man/venn.Rd 2016-03-25 16:33:51 UTC (rev 2100) +++ pkg/gplots/man/venn.Rd 2016-03-25 16:35:08 UTC (rev 2101) @@ -31,7 +31,9 @@ if the returned object should have the attribute "individuals.in.intersections" featuring for every set a list of individuals that are assigned to it.} - \item{y,...}{Ignored} + \item{y}{Ignored} + \item{...}{Optional graphical parameters.} + \item{names}{Optional vector of group names.} } \details{ \code{data} should be either a named list of vectors containing From noreply at r-forge.r-project.org Fri Mar 25 17:39:34 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 17:39:34 +0100 (CET) Subject: [R-gregmisc-commits] r2102 - pkg/gplots/man Message-ID: <20160325163935.047C41869CE@r-forge.r-project.org> Author: warnes Date: 2016-03-25 17:39:34 +0100 (Fri, 25 Mar 2016) New Revision: 2102 Modified: pkg/gplots/man/gplots-defunct.Rd pkg/gplots/man/gplots-deprecated.Rd Log: Fix documenation issues identified by 'R CMD check' Modified: pkg/gplots/man/gplots-defunct.Rd =================================================================== --- pkg/gplots/man/gplots-defunct.Rd 2016-03-25 16:35:08 UTC (rev 2101) +++ pkg/gplots/man/gplots-defunct.Rd 2016-03-25 16:39:34 UTC (rev 2102) @@ -32,13 +32,26 @@ inset = 0.05) } \arguments{ - \item{\dots}{see man page for the corresponding replacement function} - \item{top, shrink, textcolor}{See man page for - \code{\link{boxplot2}}.} - \item{x, which, caption, panel, sub.caption, main, ask, id.n, - labels.id, cex.id, band, rug, width, max.n}{See man page for - \code{\link{lmplot2}}.} - \item{x, y, inset, \dots}{see man page for the corresponding replacement function} + \item{ask, + band, + caption, + cex.id, + id.n, + inset, + labels.id, + main, + max.n, + panel, + rug, + shrink, + sub.caption, + textcolor, + top, + which, + width, + x, + y, + \dots}{see man page for the corresponding replacement function} } \details{ These functions are no longer available. Please refer to the manual page Modified: pkg/gplots/man/gplots-deprecated.Rd =================================================================== --- pkg/gplots/man/gplots-deprecated.Rd 2016-03-25 16:35:08 UTC (rev 2101) +++ pkg/gplots/man/gplots-deprecated.Rd 2016-03-25 16:39:34 UTC (rev 2102) @@ -6,7 +6,7 @@ releases of gplots. } \usage{ - (No deprecated functions at this time) + ## No deprecated functions at this time ## } \arguments{ } From noreply at r-forge.r-project.org Fri Mar 25 18:11:26 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 18:11:26 +0100 (CET) Subject: [R-gregmisc-commits] r2103 - pkg/gplots/R Message-ID: <20160325171126.9E3B5184782@r-forge.r-project.org> Author: warnes Date: 2016-03-25 18:11:26 +0100 (Fri, 25 Mar 2016) New Revision: 2103 Modified: pkg/gplots/R/heatmap.2.R Log: Fix error when Rowv=FALSE or Colv=FALSE Modified: pkg/gplots/R/heatmap.2.R =================================================================== --- pkg/gplots/R/heatmap.2.R 2016-03-25 16:39:34 UTC (rev 2102) +++ pkg/gplots/R/heatmap.2.R 2016-03-25 17:11:26 UTC (rev 2103) @@ -142,7 +142,7 @@ ## Check if Rowv and dendrogram arguments are consistent if ( ( - ( is.logical(Rowv) && !isTRUE(Rowv) ) + ( is.logical(Rowv) && !isTRUE(Rowv) ) || ( is.null(Rowv) ) ) @@ -150,14 +150,14 @@ ( dendrogram %in% c("both","row") ) ) { - if (is.logical(Colv) && (Colv)) + warning("Discrepancy: Rowv is FALSE, while dendrogram is `", + dendrogram, "'. Omitting row dendogram.") + + if (dendrogram=="both") dendrogram <- "column" else dendrogram <- "none" - warning("Discrepancy: Rowv is FALSE, while dendrogram is `", - dendrogram, "'. Omitting row dendogram.") - } } @@ -172,13 +172,14 @@ && ( dendrogram %in% c("both","column")) ) { - if (is.logical(Rowv) && (Rowv)) + warning("Discrepancy: Colv is FALSE, while dendrogram is `", + dendrogram, "'. Omitting column dendogram.") + + if (dendrogram=="both") dendrogram <- "row" else dendrogram <- "none" - warning("Discrepancy: Colv is FALSE, while dendrogram is `", - dendrogram, "'. Omitting column dendogram.") } } @@ -223,13 +224,18 @@ rowInd <- order.dendrogram(ddr) if(nr != length(rowInd)) stop("row dendrogram ordering gave index of wrong length") - } else { + } + else if(!isTRUE(Rowv)) + { rowInd <- nr:1 + ddr <- as.dendrogram(hclust(dist(diag(nr)))) + } + else + { + rowInd <- nr:1 ddr <- as.dendrogram(Rowv) } - ## if( dendrogram %in% c("both","column") ) - ## { if(inherits(Colv, "dendrogram")) { ddc <- Colv ## use Colv 'as-is', when it is dendrogram @@ -271,6 +277,11 @@ if(nc != length(colInd)) stop("column dendrogram ordering gave index of wrong length") } + else if(!isTRUE(Colv)) + { + colInd <- 1:nc + ddc <- as.dendrogram(hclust(dist(diag(nc)))) + } else { colInd <- 1:nc From noreply at r-forge.r-project.org Fri Mar 25 18:27:01 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 18:27:01 +0100 (CET) Subject: [R-gregmisc-commits] r2104 - pkg/gplots/man Message-ID: <20160325172701.19BA1187E4B@r-forge.r-project.org> Author: warnes Date: 2016-03-25 18:27:00 +0100 (Fri, 25 Mar 2016) New Revision: 2104 Modified: pkg/gplots/man/lowess.Rd pkg/gplots/man/venn.Rd Log: Fix errors identified by R CMD check Modified: pkg/gplots/man/lowess.Rd =================================================================== --- pkg/gplots/man/lowess.Rd 2016-03-25 17:11:26 UTC (rev 2103) +++ pkg/gplots/man/lowess.Rd 2016-03-25 17:27:00 UTC (rev 2104) @@ -28,8 +28,8 @@ \method{lowess}{default}(x, y=NULL, f=2/3, iter=3L, delta=0.01 * diff(range(x)), ...) -\method{lowess}{formula}(formula,data=parent.frame(), subset, f=2/3, - iter=3L, delta=.01*diff(range(mf[-response])), ... ) +\method{lowess}{formula}(formula,data=parent.frame(), ..., subset, f=2/3, + iter=3L, delta=.01*diff(range(mf[-response]))) \method{plot}{lowess}(x, y, ..., col.lowess="red", lty.lowess=2) @@ -57,10 +57,6 @@ \item{delta}{values of \code{x} which lie within \code{delta} of each other replaced by a single value in the output from \code{lowess}.} - \item{na.action}{a function which indicates what should happen when the - data contain `NA's. The default is set by the `na.action' setting - of `options', and is `na.fail' if that is unset. The ``factory-fresh'' - default is `na.omit'.} \item{...}{parameters for methods.} \item{col.lowess, lty.lowess}{color and line type for plotted line} } Modified: pkg/gplots/man/venn.Rd =================================================================== --- pkg/gplots/man/venn.Rd 2016-03-25 17:11:26 UTC (rev 2103) +++ pkg/gplots/man/venn.Rd 2016-03-25 17:27:00 UTC (rev 2104) @@ -133,7 +133,7 @@ str(isect) # Extract and combine the subsets of interest.. -AandB <- unique(c(int$A, int$B, int$'A:B')) +AandB <- unique(c(isect$A, isect$B, isect$'A:B')) # and look at the results str(AandB) From noreply at r-forge.r-project.org Fri Mar 25 18:27:37 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 18:27:37 +0100 (CET) Subject: [R-gregmisc-commits] r2105 - pkg/gplots/R Message-ID: <20160325172737.45F70187E4B@r-forge.r-project.org> Author: warnes Date: 2016-03-25 18:27:36 +0100 (Fri, 25 Mar 2016) New Revision: 2105 Modified: pkg/gplots/R/lowess.R Log: Remove obsolete function to add '...' to argument list for stats::lowess(). Modified: pkg/gplots/R/lowess.R =================================================================== --- pkg/gplots/R/lowess.R 2016-03-25 17:27:00 UTC (rev 2104) +++ pkg/gplots/R/lowess.R 2016-03-25 17:27:36 UTC (rev 2105) @@ -13,10 +13,6 @@ retval } - -# add "..." to the argument list to match the generic -formals(lowess.default) <- c(formals(lowess.default),alist(...= )) - lowess <- function(x,...) UseMethod("lowess") From noreply at r-forge.r-project.org Fri Mar 25 18:28:45 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 18:28:45 +0100 (CET) Subject: [R-gregmisc-commits] r2106 - pkg/gplots/R Message-ID: <20160325172845.D7653187E4B@r-forge.r-project.org> Author: warnes Date: 2016-03-25 18:28:45 +0100 (Fri, 25 Mar 2016) New Revision: 2106 Modified: pkg/gplots/R/plot.venn.R Log: Warning message didn't have spaces between words. Minor code reformatting. Modified: pkg/gplots/R/plot.venn.R =================================================================== --- pkg/gplots/R/plot.venn.R 2016-03-25 17:27:36 UTC (rev 2105) +++ pkg/gplots/R/plot.venn.R 2016-03-25 17:28:45 UTC (rev 2106) @@ -7,7 +7,7 @@ { drawVennDiagram( data=x, - small=small, + small=small, showSetLogicLabel=showSetLogicLabel, simplify=simplify ) @@ -20,8 +20,11 @@ ## giving the pattern of group membership -drawVennDiagram <-function(data,small=0.7, - showSetLogicLabel=FALSE,simplify=FALSE) { +drawVennDiagram <-function(data, + small=0.7, + showSetLogicLabel=FALSE, + simplify=FALSE) + { numCircles<-NA data.colnames<-NULL data.rownames<-NULL @@ -56,7 +59,7 @@ })) #print(data) - + #data.names<-apply(data,1,function(X){ # return(paste(X),collapse="") #}) @@ -88,8 +91,10 @@ circle <- function(x,y=NULL,r=1) { elps=cbind(r*cos(seq(0,2*pi,len=1000)), r*sin(seq(0,2*pi,len=1000))); if (!is.null(y)) { - if (length(x) != length(y)) stop("circle: both x and y need to be of same length") - if (is.matrix(x) && ncol(x)>1) stop("circle: if y is not NULL, then x must not be a matrix") + if (length(x) != length(y)) + stop("circle: both x and y need to be of same length") + if (is.matrix(x) && ncol(x)>1) + stop("circle: if y is not NULL, then x must not be a matrix") x<-cbind(x,y) } for(i in 1:nrow(x)) { @@ -155,7 +160,7 @@ } #degrees[2^i+1] + degrees[2^((i+1)%%numCircles)+1])/2 - + if (3 <=numCircles) { for (i in 0:(numCircles-1)) { distFromZero[(2^i+2^((i+1)%%numCircles))+1]<- 2.2/12*h @@ -176,7 +181,7 @@ v<-data[n,1] d<-degrees[i] if (1 == length(d) && is.na(d)) { - if (v>0) warning("Not shown: ",n,"is",v,"\n") + if (v>0) warning("Not shown: ",n," contains ",v,"\n") } else { l<-distFromZero[i] @@ -234,19 +239,19 @@ text(260, 315, lab("0010",data)); text(365, 250, lab("0001",data)); - text( 90, 280, lab("1100",data), cex=small) - text( 95, 110, lab("1010",data) ) - text(200, 50, lab("1001",data), cex=small) - text(200, 290, lab("0110",data)) - text(300, 110, lab("0101",data)) - text(310, 280, lab("0011",data), cex=small) + text( 90, 280, lab("1100",data), cex=small) + text( 95, 110, lab("1010",data) ) + text(200, 50, lab("1001",data), cex=small) + text(200, 290, lab("0110",data)) + text(300, 110, lab("0101",data)) + text(310, 280, lab("0011",data), cex=small) text(130, 230, lab("1110",data)) - text(245, 75, lab("1101",data),cex=small) + text(245, 75, lab("1101",data),cex=small) text(155, 75, lab("1011",data),cex=small) - text(270, 230, lab("0111",data)) + text(270, 230, lab("0111",data)) - text(200,150,lab("1111",data)) + text(200,150,lab("1111",data)) } else if (5 == numCircles) { @@ -273,32 +278,32 @@ text(146, 250, lab("11000",data), cex=small) text(123, 188, lab("10100",data), cex=small) - text(275, 152, lab("10010",data), cex=small) - text(137, 146, lab("10001",data), cex=small) - text(243, 268, lab("01100",data), cex=small) - text(175, 267, lab("01010",data), cex=small) - text(187, 117, lab("01001",data), cex=small) - text(286, 188, lab("00110",data), cex=small) - text(267, 235, lab("00101",data), cex=small) - text(228, 105, lab("00011",data), cex=small) + text(275, 152, lab("10010",data), cex=small) + text(137, 146, lab("10001",data), cex=small) + text(243, 268, lab("01100",data), cex=small) + text(175, 267, lab("01010",data), cex=small) + text(187, 117, lab("01001",data), cex=small) + text(286, 188, lab("00110",data), cex=small) + text(267, 235, lab("00101",data), cex=small) + text(228, 105, lab("00011",data), cex=small) text(148, 210, lab("11100",data),cex=small) - text(159, 253, lab("11010",data),cex=small) - text(171, 141, lab("11001",data),cex=small) - text(281, 175, lab("10110",data),cex=small) - text(143, 163, lab("10101",data),cex=small) - text(252, 145, lab("10011",data),cex=small) - text(205, 255, lab("01110",data),cex=small) - text(254, 243, lab("01101",data),cex=small) - text(211, 118, lab("01011",data),cex=small) - text(267, 211, lab("00111",data),cex=small) + text(159, 253, lab("11010",data),cex=small) + text(171, 141, lab("11001",data),cex=small) + text(281, 175, lab("10110",data),cex=small) + text(143, 163, lab("10101",data),cex=small) + text(252, 145, lab("10011",data),cex=small) + text(205, 255, lab("01110",data),cex=small) + text(254, 243, lab("01101",data),cex=small) + text(211, 118, lab("01011",data),cex=small) + text(267, 211, lab("00111",data),cex=small) - text(170, 231,lab("11110",data),cex=small) - text(158, 169,lab("11101",data),cex=small) + text(170, 231,lab("11110",data),cex=small) + text(158, 169,lab("11101",data),cex=small) text(212, 139,lab("11011",data),cex=small) - text(263, 180,lab("10111",data),cex=small) + text(263, 180,lab("10111",data),cex=small) text(239, 232,lab("01111",data),cex=small) - + text(204,190,lab("11111",data)) } } From noreply at r-forge.r-project.org Fri Mar 25 19:20:26 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 19:20:26 +0100 (CET) Subject: [R-gregmisc-commits] r2107 - pkg/gplots/tests Message-ID: <20160325182026.6B196187D21@r-forge.r-project.org> Author: warnes Date: 2016-03-25 19:20:26 +0100 (Fri, 25 Mar 2016) New Revision: 2107 Modified: pkg/gplots/tests/heatmap2Test.Rout.save Log: Update test output to match corrected messages Modified: pkg/gplots/tests/heatmap2Test.Rout.save =================================================================== --- pkg/gplots/tests/heatmap2Test.Rout.save 2016-03-25 17:28:45 UTC (rev 2106) +++ pkg/gplots/tests/heatmap2Test.Rout.save 2016-03-25 18:20:26 UTC (rev 2107) @@ -1,7 +1,7 @@ -R version 3.1.1 (2014-07-10) -- "Sock it to Me" -Copyright (C) 2014 The R Foundation for Statistical Computing -Platform: x86_64-apple-darwin13.1.0 (64-bit) +R version 3.2.0 (2015-04-16) -- "Full of Ingredients" +Copyright (C) 2015 The R Foundation for Statistical Computing +Platform: x86_64-unknown-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. @@ -40,44 +40,44 @@ > heatmap.2(x, Colv=FALSE) Warning message: In heatmap.2(x, Colv = FALSE) : - Discrepancy: Colv is FALSE, while dendrogram is `row'. Omitting column dendogram. + Discrepancy: Colv is FALSE, while dendrogram is `both'. Omitting column dendogram. > heatmap.2(x, Colv=NULL) Warning message: In heatmap.2(x, Colv = NULL) : - Discrepancy: Colv is FALSE, while dendrogram is `row'. Omitting column dendogram. + Discrepancy: Colv is FALSE, while dendrogram is `both'. Omitting column dendogram. > > heatmap.2(x, Rowv=FALSE) Warning message: In heatmap.2(x, Rowv = FALSE) : - Discrepancy: Rowv is FALSE, while dendrogram is `column'. Omitting row dendogram. + Discrepancy: Rowv is FALSE, while dendrogram is `both'. Omitting row dendogram. > heatmap.2(x, Rowv=NULL) Warning message: In heatmap.2(x, Rowv = NULL) : - Discrepancy: Rowv is FALSE, while dendrogram is `column'. Omitting row dendogram. + Discrepancy: Rowv is FALSE, while dendrogram is `both'. Omitting row dendogram. > > heatmap.2(x, Rowv=FALSE, dendrogram="both") ## generate warning! Warning message: In heatmap.2(x, Rowv = FALSE, dendrogram = "both") : - Discrepancy: Rowv is FALSE, while dendrogram is `column'. Omitting row dendogram. + Discrepancy: Rowv is FALSE, while dendrogram is `both'. Omitting row dendogram. > heatmap.2(x, Rowv=NULL, dendrogram="both") ## generate warning! Warning message: In heatmap.2(x, Rowv = NULL, dendrogram = "both") : - Discrepancy: Rowv is FALSE, while dendrogram is `column'. Omitting row dendogram. + Discrepancy: Rowv is FALSE, while dendrogram is `both'. Omitting row dendogram. > heatmap.2(x, Colv=FALSE, dendrogram="both") ## generate warning! Warning message: In heatmap.2(x, Colv = FALSE, dendrogram = "both") : - Discrepancy: Colv is FALSE, while dendrogram is `row'. Omitting column dendogram. + Discrepancy: Colv is FALSE, while dendrogram is `both'. Omitting column dendogram. > > > > heatmap.2(x,dendrogram="both", Rowv=FALSE) ## row and col reordering done, but only col dendrogram plotted Warning message: In heatmap.2(x, dendrogram = "both", Rowv = FALSE) : - Discrepancy: Rowv is FALSE, while dendrogram is `column'. Omitting row dendogram. + Discrepancy: Rowv is FALSE, while dendrogram is `both'. Omitting row dendogram. > heatmap.2(x,dendrogram="row", Rowv=FALSE) Warning message: In heatmap.2(x, dendrogram = "row", Rowv = FALSE) : - Discrepancy: Rowv is FALSE, while dendrogram is `column'. Omitting row dendogram. + Discrepancy: Rowv is FALSE, while dendrogram is `row'. Omitting row dendogram. > > > heatmap.2(x,dendrogram="col", Rowv=FALSE) @@ -87,19 +87,19 @@ > heatmap.2(x,dendrogram="both", Colv=FALSE) ## row and col reordering done, but only row dendrogram plotted Warning message: In heatmap.2(x, dendrogram = "both", Colv = FALSE) : - Discrepancy: Colv is FALSE, while dendrogram is `row'. Omitting column dendogram. + Discrepancy: Colv is FALSE, while dendrogram is `both'. Omitting column dendogram. > heatmap.2(x,dendrogram="row", Colv=FALSE) > heatmap.2(x,dendrogram="col", Colv=FALSE) Warning message: In heatmap.2(x, dendrogram = "col", Colv = FALSE) : - Discrepancy: Colv is FALSE, while dendrogram is `row'. Omitting column dendogram. + Discrepancy: Colv is FALSE, while dendrogram is `column'. Omitting column dendogram. > heatmap.2(x,dendrogram="none", Colv=FALSE) > > ## above statement is same as heatmap.2(x,Colv=FALSE) > heatmap.2(x,dendrogram="col", Colv=FALSE) ## col reordering done, but no dendrogram plotted Warning message: In heatmap.2(x, dendrogram = "col", Colv = FALSE) : - Discrepancy: Colv is FALSE, while dendrogram is `row'. Omitting column dendogram. + Discrepancy: Colv is FALSE, while dendrogram is `column'. Omitting column dendogram. > > > hv <- heatmap.2(x, col=cm.colors(256), scale="column", @@ -109,7 +109,7 @@ + tracecol="green", density="density") > > str(hv) # the two re-ordering index vectors -List of 12 +List of 13 $ rowInd : int [1:32] 31 17 16 15 5 25 29 24 7 6 ... $ colInd : int [1:11] 2 9 8 11 6 5 10 7 1 4 ... $ call : language heatmap.2(x = x, scale = "column", col = cm.colors(256), tracecol = "green", margins = c(5, 10), ColSideColors = cc, RowSideColors = rc, density.info = "density", ... @@ -212,6 +212,10 @@ ..$ low : num [1:256] -3.21 -3.19 -3.16 -3.14 -3.11 ... ..$ high : num [1:256] -3.19 -3.16 -3.14 -3.11 -3.09 ... ..$ color: Factor w/ 254 levels "#80FFFFFF","#81FFFFFF",..: 1 1 2 3 4 5 6 7 8 9 ... + $ layout :List of 3 + ..$ lmat: num [1:3, 1:3] 6 0 4 0 0 1 5 2 3 + ..$ lhei: num [1:3] 1.5 0.2 4 + ..$ lwid: num [1:3] 1.5 0.2 4 > > ## Test row and column separators > heatmap.2(x,dendrogram="col", colsep=1) ## one colsep @@ -222,4 +226,4 @@ > > proc.time() user system elapsed - 1.485 0.094 2.015 + 1.618 1.555 1.558 From noreply at r-forge.r-project.org Fri Mar 25 19:47:34 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 19:47:34 +0100 (CET) Subject: [R-gregmisc-commits] r2108 - pkg/gplots/man Message-ID: <20160325184734.DAE401878DC@r-forge.r-project.org> Author: warnes Date: 2016-03-25 19:47:34 +0100 (Fri, 25 Mar 2016) New Revision: 2108 Modified: pkg/gplots/man/heatmap.2.Rd Log: Add trailing slash to make R CMD check's URL testing happy. Modified: pkg/gplots/man/heatmap.2.Rd =================================================================== --- pkg/gplots/man/heatmap.2.Rd 2016-03-25 18:20:26 UTC (rev 2107) +++ pkg/gplots/man/heatmap.2.Rd 2016-03-25 18:47:34 UTC (rev 2108) @@ -276,7 +276,7 @@ The default colors range from red to white (\code{heat.colors}) and are not pretty. Consider using enhancements such as the \pkg{RColorBrewer} package, - \url{http://cran.r-project.org/web/packages/RColorBrewer} + \url{http://cran.r-project.org/web/packages/RColorBrewer/} to select better colors. By default four components will be displayed in the plot. At the top From noreply at r-forge.r-project.org Fri Mar 25 19:48:25 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 19:48:25 +0100 (CET) Subject: [R-gregmisc-commits] r2109 - pkg/gplots Message-ID: <20160325184825.8FE291878DC@r-forge.r-project.org> Author: warnes Date: 2016-03-25 19:48:24 +0100 (Fri, 25 Mar 2016) New Revision: 2109 Modified: pkg/gplots/NAMESPACE Log: Add imports recommended by R CMD check on WinBuilder Modified: pkg/gplots/NAMESPACE =================================================================== --- pkg/gplots/NAMESPACE 2016-03-25 18:47:34 UTC (rev 2108) +++ pkg/gplots/NAMESPACE 2016-03-25 18:48:24 UTC (rev 2109) @@ -74,3 +74,25 @@ S3method(textplot, data.frame) S3method(textplot, default) S3method(textplot, matrix) + +# imports recommended by R CMD check +importFrom("grDevices", "col2rgb", "contourLines", "dev.flush", + "dev.hold", "dev.interactive", "heat.colors", "rgb", + "topo.colors") + +importFrom("graphics", "abline", "arrows", "axTicks", "axis", + "barplot", "contour", "filled.contour", "grid", "hist", + "identify", "image", "layout", "legend", "lines", + "matlines", "matpoints", "mtext", "panel.smooth", "par", + "plot", "plot.default", "plot.new", "plot.window", "points", + "polygon", "rect", "segments", "strheight", "strwidth", + "text", "title", "xinch", "yinch") + +importFrom("stats", "as.dendrogram", "cooks.distance", "density", + "deviance", "df.residual", "dist", "dnorm", "effects", + "expand.model.frame", "fitted", "hclust", "is.leaf", + "lm.influence", "median", "model.frame", "order.dendrogram", + "ppoints", "predict", "qnorm", "qqline", "qqnorm", "qt", + "residuals", "sd", "var", "weights") + +importFrom("utils", "str") \ No newline at end of file From noreply at r-forge.r-project.org Fri Mar 25 19:48:39 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 19:48:39 +0100 (CET) Subject: [R-gregmisc-commits] r2110 - in pkg/gplots: . inst Message-ID: <20160325184839.7E7951878DC@r-forge.r-project.org> Author: warnes Date: 2016-03-25 19:48:39 +0100 (Fri, 25 Mar 2016) New Revision: 2110 Modified: pkg/gplots/DESCRIPTION pkg/gplots/inst/ChangeLog pkg/gplots/inst/NEWS Log: Update files for gplots 2.18.0 Modified: pkg/gplots/DESCRIPTION =================================================================== --- pkg/gplots/DESCRIPTION 2016-03-25 18:48:24 UTC (rev 2109) +++ pkg/gplots/DESCRIPTION 2016-03-25 18:48:39 UTC (rev 2110) @@ -1,7 +1,7 @@ Package: gplots Title: Various R Programming Tools for Plotting Data Description: Various R programming tools for plotting data, including: - - calculating and plotting locally smoothed summary functionas + - calculating and plotting locally smoothed summary function as ('bandplot', 'wapply'), - enhanced versions of standard plots ('barplot2', 'boxplot2', 'heatmap.2', 'smartlegend'), @@ -15,7 +15,7 @@ - plotting a matrix where each cell contains a dot whose size reflects the relative magnitude of the elements ('balloonplot'), - plotting venn diagrams ('venn'), - - displaying Open-Office syle plots ('ooplot'), + - displaying Open-Office style plots ('ooplot'), - plotting multiple datasets on same region, with separate axes ('overplot'), - plotting means and cofidence intervals ('plotCI', 'plotmeans'), @@ -23,8 +23,8 @@ Depends: R (>= 3.0) Imports: gtools, gdata, stats, caTools, KernSmooth Suggests: grid, MASS -Version: 2.17.0 -Date: 2015-05-01 +Version: 2.18.0 +Date: 2016-03-25 Author: Gregory R. Warnes, Ben Bolker, Lodewijk Bonebakker, Robert Gentleman, Wolfgang Huber Andy Liaw, Thomas Lumley, Martin Maechler, Arni Magnusson, Steffen Moeller, Marc Schwartz, Bill Modified: pkg/gplots/inst/ChangeLog =================================================================== --- pkg/gplots/inst/ChangeLog 2016-03-25 18:48:24 UTC (rev 2109) +++ pkg/gplots/inst/ChangeLog 2016-03-25 18:48:39 UTC (rev 2110) @@ -1,59 +1,145 @@ +2016-03-25 warnes + + * [r2106] R/plot.venn.R: Warning message didn't have spaces between + words. Minor code reformatting. + * [r2105] R/lowess.R: Remove obsolete function to add '...' to + argument list for stats::lowess(). + * [r2104] man/lowess.Rd, man/venn.Rd: Fix errors identified by R + CMD check + * [r2103] R/heatmap.2.R: Fix error when Rowv=FALSE or Colv=FALSE + * [r2102] man/gplots-defunct.Rd, man/gplots-deprecated.Rd: Fix + documenation issues identified by 'R CMD check' + * [r2101] man/venn.Rd: Correct discrepencies in man page + * [r2100] man/venn.Rd: Correct discrepencies in man page + * [r2099] man/lowess.Rd: Correct differences between calls on man + page and in code + * [r2098] R/lmplot2.R: Fix name of replacement functon in defuct + message generated by plot.lm2 + * [r2097] man/lowess.Rd: Improve lowess() man page + * [r2096] NAMESPACE: Add plotLowess() and plot.lowess() to the + NAMESPACE + * [r2095] R/plot.lowess.R: Ensure lowess plot methods (invisibly) + return the lowess object. + * [r2094] man/lowess.Rd: Update man page for lowess to reflect new + lowess method for plot(). + * [r2093] R/plot.lowess.R: Ensure extra arguments are properly + passed to the plot call. + * [r2092] R/heatmap.2.R: Corrected a bug causing "Error in + plot.new() : figure margins too large" to occur when 'key=FALSE'. + (Reported and patch provided by Sveinung Gundersen.) + +2016-03-24 warnes + + * [r2091] R/lowess.R, R/plot.lowess.R: Rename plot.lowess to + plotLowess to avoid confusions with plot() method for class + 'lowess', create a plot() method for class 'lowess' and modify + the lowess.default() and lowess.formula() to add the 'lowess' + class to the returned object, along with a 'call' list element. + * [r2090] R/venn.R, R/vennMembers.R, man/venn.Rd: The + 'intersections' attribute returned from venn() has been improved + to use set names instead of indicators, and is ordered from + simplest to most complex set interactions. + * [r2089] R/smartlegend.R, man/gplots-defunct.Rd, + man/gplots-deprecated.Rd: The smartlegend() function has been + made defunct and is no longer available. + * [r2088] R/lmplot2.R: Indentation changes + * [r2087] man/heatmap.2.Rd: Update heatmap.2() man page to reflect + addition of to the returned object. + * [r2086] R/lowess.R: Remove observations with missing values when + lowess is called using the formula interface. + * [r2085] R/heatmap.2.R: Add layout infromation to object returned + from heatmap.2() (patch provided by Jenny Drnevich). + * [r2084] DESCRIPTION: Correct spelling + +2016-03-08 warnes + + * [r2083] R/plot.lowess.R: Add function to plot points and lowess + using formula interface. + * [r2082] R/lowess.R: Remove old code for S-Plus and modernize + formula handling code. + * [r2081] R/heatmap.2.R: Set srtCol default if missing and colCol + is set + +2016-02-26 warnes + + * [r2080] R/venn.R: venn() now support matrix arguments. + * [r2079] R/angleAxis.R, man/angleAxis.Rd: New angleAxis() function + to create axis labels with rotated text. + * [r2078] R/heatmap.2.R: - heatmap.2() can now be used to plot + subsets of a previous heatmap. + - Remove stray 'browser()' debuggint statement from heatmap.2() + code. + - Decrease the granularity of the carpet in heatmap.2()'s color + key to + avoid visual artifacts. + +2015-11-23 warnes + + * [r2070] R/heatmap.2.R: Remove debugging print() statement. + +2015-07-22 warnes + + * [r2062] DESCRIPTION, R/heatmap.2.R, R/layout_set.R: Renamed + 'test' directory to 'tests', commented out tests for lme4 which + has a changed API + +2015-06-02 warnes + + * [r2052] R/boxplot2.R: Defunct message for boxplot.n was + recommending the wrong function + +2015-05-02 warnes + + * [r2018] Rename 'trunk' to 'pkg' for compatibility with R-forge + 2015-05-01 warnes - * [r2013] inst/ChangeLog: Update ChangeLog (again) - * [r2012] man/gplots-defunct.Rd: Summary: Correct man page name - * [r2011] man/gplots-deprecated.Rd: Summary: Forgot to add \alias - for smartlegend. - * [r2010] man/lmplot2.Rd: Remove leftover alias - * [r2009] inst/ChangeLog: Commit ChangeLog - * [r2008] NAMESPACE, inst/NEWS: Update NEWS again. - * [r2007] man/gplots-defunct.Rd, man/gplots-deprecated.Rd, - man/lmplot2.Rd, man/smartlegend.Rd: Mark boxplot.n and() - plot.lm2() as defunct. - * [r2006] R/boxplot2.R, R/lmplot2.R: Make ballonplot.n() and - plot.lm2() 'defunct'. - * [r2005] inst/ChangeLog, inst/NEWS: Update NEWS and ChangeLog - again. - * [r2004] man/sinkplot.Rd: Summary: Punctuation. - * [r2003] NAMESPACE: Correct URLs in man pages. - * [r2002] man/heatmap.2.Rd, man/sinkplot.Rd: Correct URLs in man - pages. - * [r2001] inst/NEWS: Update NEWS again. - * [r2000] DESCRIPTION: Improve package description. - * [r1999] man/smartlegend.Rd: Mark 'smartlegend' as deprecated - * [r1998] R/smartlegend.R: Summary: Mark smartlegend() as - deprecated. - * [r1997] man/venn.Rd: Summary: venn example used 'F' instead of - 'FALSE'. - * [r1996] DESCRIPTION, inst/ChangeLog, inst/NEWS: Update - DESCRIPTION, NEWS, and ChangeLog again for gplots 2.17.0. - * [r1995] R/heatmap.2.R: - heatmap.2: row traces could be plotted - in the wrong order. - * [r1994] R/heatmap.2.R, man/heatmap.2.Rd: - heatmap.2: column - traces could be plotted in the wrong order. + * [r2014] Again... + * [r2013] Update ChangeLog (again) + * [r2012] Summary: Correct man page name + * [r2011] Summary: Forgot to add \alias for smartlegend. + * [r2010] Remove leftover alias + * [r2009] Commit ChangeLog + * [r2008] Update NEWS again. + * [r2007] Mark boxplot.n and() plot.lm2() as defunct. + * [r2006] Make ballonplot.n() and plot.lm2() 'defunct'. + * [r2005] Update NEWS and ChangeLog again. + * [r2004] Summary: Punctuation. + * [r2003] Correct URLs in man pages. + * [r2002] Correct URLs in man pages. + * [r2001] Update NEWS again. + * [r2000] Improve package description. + * [r1999] Mark 'smartlegend' as deprecated + * [r1998] Summary: Mark smartlegend() as deprecated. + * [r1997] Summary: venn example used 'F' instead of 'FALSE'. + * [r1996] Update DESCRIPTION, NEWS, and ChangeLog again for gplots + 2.17.0. + * [r1995] - heatmap.2: row traces could be plotted in the wrong + order. + * [r1994] - heatmap.2: column traces could be plotted in the wrong + order. - heatmap.2: add support for plotting sub-clusters of the full row and column dendrograms 2015-04-23 warnes - * [r1955] inst/ChangeLog, inst/NEWS: Update NEWS and ChangeLog - * [r1954] DESCRIPTION, R/heatmap.2.R, inst/ChangeLog, inst/NEWS: In - heatmap.2(), the color key now properly handles color breaks that + * [r1955] Update NEWS and ChangeLog + * [r1954] In heatmap.2(), the color key now properly handles color + breaks that are not equally spaced. (Issue reported by Tim Richter-Heitmann.) - * [r1948] R/plotCI.R: - plotCI() was not properly respecting the - 'type=' argument. This has + * [r1948] - plotCI() was not properly respecting the 'type=' + argument. This has been corrected. - * [r1947] R/overplot.R: - Remove stray browser() call from - overplot() - * [r1943] man/balloonplot.Rd: Explicitly specify argument to - gplots:::reorder.factor to prevent error. - * [r1942] R/venn.R, man/venn.Rd: - The returned object from venn() - now includes a 'interesection' + * [r1947] - Remove stray browser() call from overplot() + * [r1943] Explicitly specify argument to gplots:::reorder.factor to + prevent error. + * [r1942] - The returned object from venn() now includes a + 'interesection' attribution containing a list of which items are in each set intersection. This can be turned off by settting 'intersection=FALSE'. - * [r1941] R/heatmap.2.R: Patch submitted by Ilia Kats: + * [r1941] Patch submitted by Ilia Kats: - easily extract and plot subclusters from a big heatmap using the same colorkey, by passing a dendgrogram of the subcluster @@ -65,92 +151,83 @@ paper, but maintain consistent color coding. - Improves the behavior of the color key axis labels, as they now honor par("cex") and par("cex.lab"). - * [r1940] R/heatmap.2.R: In heatmap.2() split calls to distfun() - and hclustfun() into separate steps to make debugging easier + * [r1940] In heatmap.2() split calls to distfun() and hclustfun() + into separate steps to make debugging easier 2015-04-22 warnes - * [r1931] DESCRIPTION, inst/ChangeLog, inst/NEWS: Update - DESCRIPTION, ChangeLog, and NEWS for gplots 2.17.0 - * [r1930] R/heatmap.2.R, man/heatmap.2.Rd: heatmap.2: add new - 'colRow' and 'colCol' arguments to control the color of row and - column text labels + * [r1931] Update DESCRIPTION, ChangeLog, and NEWS for gplots 2.17.0 + * [r1930] heatmap.2: add new 'colRow' and 'colCol' arguments to + control the color of row and column text labels 2015-04-06 warnes - * [r1916] inst/ChangeLog: Add ChangeLog files to repository + * [r1916] Add ChangeLog files to repository 2015-01-02 warnes - * [r1913] DESCRIPTION, inst/NEWS: Update for gplots release 2.16.0. - * [r1912] R/plotmeans.R: Change default group count lable back to - 'n='. - * [r1911] R/plotmeans.R, man/plotmeans.Rd: - plotmeans: Pass - optional graphical arguments captured in '...' axis function + * [r1913] Update for gplots release 2.16.0. + * [r1912] Change default group count lable back to 'n='. + * [r1911] - plotmeans: Pass optional graphical arguments captured + in '...' axis function used to draw the x axis. - plotmeans: Add an new argument 'text.n.label' to specify the text used for labelingthe number of elements in a group. - * [r1910] R/plotmeans.R: - Remove S-Plus-specific code + * [r1910] - Remove S-Plus-specific code - Simplify model frame code 2014-12-03 warnes - * [r1909] tests/heatmap2Test.Rout.save: Update stored test output - to account for new startup message from KernSmooth package - * [r1908] DESCRIPTION: Fix package title capitalization. + * [r1909] Update stored test output to account for new startup + message from KernSmooth package + * [r1908] Fix package title capitalization. 2014-12-02 warnes - * [r1907] inst/NEWS: Add descrioption of node stack overflow issue - and work-around. - * [r1906] R/bandplot.R: Move '...' argument to bandplot.formula to - match man page. - * [r1905] tests/test_plottingDeepDendrogram.R: plot.dendrogram - isn't exported by gplots, so it must be referenced using the - ':::' notation. - * [r1904] man/bandplot.Rd: Man page fixes. - * [r1903] NAMESPACE: Add exports of new bandplot methods to - NAMESPACE file. - * [r1902] R/bandplot.R: Code cleanup. - * [r1901] R/bandplot.R: Simplify model.frame code for - bandplot.formula. + * [r1907] Add descrioption of node stack overflow issue and + work-around. + * [r1906] Move '...' argument to bandplot.formula to match man + page. + * [r1905] plot.dendrogram isn't exported by gplots, so it must be + referenced using the ':::' notation. + * [r1904] Man page fixes. + * [r1903] Add exports of new bandplot methods to NAMESPACE file. + * [r1902] Code cleanup. + * [r1901] Simplify model.frame code for bandplot.formula. 2014-12-01 warnes - * [r1900] inst/NEWS: Update for 2.15.0 - * [r1899] DESCRIPTION, R/bandplot.R, man/bandplot.Rd: Convert - bandplot to S3-method dispatch and add method for class formula. - * [r1898] NAMESPACE: Improve whitespace + * [r1900] Update for 2.15.0 + * [r1899] Convert bandplot to S3-method dispatch and add method for + class formula. + * [r1898] Improve whitespace 2014-09-17 warnes - * [r1895] NAMESPACE: Minor reformatting. - * [r1894] R/plotNode.R: Explicitly reset namespace for dendrogram - functions copied from stats. - * [r1893] DESCRIPTION, inst/NEWS: Update DESCRIPTION and NEWS for - gplots 2.14.2 - * [r1892] R/heatmap.2.R, R/plotNode.R: To work around recursion - limit issues triggered by deeply nested + * [r1895] Minor reformatting. + * [r1894] Explicitly reset namespace for dendrogram functions + copied from stats. + * [r1893] Update DESCRIPTION and NEWS for gplots 2.14.2 + * [r1892] To work around recursion limit issues triggered by deeply + nested dendrograms, (1) create a local *intepreted* copy of stats:::plotNode(), (2) detect recursion limit error message within heatmap.2() and generate a more user-friendly message. - * [r1891] tests/dat.csv, tests/test_plottingDeepDendrogram.R: Add - test case for exceeding recursion limits when plotting deeply - nested dendrograms - * [r1890] R/heatmap.2.R: heatmap.2 was not properly handling - integer vectors for Rowv and Colv. - * [r1889] R/heatmap.2.R: key.title=NA was not being honored when - density.info=NA. + * [r1891] Add test case for exceeding recursion limits when + plotting deeply nested dendrograms + * [r1890] heatmap.2 was not properly handling integer vectors for + Rowv and Colv. + * [r1889] key.title=NA was not being honored when density.info=NA. 2014-09-16 warnes - * [r1888] R/plotNode.R: Add plotNode code to allow modificaiton of - algorithm from recursive to iterative for the purpose of avoiding - node stack overflow. - * [r1887] R/heatmap.2.R, man/heatmap.2.Rd: - Correct statement of - default color for 'notecol' argumemt to 'heatmap.2'. + * [r1888] Add plotNode code to allow modificaiton of algorithm from + recursive to iterative for the purpose of avoiding node stack + overflow. + * [r1887] - Correct statement of default color for 'notecol' + argumemt to 'heatmap.2'. - Modify default arguments to 'symbreaks' and 'symkey' to make the logic more evident by replacing min() with any(). (The previous @@ -160,222 +237,187 @@ 2014-06-30 warnes - * [r1823] R/heatmap.2.R: Fix typo in dendrogram size checking code. + * [r1823] Fix typo in dendrogram size checking code. 2014-06-19 warnes - * [r1822] R/heatmap.2.R: Fix typo 'ColInd' --> 'colInd'. - * [r1821] DESCRIPTION, inst/NEWS: Update for gplots 2.14.0 + * [r1822] Fix typo 'ColInd' --> 'colInd'. + * [r1821] Update for gplots 2.14.0 2014-06-17 warnes - * [r1820] man/heatmap.2.Rd: - Document new 'key.title', 'key.xlab', - 'key.ylab', 'key.xtickfun', + * [r1820] - Document new 'key.title', 'key.xlab', 'key.ylab', + 'key.xtickfun', 'key.ytickfun', 'key.par' arguments to heatmap.2 (belated commit). - Document new 'reorderfun' argument to heatmap.2. - * [r1819] R/heatmap.2.R: Allow user to specify function used to - reorder based on the dendogram + * [r1819] Allow user to specify function used to reorder based on + the dendogram via a new 'reorderfun' argument. Suggested by Yuanhua Liu. - * [r1818] R/heatmap.2.R: Fix typo in heatmap.2() reported by - Yuanhua Liu. + * [r1818] Fix typo in heatmap.2() reported by Yuanhua Liu. 2014-06-05 warnes - * [r1817] R/heatmap.2.R: Check size of Rowv and Colv dendogram - objects to ensure they matches data. + * [r1817] Check size of Rowv and Colv dendogram objects to ensure + they matches data. 2014-04-17 warnes - * [r1812] man/hist2d.Rd: Add see also to r2d2::freq2d. - * [r1811] man/ci2d.Rd: Add reference to r2d2::conf2d. + * [r1812] Add see also to r2d2::freq2d. + * [r1811] Add reference to r2d2::conf2d. 2014-04-09 warnes - * [r1802] R/heatmap.2.R: Add padj=0.5 to better align margin - labels. + * [r1802] Add padj=0.5 to better align margin labels. 2014-04-05 warnes - * [r1781] inst/NEWS: Update NEWS - * [r1780] R/heatmap.2.R, man/heatmap.2.Rd: Add 'extrafun' argument - to heatmap.2 to allow the user to perform + * [r1781] Update NEWS + * [r1780] Add 'extrafun' argument to heatmap.2 to allow the user to + perform additional customization by providing a function to be called before heatmap.2 exits. 2014-04-04 warnes - * [r1779] DESCRIPTION, inst/NEWS: Update for gplots 2.13.0 - * [r1778] R/heatmap.2.R: Fix handling of row trace (hline). Bug - report and patch provided by Ilia Kats. + * [r1779] Update for gplots 2.13.0 + * [r1778] Fix handling of row trace (hline). Bug report and patch + provided by Ilia Kats. 2013-10-21 warnes - * [r1744] man/gplots-deprecated.Rd: Handle 'ask' argument in - lmplot2 function proper, rather than in (depreciated) plot.lm2 - wrapper. - * [r1743] inst/NEWS: Correct release number - * [r1742] R/lmplot2.R: Handle 'ask' argument in lmplot2 function - proper, rather than in (depreciated) plot.lm2 wrapper. - * [r1741] man/lmplot2.Rd: Fix typo + * [r1744] Handle 'ask' argument in lmplot2 function proper, rather + than in (depreciated) plot.lm2 wrapper. + * [r1743] Correct release number + * [r1742] Handle 'ask' argument in lmplot2 function proper, rather + than in (depreciated) plot.lm2 wrapper. + * [r1741] Fix typo 2013-10-15 warnes - * [r1740] NAMESPACE: Add boxplot2 and lmplot2 to NAMESPACE - * [r1739] DESCRIPTION, inst/NEWS: Update for gplots release 2.12.1 - * [r1738] R/boxplot.n.R, R/boxplot2.R, R/lmplot2.R, R/plot.lm.R, - man/boxplot.n.Rd, man/boxplot2.Rd, man/gplots-deprecated.Rd, - man/lmplot2.Rd, man/plot.lm2.Rd: Rename boxplot.n to boxplt2 and - plot.lm2 to lmplot2 - * [r1737] man/lmplot2.Rd: Make lmplot2 manual page from plot.lm.2 - manual page. - * [r1736] man/boxplot2.Rd: Make boxplot2 manual page from boxplot.n - manual page. - * [r1735] man/gplots-deprecated.Rd: Create deprecated man page from - boxplot.n man page + * [r1740] Add boxplot2 and lmplot2 to NAMESPACE + * [r1739] Update for gplots release 2.12.1 + * [r1738] Rename boxplot.n to boxplt2 and plot.lm2 to lmplot2 + * [r1737] Make lmplot2 manual page from plot.lm.2 manual page. + * [r1736] Make boxplot2 manual page from boxplot.n manual page. + * [r1735] Create deprecated man page from boxplot.n man page 2013-10-12 warnes - * [r1734] inst/NEWS: Update NEWS with latest changes - * [r1733] man/ci2d.Rd: Mark one example dontrun to avoid --as-cran - warning. + * [r1734] Update NEWS with latest changes + * [r1733] Mark one example dontrun to avoid --as-cran warning. 2013-10-11 warnes - * [r1732] R/overplot.R: Allow standard S3 method handling to locate - the correct function. - * [r1731] R/overplot.R: Fix error when a subgroup contains no - finite values - * [r1730] tests/heatmap2Test.Rout.save: Update test output - * [r1729] DESCRIPTION: Move several packages from Depends to - Imports, Suggests - * [r1728] man/ci2d.Rd: Use gdata::nobs in example - * [r1727] NAMESPACE: caTools and KernSmooth now have namespaces, so - import from them. - * [r1726] inst/NEWS: Update files for gplots 2.12.0 - * [r1725] DESCRIPTION, inst/NEWS: Update files for gplots 2.12.0 - * [r1724] R/heatmap.2.R, man/heatmap.2.Rd: Add parameters to - control row and column label positioning, rotation, - justification, and offset. - * [r1723] R/venn.R: Fix bug in getVennCounts.data.frame when number - of TRUE cases in each variable are equal. + * [r1732] Allow standard S3 method handling to locate the correct + function. + * [r1731] Fix error when a subgroup contains no finite values + * [r1730] Update test output + * [r1729] Move several packages from Depends to Imports, Suggests + * [r1728] Use gdata::nobs in example + * [r1727] caTools and KernSmooth now have namespaces, so import + from them. + * [r1726] Update files for gplots 2.12.0 + * [r1725] Update files for gplots 2.12.0 + * [r1724] Add parameters to control row and column label + positioning, rotation, justification, and offset. + * [r1723] Fix bug in getVennCounts.data.frame when number of TRUE + cases in each variable are equal. 2013-06-28 warnes - * [r1680] inst/doc/BalloonPlot.pdf: Update PDF file, including new - email addresses + * [r1680] Update PDF file, including new email addresses 2013-06-27 warnes - * [r1679] inst/NEWS: Update for gplots 2.11.3 - * [r1678] DESCRIPTION: Update for release 2.11.3 - * [r1677] tests/heatmap2Test.Rout.save: Update with tests for only - 1 row/column separator - * [r1676] man/plotmeans.Rd: Fix typo - * [r1675] tests/heatmap2Test.R: Add test for one row/column - separator - * [r1674] R/baseOf.R: Add more in-line comments - * [r1673] R/sinkplot.R, man/sinkplot.Rd: Modify sinkplot to use a - local environement to store its information instead of the global - environment. + * [r1679] Update for gplots 2.11.3 + * [r1678] Update for release 2.11.3 + * [r1677] Update with tests for only 1 row/column separator + * [r1676] Fix typo + * [r1675] Add test for one row/column separator + * [r1674] Add more in-line comments + * [r1673] Modify sinkplot to use a local environement to store its + information instead of the global environment. 2013-03-24 warnes - * [r1647] inst/NEWS: Update news for release 2.11.2 - * [r1646] R/barplot2.R, man/barplot2.Rd: Add ci.width argument to - barplot2() to allow varying the length of the 't' at the end of - confidence interval bars. - * [r1642] DESCRIPTION: Update for release 2.11.2 - * [r1641] man/lowess.Rd: Update manual page for lowess.default() to - match changed argument list for lowess() in R 3.0.0 + * [r1647] Update news for release 2.11.2 + * [r1646] Add ci.width argument to barplot2() to allow varying the + length of the 't' at the end of confidence interval bars. + * [r1642] Update for release 2.11.2 + * [r1641] Update manual page for lowess.default() to match changed + argument list for lowess() in R 3.0.0 2012-12-14 warnes - * [r1631] R/plot.venn.R: Fix typo: warn() instead of warning(). - * [r1630] vignettes/venn.Rnw: Fix syntax of VignetteIndexEntry in - venn.Rnw. - * [r1629] vignettes/venn.Rnw, vignettes/venn.pdf: Add generated - vignette pdf. - * [r1628] vignettes/venn.Rnw: Add required VignetteIndexEntry - metadata to venn vignette code. - * [r1627] DESCRIPTION, inst/NEWS: Update DESCRIPTION and NEWS for - release 2.11.1. - * [r1626] R/baseOf.R, R/plot.venn.R, R/venn.R, vignettes, - vignettes/venn.Rnw: Improve venn() to work with PDF and - Sweave/pdflatex. Provide a vignette for venn(). - * [r1625] R/heatmap.2.R: Fix error in processing the colsep - argument to heatmap.2. - * [r1624] man/plotmeans.Rd: Clarify that plotmeans is intended for - a *continuous* outcome based on + * [r1631] Fix typo: warn() instead of warning(). + * [r1630] Fix syntax of VignetteIndexEntry in venn.Rnw. + * [r1629] Add generated vignette pdf. + * [r1628] Add required VignetteIndexEntry metadata to venn vignette + code. + * [r1627] Update DESCRIPTION and NEWS for release 2.11.1. + * [r1626] Improve venn() to work with PDF and Sweave/pdflatex. + Provide a vignette for venn(). + * [r1625] Fix error in processing the colsep argument to heatmap.2. + * [r1624] Clarify that plotmeans is intended for a *continuous* + outcome based on a *factor* grouping level. - * [r1623] inst/doc/BalloonPlot.pdf: Replace corrupted - BalloonPlot.pdf file and remove svn properties that were causing - it to be corrupted. + * [r1623] Replace corrupted BalloonPlot.pdf file and remove svn + properties that were causing it to be corrupted. 2012-06-08 warnes - * [r1558] inst/NEWS: Update NEWS for 2.11.0 release. - * [r1557] DESCRIPTION, R/barplot2.R, R/ooplot.R, R/plotCI.R, - R/sinkplot.R, man/qqnorm.aov.Rd, tests/heatmap2Test.Rout.save: - Fix R CMD check warnings. - * [r1556] man/hist2d.Rd: Move incorrectly placed closing brace. + * [r1558] Update NEWS for 2.11.0 release. + * [r1557] Fix R CMD check warnings. + * [r1556] Move incorrectly placed closing brace. 2012-06-07 warnes - * [r1555] R/ci2d.R, R/hist2d.R, R/print.hist2d.R, man/hist2d.Rd: - Object returned by hist2d() has been changed: + * [r1555] Object returned by hist2d() has been changed: - $x and $y now contain the n midpoints of the bins in each direction - $x.breaks, $y.breaks now contain the n+1 limits of the bins in each direction The function print.hist2d() has been updated appropriately. - * [r1554] R/hist2d.R: Correct error in handling binning: - (N+1)x(N+1) bins were being created + * [r1554] Correct error in handling binning: (N+1)x(N+1) bins were + being created instead of NxN bins, and the highest row/column in each direction was being omitted from the results and plot. - * [r1553] R/plotmeans.R, man/plotmeans.Rd: Add default value for - lwd argument to plotmeans() + * [r1553] Add default value for lwd argument to plotmeans() 2012-05-31 warnes - * [r1533] man/qqnorm.aov.Rd: Properly mark up S3 method. + * [r1533] Properly mark up S3 method. 2011-12-09 warnes - * [r1519] R/plotmeans.R, man/plotmeans.Rd: Add 'lwd' (linewidth) to - arguments handled by plotmeans. + * [r1519] Add 'lwd' (linewidth) to arguments handled by plotmeans. 2011-09-02 warnes - * [r1505] inst/NEWS: Update NEWS for release 2.10.1. - * [r1504] DESCRIPTION: Increment version counter. - * [r1503] man/ci2d.Rd, man/hist2d.Rd: Add necessary alias statment - to man files for for 'hist2d' and 'ci2d' + * [r1505] Update NEWS for release 2.10.1. + * [r1504] Increment version counter. + * [r1503] Add necessary alias statment to man files for for + 'hist2d' and 'ci2d' print methods. - * [r1502] R/print.hist2d, R/print.hist2d.R: Fix naming error - * [r1501] NAMESPACE, R/ci2d.R, R/hist2d.R, R/print.ci2d.R, - R/print.hist2d, man/ci2d.Rd, man/hist2d.Rd: Provide print() - methods for 'hist2d' and 'ci2d' objects. - * [r1498] DESCRIPTION: Correct dependence on R >= 2.10 + * [r1502] Fix naming error + * [r1501] Provide print() methods for 'hist2d' and 'ci2d' objects. + * [r1498] Correct dependence on R >= 2.10 2011-09-01 warnes - * [r1491] NAMESPACE, man/ci2d.Rd: - Correct issues in ci2d() man - page. - * [r1490] DESCRIPTION, NAMESPACE, tests/heatmap2Test.Rout.save: - - Comment out import from KernSmooth in NAMESPACES, since + * [r1491] - Correct issues in ci2d() man page. + * [r1490] - Comment out import from KernSmooth in NAMESPACES, since KernSmooth doesn't provide a namespace. - Update a test output. - * [r1489] DESCRIPTION, inst/NEWS: - Update NEWS file and correct - version number - * [r1488] DESCRIPTION: - Depend on KernSmooth package. Increment - version number. - * [r1487] NAMESPACE: - Depend on KernSmooth package and import - 'bkdeD2' and 'dpik'. - * [r1486] R/ci2d.R, man/ci2d.Rd: Improvements to ci2d(): + * [r1489] - Update NEWS file and correct version number + * [r1488] - Depend on KernSmooth package. Increment version number. + * [r1487] - Depend on KernSmooth package and import 'bkdeD2' and + 'dpik'. + * [r1486] Improvements to ci2d(): - Add option to utilize KernDensity::bkde2D to estimate the 2-d density (now the default). @@ -388,63 +430,53 @@ level to make it easier to select desired contours. - Improve handling of x and y labels - * [r1485] man/hist2d.Rd: Remove log tag and comments from top of - the file. + * [r1485] Remove log tag and comments from top of the file. 2011-08-26 warnes - * [r1478] inst/NEWS: Update NEWS for 2.10.0 release - * [r1477] DESCRIPTION: Add dependency on R>= 2.10 to handle - compressed Rda data file. - * [r1476] data/rtPCR.rda: Compress rtPCR example data set to make - distributed package smaller. - * [r1475] R/ci2d.R: Remove '1.0' confidence line from + * [r1478] Update NEWS for 2.10.0 release + * [r1477] Add dependency on R>= 2.10 to handle compressed Rda data + file. + * [r1476] Compress rtPCR example data set to make distributed + package smaller. + * [r1475] Remove '1.0' confidence line from ci2d(..,show="contour"). 2011-08-25 warnes - * [r1474] DESCRIPTION, NAMESPACE, R/ci2d.R, man/ci2d.Rd, - man/rich.colors.Rd: - Add 'ci2d()' to compute 2-dimensional - emipirical confidence interval. + * [r1474] - Add 'ci2d()' to compute 2-dimensional emipirical + confidence interval. - Fix parse error in help page for 'rich.colors()'. 2011-08-16 warnes - * [r1473] DESCRIPTION: Update DESCRIPTION file for 2.8.1. - * [r1472] R/rich.colors.R, man/rich.colors.Rd: Add 'alpha' argument - to rich.colors() to control transparency. - * [r1471] R/hist2d.R, man/hist2d.Rd: Accellerate hist2d by - replacing for() loop with tapply(), and allow user to specify - summary function applied, per suggestion by Peter Hagedorn (PHA - -at- santaris -dot- com). + * [r1473] Update DESCRIPTION file for 2.8.1. + * [r1472] Add 'alpha' argument to rich.colors() to control + transparency. + * [r1471] Accellerate hist2d by replacing for() loop with tapply(), + and allow user to specify summary function applied, per + suggestion by Peter Hagedorn (PHA -at- santaris -dot- com). 2011-05-02 arnima - * [r1470] R/rich.colors.R, man/rich.colors.Rd: Added argument - 'alpha' and removed argument 'rgb' in rich.colors() + * [r1470] Added argument 'alpha' and removed argument 'rgb' in + rich.colors() 2010-12-13 warnes - * [r1463] R/heatmap.2.R: Correct error that arises when data - includes NA values, identified by Melissa Key + * [r1463] Correct error that arises when data includes NA values, + identified by Melissa Key 2010-06-11 warnes - * [r1446] man/venn.Rd: Fix errors detected by R CMD check - * [r1445] man/venn.Rd: Fix errors detected by R CMD check - * [r1444] man/venn.Rd: Use 'TRUE' instead of 'T' for true in venn - man page - * [r1443] DESCRIPTION, NAMESPACE, inst/NEWS: Update for gplots - 2.8.0 - * [r1442] R/baseOf.R: Moved baseOf() into a separate file - * [r1441] man/balloonplot.Rd, man/bandplot.Rd, man/boxplot.n.Rd, - man/colorpanel.Rd, man/hist2d.Rd, man/ooplot.Rd, man/overplot.Rd, - man/plot.lm2.Rd, man/plotCI.Rd, man/plotmeans.Rd, - man/residplot.Rd, man/sinkplot.Rd, man/smartlegend.Rd, - man/space.Rd, man/textplot.Rd, man/wapply.Rd: Update Greg's email - address - * [r1440] R/plot.venn.R, R/venn.R, man/venn.Rd: - venn() now - returns an object of class venn() and a plot method for + * [r1446] Fix errors detected by R CMD check + * [r1445] Fix errors detected by R CMD check + * [r1444] Use 'TRUE' instead of 'T' for true in venn man page + * [r1443] Update for gplots 2.8.0 + * [r1442] Moved baseOf() into a separate file + * [r1441] Update Greg's email address + * [r1440] - venn() now returns an object of class venn() and a plot + method for this class is provided. - Manual page for venn has been improved, based on contributions @@ -453,482 +485,386 @@ 2010-02-17 warnes - * [r1420] DESCRIPTION, R/hist2d.R, inst/NEWS: Improve performance - of hist2d thanks to suggestion by Joerg van den Hoff. + * [r1420] Improve performance of hist2d thanks to suggestion by + Joerg van den Hoff. 2010-01-22 arnima - * [r1372] R/rich.color.R, R/rich.colors.R, man/rich.color.Rd, - man/rich.colors.Rd: Renamed files rich.color.* to rich.colors.* - and renamed rich.colors args + * [r1372] Renamed files rich.color.* to rich.colors.* and renamed + rich.colors args 2009-11-16 arnima - * [r1367] R/rich.color.R: Minor reformatting only. + * [r1367] Minor reformatting only. 2009-11-12 warnes - * [r1365] DESCRIPTION, R/plotmeans.R, inst/NEWS, - tests/plotmeans_nobars.R: Correct bug reported by Alan Yong: - plotmeans() crashed when 'bars=FALSE'. + * [r1365] Correct bug reported by Alan Yong: plotmeans() crashed + when 'bars=FALSE'. 2009-10-22 warnes - * [r1364] R/heatmap.2.R: Fixed typo in bug fix. - * [r1363] DESCRIPTION, inst/NEWS: Update NEWS and DESCRIPTION for - gplots 2.7.3 - * [r1362] R/heatmap.2.R: Fix transposed display of data (but not - labels) in heatmap.2 when symm=TRUE + * [r1364] Fixed typo in bug fix. + * [r1363] Update NEWS and DESCRIPTION for gplots 2.7.3 + * [r1362] Fix transposed display of data (but not labels) in + heatmap.2 when symm=TRUE 2009-10-12 warnes [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/r-gregmisc -r 2110 From noreply at r-forge.r-project.org Fri Mar 25 20:09:16 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 20:09:16 +0100 (CET) Subject: [R-gregmisc-commits] r2111 - pkg/gplots Message-ID: <20160325190916.33697187932@r-forge.r-project.org> Author: warnes Date: 2016-03-25 20:09:15 +0100 (Fri, 25 Mar 2016) New Revision: 2111 Modified: pkg/gplots/DESCRIPTION Log: Fix typos and quote uncommon words to make R CMD check happy Modified: pkg/gplots/DESCRIPTION =================================================================== --- pkg/gplots/DESCRIPTION 2016-03-25 18:48:39 UTC (rev 2110) +++ pkg/gplots/DESCRIPTION 2016-03-25 19:09:15 UTC (rev 2111) @@ -10,15 +10,15 @@ - calculating and plotting two-dimensional data summaries ('ci2d', 'hist2d'), - enhanced regression diagnostic plots ('lmplot2', 'residplot'), - - formula-enabled interface to stats::lowess function ('lowess'), + - formula-enabled interface to 'stats::lowess' function ('lowess'), - displaying textual data in plots ('textplot', 'sinkplot'), - plotting a matrix where each cell contains a dot whose size reflects the relative magnitude of the elements ('balloonplot'), - - plotting venn diagrams ('venn'), + - plotting "Venn" diagrams ('venn'), - displaying Open-Office style plots ('ooplot'), - - plotting multiple datasets on same region, with separate axes + - plotting multiple data on same region, with separate axes ('overplot'), - - plotting means and cofidence intervals ('plotCI', 'plotmeans'), + - plotting means and confidence intervals ('plotCI', 'plotmeans'), - spacing points in an x-y plot so they don't overlap ('space'). Depends: R (>= 3.0) Imports: gtools, gdata, stats, caTools, KernSmooth From noreply at r-forge.r-project.org Fri Mar 25 20:09:34 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 20:09:34 +0100 (CET) Subject: [R-gregmisc-commits] r2112 - pkg/gplots/man Message-ID: <20160325190934.4C1AC187932@r-forge.r-project.org> Author: warnes Date: 2016-03-25 20:09:33 +0100 (Fri, 25 Mar 2016) New Revision: 2112 Modified: pkg/gplots/man/heatmap.2.Rd Log: Update URL for RColorBrewer Modified: pkg/gplots/man/heatmap.2.Rd =================================================================== --- pkg/gplots/man/heatmap.2.Rd 2016-03-25 19:09:15 UTC (rev 2111) +++ pkg/gplots/man/heatmap.2.Rd 2016-03-25 19:09:33 UTC (rev 2112) @@ -276,7 +276,7 @@ The default colors range from red to white (\code{heat.colors}) and are not pretty. Consider using enhancements such as the \pkg{RColorBrewer} package, - \url{http://cran.r-project.org/web/packages/RColorBrewer/} + \url{https://cran.r-project.org/package=RColorBrewer} to select better colors. By default four components will be displayed in the plot. At the top From noreply at r-forge.r-project.org Fri Mar 25 23:05:06 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 23:05:06 +0100 (CET) Subject: [R-gregmisc-commits] r2113 - pkg/SASxport/R Message-ID: <20160325220507.0628F187E8C@r-forge.r-project.org> Author: warnes Date: 2016-03-25 23:05:06 +0100 (Fri, 25 Mar 2016) New Revision: 2113 Modified: pkg/SASxport/R/fstr.R pkg/SASxport/R/makeSASNames.R pkg/SASxport/R/parseFormat.R pkg/SASxport/R/read.xport.R pkg/SASxport/R/write.xport.R pkg/SASxport/R/xport.namestr.R Log: Specify that nchar should return the number of bytes Modified: pkg/SASxport/R/fstr.R =================================================================== --- pkg/SASxport/R/fstr.R 2016-03-25 19:09:33 UTC (rev 2112) +++ pkg/SASxport/R/fstr.R 2016-03-25 22:05:06 UTC (rev 2113) @@ -1,6 +1,6 @@ fstr <- function(name, length, digits) { - invalid <- function(x) is.null(x) | ( length(x)<1 ) | ( nchar(x) < 1 ) | x==0 + invalid <- function(x) is.null(x) | ( length(x)<1 ) | ( nchar(x, "bytes") < 1 ) | x==0 inner <- function(i) { if( invalid(name[i]) ) Modified: pkg/SASxport/R/makeSASNames.R =================================================================== --- pkg/SASxport/R/makeSASNames.R 2016-03-25 19:09:33 UTC (rev 2112) +++ pkg/SASxport/R/makeSASNames.R 2016-03-25 22:05:06 UTC (rev 2113) @@ -6,9 +6,9 @@ # Step 0: converce to uppercase names <- toupper(names) - + # Step 1: expand/truncate to 8 characters - tooLong <- nchar(names)>8 + tooLong <- nchar(names, "bytes")>8 if (any(tooLong)) { shortNames <- substr(as.character(names), 1, nchar) @@ -28,18 +28,18 @@ passes <- passes+1 dups <- duplicated(varNames) repeatCount <- table(varNames)-1 - digitChars <- nchar(as.character(repeatCount))+1 + digitChars <- nchar(as.character(repeatCount), "bytes")+1 names(digitChars) <- names(repeatCount) newNames <- make.names(substr(varNames, 1, nchar-digitChars[varNames]), unique=TRUE) changed <- newNames != names - + ##newNames[changed] <- gsub("\\.([0-9]+)$","\\1", newNames[changed]) varNames <- newNames } if(any(duplicated(varNames))) stop("Unable to make all names unique after ", passes, " passes.") - + if(any(dups) && !quiet) warning("Made ",sum(dups)," duplicate names unique.") Modified: pkg/SASxport/R/parseFormat.R =================================================================== --- pkg/SASxport/R/parseFormat.R 2016-03-25 19:09:33 UTC (rev 2112) +++ pkg/SASxport/R/parseFormat.R 2016-03-25 22:05:06 UTC (rev 2113) @@ -17,7 +17,7 @@ { retval$name <- substr(format,0,index-1)[1] - lenStr <- substr(format, index, nchar(format)) + lenStr <- substr(format, index, nchar(format, "bytes")) index <- regexpr("\\.", lenStr) if(index==-1) @@ -28,7 +28,7 @@ else { retval$len <- as.numeric(substr(lenStr, 0, index-1)) - retval$digits <- as.numeric(substr(lenStr, index+1, nchar(lenStr))) + retval$digits <- as.numeric(substr(lenStr, index+1, nchar(lenStr, "bytes"))) } } Modified: pkg/SASxport/R/read.xport.R =================================================================== --- pkg/SASxport/R/read.xport.R 2016-03-25 19:09:33 UTC (rev 2112) +++ pkg/SASxport/R/read.xport.R 2016-03-25 22:05:06 UTC (rev 2113) @@ -40,8 +40,8 @@ scat("Checking if the specified file has the appropriate header") xport.file.header <- "HEADER RECORD*******LIBRARY HEADER RECORD!!!!!!!000000000000000000000000000000 " - file.header <- readBin( file, what=character(0), n=1, size=nchar(xport.file.header) ) - file.header <- substr(file.header, start=1, stop=nchar(xport.file.header) ) + file.header <- readBin( file, what=character(0), n=1, size=nchar(xport.file.header, "bytes") ) + file.header <- substr(file.header, start=1, stop=nchar(xport.file.header, "bytes") ) if( !identical(xport.file.header, file.header) ) stop("The specified file does not start with a SAS xport file header!") Modified: pkg/SASxport/R/write.xport.R =================================================================== --- pkg/SASxport/R/write.xport.R 2016-03-25 19:09:33 UTC (rev 2112) +++ pkg/SASxport/R/write.xport.R 2016-03-25 22:05:06 UTC (rev 2113) @@ -188,7 +188,7 @@ # compute variable length if(is.character(var)) - varLen <- max(c(8,nchar(var) ) ) + varLen <- max(c(8,nchar(var, "bytes") ) ) else varLen <- 8 Modified: pkg/SASxport/R/xport.namestr.R =================================================================== --- pkg/SASxport/R/xport.namestr.R 2016-03-25 19:09:33 UTC (rev 2112) +++ pkg/SASxport/R/xport.namestr.R 2016-03-25 22:05:06 UTC (rev 2113) @@ -4,7 +4,7 @@ varName, # name of variable varNum, # variable number (starting at 1) - varPos, # record position of varible (starting at 0) + varPos, # record position of varible (starting at 0) # optional arguments varLength, # variable length @@ -12,11 +12,11 @@ # attribute if present, otherwise # defaults to R variable name) - fName="", - fLength=0, + fName="", + fLength=0, fDigits=0, just=c("left","right"), - + iName="", iLength=0, iDigits=0 @@ -24,25 +24,25 @@ { if(is.factor(var)) var <- as.character(var) - + isChar = is.character(var) if(missing(varLength)) if(isChar) - varLength <- max(nchar(var)) + varLength <- max(nchar(var, "bytes")) else varLength <- 8 if( missing(varLabel) || is.null(varLabel) ) - varLabel <- "" + varLabel <- "" just <- match.arg(just) if(just=="left") justVal <- 0 else justVal <- 1 - - + + ## force variable name into format permitted by SAS. Starts with ## alpha, alpha, numbers, and underscore permitted. R's ## make.names() function almost does what we want, but allows @@ -52,24 +52,24 @@ ## Note that the variable name field in the xport file only permits ## 8 characters, so names will be truncated. - + .C("fill_namestr", isChar = as.integer(isChar), # Bool: Is this a character varible nlng = as.integer(varLength), # LENGTH OF VARIABLE IN OBSERVATION nvar0 = as.integer(varNum), # VARNUM nname = toupper(as.character(varName)), # NAME OF VARIABLE nlabel = as.character(varLabel), # LABEL OF VARIABLE - + nform = toupper(as.character(fName)), # NAME OF FORMAT nfl = as.integer(fLength), # FORMAT FIELD LENGTH OR 0 nfd = as.integer(fDigits), # FORMAT NUMBER OF DECIMALS nfj = as.integer(justVal), # 0=LEFT JUSTIFICATION, 1=RIGHT JUST - + niform = toupper(as.character(iName)), # NAME OF INPUT FORMAT nifl = as.integer(iLength), # INFORMAT LENGTH ATTRIBUTE nifd = as.integer(iDigits), # INFORMAT NUMBER OF DECIMALS - npos = as.integer(varPos), # POSITION OF VALUE IN OBSERVATION + npos = as.integer(varPos), # POSITION OF VALUE IN OBSERVATION PACKAGE="SASxport" ) From noreply at r-forge.r-project.org Fri Mar 25 23:05:55 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 23:05:55 +0100 (CET) Subject: [R-gregmisc-commits] r2114 - pkg/SASxport/R Message-ID: <20160325220555.DCC1B187E8C@r-forge.r-project.org> Author: warnes Date: 2016-03-25 23:05:55 +0100 (Fri, 25 Mar 2016) New Revision: 2114 Modified: pkg/SASxport/R/AFirst.lib.s pkg/SASxport/R/makeNames.R pkg/SASxport/R/testDateTime.R Log: Remove code supporting S-Plus Modified: pkg/SASxport/R/AFirst.lib.s =================================================================== --- pkg/SASxport/R/AFirst.lib.s 2016-03-25 22:05:06 UTC (rev 2113) +++ pkg/SASxport/R/AFirst.lib.s 2016-03-25 22:05:55 UTC (rev 2114) @@ -1,5 +1,5 @@ ## -## Code originally from Frank Harrell's 'Hmisc' library: +## Code originally from Frank Harrell's 'Hmisc' library: ## http://biostat.mc.vanderbilt.edu/twiki/bin/view/Main/Hmisc ## Copied with permission on 2007-08-04 ## @@ -8,8 +8,8 @@ under.unix <- !(version$os=='Microsoft Windows' || version$os=='Win32' || version$os=='mingw32') -.R. <- TRUE -.SV4. <- FALSE +# .R. <- TRUE +# .SV4. <- FALSE .noGenenerics <- TRUE # faster loading as new methods not used @@ -17,9 +17,9 @@ existsFunction <- function(...) exists(..., mode='function') } -if(.R.) { +# if(.R.) { ## create some function definitions just to avoid R CMD CHECK warnings timeDate <- function(...) stop("Not Implemented") - dates <- function(...) stop("Not Implemented") -} +# dates <- function(...) stop("Not Implemented") +# } Modified: pkg/SASxport/R/makeNames.R =================================================================== --- pkg/SASxport/R/makeNames.R 2016-03-25 22:05:06 UTC (rev 2113) +++ pkg/SASxport/R/makeNames.R 2016-03-25 22:05:55 UTC (rev 2114) @@ -1,16 +1,16 @@ ## -## Code originally from Frank Harrell's 'Hmisc' library: +## Code originally from Frank Harrell's 'Hmisc' library: ## http://biostat.mc.vanderbilt.edu/twiki/bin/view/Main/Hmisc ## Copied with permission on 2007-08-04 ## makeNames <- function(names, unique=FALSE, allow=NULL) { - ## Runs make.names with exceptions in vector allow - ## By default, R 1.9 make.names is overridden to convert _ to . as - ## with S-Plus and previous versions of R. Specify allow='_' otherwise. - if(!.R. & length(allow)) - stop('does not apply for S-Plus') + # ## Runs make.names with exceptions in vector allow + # ## By default, R 1.9 make.names is overridden to convert _ to . as + # ## with S-Plus and previous versions of R. Specify allow='_' otherwise. + # if(!.R. & length(allow)) + # stop('does not apply for S-Plus') n <- make.names(names, unique) if(!length(allow)) n <- gsub('_', '.', n) Modified: pkg/SASxport/R/testDateTime.R =================================================================== --- pkg/SASxport/R/testDateTime.R 2016-03-25 22:05:06 UTC (rev 2113) +++ pkg/SASxport/R/testDateTime.R 2016-03-25 22:05:55 UTC (rev 2114) @@ -1,5 +1,5 @@ ## -## Code originally from Frank Harrell's 'Hmisc' library: +## Code originally from Frank Harrell's 'Hmisc' library: ## http://biostat.mc.vanderbilt.edu/twiki/bin/view/Main/Hmisc ## Copied with permission on 2007-08-04 ## @@ -14,28 +14,32 @@ if(!length(cl)) return(FALSE) - dc <- if(.R.) - c('Date', 'POSIXt','POSIXct','dates','times','chron') - else - c('timeDate','date','dates','times','chron') - - dtc <- if(.R.) - c('POSIXt','POSIXct','chron') - else - c('timeDate','chron') - + # dc <- if(.R.) + # c('Date', 'POSIXt','POSIXct','dates','times','chron') + # else + # c('timeDate','date','dates','times','chron') + dc <- c('Date', 'POSIXt','POSIXct','dates','times','chron') + + # dtc <- if(.R.) + # c('POSIXt','POSIXct','chron') + # else + # c('timeDate','chron') + dtc <- c('POSIXt','POSIXct','chron') + switch(what, either = any(cl %in% dc), both = any(cl %in% dtc), timeVaries = { - if('chron' %in% cl || 'Date' %in% cl || !.R.) { + #if('chron' %in% cl || 'Date' %in% cl || !.R.) { + if('chron' %in% cl || 'Date' %in% cl) { ## chron or S+ timeDate y <- as.numeric(x) length(unique(round(y - floor(y),13))) > 1 } - else if(.R.) + # else if(.R.) + else length(unique(format(x,'%H%M%S'))) > 1 - else - FALSE + # else + # FALSE }) } From noreply at r-forge.r-project.org Fri Mar 25 23:06:48 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 23:06:48 +0100 (CET) Subject: [R-gregmisc-commits] r2115 - pkg/SASxport/man Message-ID: <20160325220648.BB6F3187E8C@r-forge.r-project.org> Author: warnes Date: 2016-03-25 23:06:48 +0100 (Fri, 25 Mar 2016) New Revision: 2115 Modified: pkg/SASxport/man/read.xport.Rd Log: Add code to avoid extraneous label output from describe(). Modified: pkg/SASxport/man/read.xport.Rd =================================================================== --- pkg/SASxport/man/read.xport.Rd 2016-03-25 22:05:55 UTC (rev 2114) +++ pkg/SASxport/man/read.xport.Rd 2016-03-25 22:06:48 UTC (rev 2115) @@ -200,7 +200,7 @@ library(Hmisc) describe(w$TEST) # see labels, format names for dataset test -lapply(w, describe)# see descriptive stats in more detail for each variable +lapply(w, describe, "")# see descriptive stats in more detail for each variable contents(w$TEST) # another way to see variable attributes lapply(w, contents)# show contents of individual items in more detail From noreply at r-forge.r-project.org Fri Mar 25 23:07:45 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 23:07:45 +0100 (CET) Subject: [R-gregmisc-commits] r2116 - pkg/SASxport Message-ID: <20160325220745.1DA7A187E8C@r-forge.r-project.org> Author: warnes Date: 2016-03-25 23:07:43 +0100 (Fri, 25 Mar 2016) New Revision: 2116 Modified: pkg/SASxport/NAMESPACE Log: Remove references to non-existen functions Modified: pkg/SASxport/NAMESPACE =================================================================== --- pkg/SASxport/NAMESPACE 2016-03-25 22:06:48 UTC (rev 2115) +++ pkg/SASxport/NAMESPACE 2016-03-25 22:07:43 UTC (rev 2116) @@ -41,7 +41,7 @@ ## S3method(label, data.frame) S3method(SASformat, data.frame) S3method(SASiformat, data.frame) -S3method(SAStype, data.frame) +##S3method(SAStype, data.frame) ## S3method("label<-", default) S3method("SASformat<-", default) @@ -51,7 +51,7 @@ ## S3method("label<-", data.frame) S3method("SASformat<-", data.frame) S3method("SASiformat<-", data.frame) -S3method("SAStype<-", data.frame) +##S3method("SAStype<-", data.frame) S3method(print, lookup.xport) S3method(summary, lookup.xport) From noreply at r-forge.r-project.org Fri Mar 25 23:08:20 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Mar 2016 23:08:20 +0100 (CET) Subject: [R-gregmisc-commits] r2117 - in pkg/SASxport: . inst Message-ID: <20160325220820.4741C18431B@r-forge.r-project.org> Author: warnes Date: 2016-03-25 23:08:19 +0100 (Fri, 25 Mar 2016) New Revision: 2117 Modified: pkg/SASxport/DESCRIPTION pkg/SASxport/inst/NEWS Log: Update for SASxport 1.5.0 Modified: pkg/SASxport/DESCRIPTION =================================================================== --- pkg/SASxport/DESCRIPTION 2016-03-25 22:07:43 UTC (rev 2116) +++ pkg/SASxport/DESCRIPTION 2016-03-25 22:08:19 UTC (rev 2117) @@ -1,8 +1,8 @@ Package: SASxport Type: Package Title: Read and Write SAS XPORT Files -Version: 1.5.0 -Date: 2014-07-21 +Version: 1.5.4 +Date: 2016-03-25 Description: This package provides functions for reading, listing the contents of, and writing SAS xport format files. The functions support reading and writing of either Modified: pkg/SASxport/inst/NEWS =================================================================== --- pkg/SASxport/inst/NEWS 2016-03-25 22:07:43 UTC (rev 2116) +++ pkg/SASxport/inst/NEWS 2016-03-25 22:08:19 UTC (rev 2117) @@ -1,3 +1,11 @@ +Version 1.5.4 - 2016-03-25 +-------------------------- + +Other changes: + +- Updated nchar() calls to specify type="byte" for clarity. + + Version 1.5.0 - 2014-07-21 -------------------------- @@ -4,7 +12,7 @@ Bug fixes: - Now works properly on big-endian systems such as the PowerPC, - Spark. (Reported by Brian Ripley )x + Spark. (Reported by Brian Ripley ) - Explicitly cast left bit shifts to avoid undefined C language behavior. (Reported by Brian Ripley) From noreply at r-forge.r-project.org Mon Mar 28 15:50:14 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Mar 2016 15:50:14 +0200 (CEST) Subject: [R-gregmisc-commits] r2118 - pkg/gplots/man Message-ID: <20160328135014.C9902187B97@r-forge.r-project.org> Author: warnes Date: 2016-03-28 15:50:14 +0200 (Mon, 28 Mar 2016) New Revision: 2118 Modified: pkg/gplots/man/gplots-deprecated.Rd Log: Comment out arguments section to avoid R CMD check warning. Modified: pkg/gplots/man/gplots-deprecated.Rd =================================================================== --- pkg/gplots/man/gplots-deprecated.Rd 2016-03-25 22:08:19 UTC (rev 2117) +++ pkg/gplots/man/gplots-deprecated.Rd 2016-03-28 13:50:14 UTC (rev 2118) @@ -8,8 +8,8 @@ \usage{ ## No deprecated functions at this time ## } -\arguments{ -} +#\arguments{ +#} \details{ These functions have been deprecated. Please refer to the manual page for the replacement function: From noreply at r-forge.r-project.org Mon Mar 28 15:51:09 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Mar 2016 15:51:09 +0200 (CEST) Subject: [R-gregmisc-commits] r2119 - pkg/gplots/man Message-ID: <20160328135109.EF03B187B97@r-forge.r-project.org> Author: warnes Date: 2016-03-28 15:51:09 +0200 (Mon, 28 Mar 2016) New Revision: 2119 Modified: pkg/gplots/man/gplots-deprecated.Rd Log: Used wrong comment character. Modified: pkg/gplots/man/gplots-deprecated.Rd =================================================================== --- pkg/gplots/man/gplots-deprecated.Rd 2016-03-28 13:50:14 UTC (rev 2118) +++ pkg/gplots/man/gplots-deprecated.Rd 2016-03-28 13:51:09 UTC (rev 2119) @@ -8,8 +8,8 @@ \usage{ ## No deprecated functions at this time ## } -#\arguments{ -#} +%\arguments{ +%} \details{ These functions have been deprecated. Please refer to the manual page for the replacement function: From noreply at r-forge.r-project.org Mon Mar 28 17:00:02 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Mar 2016 17:00:02 +0200 (CEST) Subject: [R-gregmisc-commits] r2120 - pkg/gplots/man Message-ID: <20160328150002.E7EDF187F09@r-forge.r-project.org> Author: warnes Date: 2016-03-28 17:00:02 +0200 (Mon, 28 Mar 2016) New Revision: 2120 Modified: pkg/gplots/man/heatmap.2.Rd Log: The 'layout' element of the list returned from heatmap.2 is a named list, not a named vector. Modified: pkg/gplots/man/heatmap.2.Rd =================================================================== --- pkg/gplots/man/heatmap.2.Rd 2016-03-28 13:51:09 UTC (rev 2119) +++ pkg/gplots/man/heatmap.2.Rd 2016-03-28 15:00:02 UTC (rev 2120) @@ -322,7 +322,7 @@ \code{trace="both"} or \code{trace="row"} } \item{colorTable}{A three-column data frame providing the lower and upper bound and color for each bin} - \item{layout}{A named numeric vector containing the values used for + \item{layout}{A named list containing the values used for \code{lmat}, \code{lhei}, and \code{lwid}. } } \author{Andy Liaw, original; R. Gentleman, M. Maechler, W. Huber, From noreply at r-forge.r-project.org Mon Mar 28 17:01:21 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Mar 2016 17:01:21 +0200 (CEST) Subject: [R-gregmisc-commits] r2121 - in pkg/gplots: . inst Message-ID: <20160328150121.D919B187F09@r-forge.r-project.org> Author: warnes Date: 2016-03-28 17:01:21 +0200 (Mon, 28 Mar 2016) New Revision: 2121 Modified: pkg/gplots/DESCRIPTION pkg/gplots/inst/NEWS Log: Update gplots version to 3.0.0. Modified: pkg/gplots/DESCRIPTION =================================================================== --- pkg/gplots/DESCRIPTION 2016-03-28 15:00:02 UTC (rev 2120) +++ pkg/gplots/DESCRIPTION 2016-03-28 15:01:21 UTC (rev 2121) @@ -23,7 +23,7 @@ Depends: R (>= 3.0) Imports: gtools, gdata, stats, caTools, KernSmooth Suggests: grid, MASS -Version: 2.18.0 +Version: 3.0.0 Date: 2016-03-25 Author: Gregory R. Warnes, Ben Bolker, Lodewijk Bonebakker, Robert Gentleman, Wolfgang Huber Andy Liaw, Thomas Lumley, Martin Modified: pkg/gplots/inst/NEWS =================================================================== --- pkg/gplots/inst/NEWS 2016-03-28 15:00:02 UTC (rev 2120) +++ pkg/gplots/inst/NEWS 2016-03-28 15:01:21 UTC (rev 2121) @@ -1,4 +1,4 @@ -Release 2.18.0 - 2016-03-24 +Release 3.0.0 - 2016-03-28 --------------------------- New Features: @@ -51,11 +51,11 @@ Other Changes: -- The smartlegend() function has been made defunct and is no - longer available. +- The smartlegend(), plot.lm2(), and boxplot.n() functions are now + defunct. Please use grephics::legend(), lmplot2() or boxplot2() + respectively. - Release 2.17.0 - 2015-05-01 --------------------------- From noreply at r-forge.r-project.org Wed Mar 30 15:52:51 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 30 Mar 2016 15:52:51 +0200 (CEST) Subject: [R-gregmisc-commits] r2122 - pkg/gplots/R Message-ID: <20160330135251.D072918421B@r-forge.r-project.org> Author: warnes Date: 2016-03-30 15:52:51 +0200 (Wed, 30 Mar 2016) New Revision: 2122 Modified: pkg/gplots/R/plot.lowess.R Log: plotLowess() wasn't finding objects in the caller's environment. Modified: pkg/gplots/R/plot.lowess.R =================================================================== --- pkg/gplots/R/plot.lowess.R 2016-03-28 15:01:21 UTC (rev 2121) +++ pkg/gplots/R/plot.lowess.R 2016-03-30 13:52:51 UTC (rev 2122) @@ -1,12 +1,13 @@ -plotLowess <- function (formula, data = parent.frame(), ..., subset=parent.frame(), +plotLowess <- function (formula, data=parent.frame(), ..., subset=parent.frame(), col.lowess="red", lty.lowess=2 ) { m <- match.call(expand.dots=TRUE) m[[1]] <- as.name("plot") - eval(m) + eframe <- parent.frame() + eval(m, eframe) m[[1]] <- as.name("lowess") - lw <- eval(m) + lw <- eval(m, eframe) lines(lw, col=col.lowess, lty=lty.lowess) grid() From noreply at r-forge.r-project.org Wed Mar 30 16:19:37 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 30 Mar 2016 16:19:37 +0200 (CEST) Subject: [R-gregmisc-commits] r2123 - in pkg/gplots: . inst Message-ID: <20160330141937.C510A187E27@r-forge.r-project.org> Author: warnes Date: 2016-03-30 16:19:37 +0200 (Wed, 30 Mar 2016) New Revision: 2123 Modified: pkg/gplots/DESCRIPTION pkg/gplots/inst/ChangeLog Log: Update for gplots 3.0.1. Modified: pkg/gplots/DESCRIPTION =================================================================== --- pkg/gplots/DESCRIPTION 2016-03-30 13:52:51 UTC (rev 2122) +++ pkg/gplots/DESCRIPTION 2016-03-30 14:19:37 UTC (rev 2123) @@ -23,8 +23,8 @@ Depends: R (>= 3.0) Imports: gtools, gdata, stats, caTools, KernSmooth Suggests: grid, MASS -Version: 3.0.0 -Date: 2016-03-25 +Version: 3.0.1 +Date: 2016-03-30 Author: Gregory R. Warnes, Ben Bolker, Lodewijk Bonebakker, Robert Gentleman, Wolfgang Huber Andy Liaw, Thomas Lumley, Martin Maechler, Arni Magnusson, Steffen Moeller, Marc Schwartz, Bill Modified: pkg/gplots/inst/ChangeLog =================================================================== --- pkg/gplots/inst/ChangeLog 2016-03-30 13:52:51 UTC (rev 2122) +++ pkg/gplots/inst/ChangeLog 2016-03-30 14:19:37 UTC (rev 2123) @@ -1,5 +1,30 @@ +2016-03-30 warnes + + * [r2122] R/plot.lowess.R: plotLowess() wasn't finding objects in + the caller's environment. + +2016-03-28 warnes + + * [r2121] DESCRIPTION, inst/NEWS: Update gplots version to 3.0.0. + * [r2120] man/heatmap.2.Rd: The 'layout' element of the list + returned from heatmap.2 is a named list, not a named vector. + * [r2119] man/gplots-deprecated.Rd: Used wrong comment character. + * [r2118] man/gplots-deprecated.Rd: Comment out arguments section + to avoid R CMD check warning. + 2016-03-25 warnes + * [r2112] man/heatmap.2.Rd: Update URL for RColorBrewer + * [r2111] DESCRIPTION: Fix typos and quote uncommon words to make R + CMD check happy + * [r2110] DESCRIPTION, inst/ChangeLog, inst/NEWS: Update files for + gplots 2.18.0 + * [r2109] NAMESPACE: Add imports recommended by R CMD check on + WinBuilder + * [r2108] man/heatmap.2.Rd: Add trailing slash to make R CMD + check's URL testing happy. + * [r2107] tests/heatmap2Test.Rout.save: Update test output to match + corrected messages * [r2106] R/plot.venn.R: Warning message didn't have spaces between words. Minor code reformatting. * [r2105] R/lowess.R: Remove obsolete function to add '...' to From noreply at r-forge.r-project.org Wed Mar 30 17:29:44 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 30 Mar 2016 17:29:44 +0200 (CEST) Subject: [R-gregmisc-commits] r2124 - pkg/gplots/man Message-ID: <20160330152944.DBFD1187E4A@r-forge.r-project.org> Author: warnes Date: 2016-03-30 17:29:44 +0200 (Wed, 30 Mar 2016) New Revision: 2124 Modified: pkg/gplots/man/lowess.Rd Log: Add tests of non-standard evaluation for lowess() and plotLowess(). Modified: pkg/gplots/man/lowess.Rd =================================================================== --- pkg/gplots/man/lowess.Rd 2016-03-30 14:19:37 UTC (rev 2123) +++ pkg/gplots/man/lowess.Rd 2016-03-30 15:29:44 UTC (rev 2124) @@ -120,5 +120,27 @@ # formula method: calculate and plot in a single command # plotLowess(dist ~ speed, data=cars, main="lowess(cars)") + +\dontshow{ +# test non-standard evaluation + +with(cars, plotLowess(dist ~ speed, main="lowess(cars)") ) +with(cars, plot(lowess(dist ~ speed, main="lowess(cars)") ) ) + +idx <- cars$speed > 10 +plotLowess(dist[idx] ~ speed[idx], data=cars, main="lowess(cars)") +plot(lowess(dist[idx] ~ speed[idx], data=cars, main="lowess(cars)")) + +with(cars, plotLowess(dist[idx] ~ speed[idx], main="lowess(cars)") ) +with(cars, plot(lowess(dist[idx] ~ speed[idx], main="lowess(cars)") )) + +local({ +dist <- cars$dist +speed <- cars$speed +plotLowess(dist[idx] ~ speed[idx], main="lowess(cars)") +plot(lowess(dist[idx] ~ speed[idx], main="lowess(cars)")) +}) +} % dontshow + } \keyword{smooth} From noreply at r-forge.r-project.org Wed Mar 30 17:35:49 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 30 Mar 2016 17:35:49 +0200 (CEST) Subject: [R-gregmisc-commits] r2125 - pkg/gplots/inst Message-ID: <20160330153549.43B88187E4A@r-forge.r-project.org> Author: warnes Date: 2016-03-30 17:35:48 +0200 (Wed, 30 Mar 2016) New Revision: 2125 Modified: pkg/gplots/inst/NEWS Log: Update news for gplots 3.0.1. Modified: pkg/gplots/inst/NEWS =================================================================== --- pkg/gplots/inst/NEWS 2016-03-30 15:29:44 UTC (rev 2124) +++ pkg/gplots/inst/NEWS 2016-03-30 15:35:48 UTC (rev 2125) @@ -1,3 +1,16 @@ +Release 3.0.1 - 2016-03-30 +-------------------------- + +Bug Fixes: + +- An error in plotLowess() prevented it from finding objects in + the caller's environment. + +- The manual page for heatmap.2() stated the incorrect type for + the 'layout' element of the return list. It is a named list, + not a named numeric vector. + + Release 3.0.0 - 2016-03-28 ---------------------------