ggplot.Predict: inserted mapping and environment arguments to comply …

…with ggplot generic

 * legend.nomabbrev: fixed bug info (note A; thanks: Alvin Jeffery)
 * Design: fixed bug, was not handling logical predictors correctly in mmcolnames.  Thanks: Max Gordon

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rms
 Version: 4.4-1
-Date: 2015-12-03
+Date: 2015-12-21
 Title: Regression Modeling Strategies
 Author: Frank E Harrell Jr <f.harrell@vanderbilt.edu>
 Maintainer: Frank E Harrell Jr <f.harrell@vanderbilt.edu>

NEWS

@@ -1,4 +1,4 @@
-Changes in version 4.4-1 (2015-12-03)
+Changes in version 4.4-1 (2015-12-21)
    * contrast, residuals.lrm, survreg.distributions, val.prob, validate.ols: changed 1 - pnorm(z) to pnorm(-z) and 1 - pt(z) to pt(-z) to increase precision; thanks: Alexander Ploner
 	 * tests/anova-ols-mult-impute.r: helps to understand sigma and sums of squares when ols is used with fit.mult.impute
 	 * survplot.npsurv: added support for competing risk cumulative incidence plots - see the new state argument
@@ -7,6 +7,9 @@ Changes in version 4.4-1 (2015-12-03)
 	 * Design: if an %ia% object has iaspecial TRUE modifies how mmcolnames is created for that model term to account for an inconsistency in R whereby a categorical variable involved in %ia% when there are only two levels does not generate the usual variable=non-reference value in the column names.
 	 * bj, cph, Glm, lrm, ols, orm: changed to subset model.matrix result on mmcolnames to rigorously require expected design matrix column names to be what model.matrix actually constructed
 	 * npsurv: add numevents and exposure objects to fit object so will have number of events by cause in case of competing risks (summary.survfit does not compute this) as well as with ordinary right-censored single events
+	 * ggplot.Predict: inserted mapping and environment arguments to comply with ggplot generic
+	 * legend.nomabbrev: fixed bug info$Abbrev (note A; thanks: Alvin Jeffery)
+	 * Design: fixed bug, was not handling logical predictors correctly in mmcolnames.  Thanks: Max Gordon
 
 Changes in version 4.4-0 (2015-09-28)
    * contrast.rms: made SE a vector not a matrix, added 4 list logic for nvary, added new test from JoAnn Alvarez

R/ggplot.Predict.s

@@ -1,5 +1,5 @@
 ggplot.Predict <-
-  function(data, formula, groups=NULL,
+  function(data, mapping, formula=NULL, groups=NULL,
            aestype=c('color', 'linetype'),
            conf=c('fill', 'lines'),
            varypred=FALSE,
@@ -18,12 +18,13 @@ ggplot.Predict <-
            histSpike.opts=list(frac=function(f) 0.01 + 
                                  0.02 * sqrt(f - 1)/sqrt(max(f, 2) - 1),
              side=1, nint=100),
-           type=NULL, ggexpr=FALSE, ...)
-{
-  # .xlim, .ylim instead of xlim, ylim to distinguish from ggplot functions
-  sepdiscrete <- match.arg(sepdiscrete)
-  class(data) <- setdiff(class(data), 'Predict')
-  ## so won't involve ggplot.Predict
+           type=NULL, ggexpr=FALSE, ..., environment) {
+
+    if(! length(formula) && ! missing(mapping)) formula <- mapping
+      ## .xlim, .ylim instead of xlim, ylim to distinguish from ggplot functions
+      sepdiscrete <- match.arg(sepdiscrete)
+      class(data) <- setdiff(class(data), 'Predict')
+      ## so won't involve ggplot.Predict
 
   if(varypred) {
     data$.predictor. <- data$.set.
@@ -330,7 +331,7 @@ ggplot.Predict <-
       yhat <- data[i, 'yhat']
       xl <- if(vnames == 'labels') pmlabel[w] else w
       zz <- data.frame(.xx.=z, .yhat=yhat)
-      if(! missing(formula))
+      if(length(formula))
         zz <- cbind(zz, data[i, all.vars(formula), drop=FALSE])
       if(conf.int) {
         zz$lower <- data[i, 'lower']
@@ -407,7 +408,7 @@ ggplot.Predict <-
         g <- c(g, h)
       }
 
-      if(! missing(formula))
+      if(length(formula))
         g <- c(g, sprintf("facet_grid(%s)", deparse(formula)))
 
       if(! is.factor(z) && length(rdata) && w %in% names(rdata)) {
@@ -518,7 +519,7 @@ ggplot.Predict <-
 
     f <- if(length(v) > 1) setdiff(v[-1], groups)
     if(length(f)) {
-      if(missing(formula)) {
+      if(! length(formula)) {
         k <- length(f)
         formula <- if(k == 1) paste('~', f[1])
                    else if(k == 2) paste(f[1], f[2], sep='~')

R/plot.nomogram.s

@@ -315,7 +315,7 @@ plot.nomogram <-
 
 legend.nomabbrev <- function(object, which, x, y=NULL, ncol=3, ...)
 {
-  abb <- attr(object, 'info')$abbrev[[which]]
+  abb <- attr(object, 'info')$Abbrev[[which]]
   if(length(abb)==0) stop(paste('no abbreviation information for',which))
   if(max(nchar(abb$abbrev))==1)
     if(length(y)) legend(x, y, abb$full, ncol=ncol,

R/rms.s

@@ -37,12 +37,15 @@ Design <- function(mf, allow.offset=TRUE, intercept=1) {
   ## matrix to get rid of terms involving strat main effects and to get
   ## rid of interaction terms involving non-reference values
 
-  mmnames <- function(assume.code, rmstrans.names, term.label, iaspecial) {
-    ## prn(assume.code); prn(rmstrans.names); prn(term.label); prn(iaspecial)
+  mmnames <- function(assume.code, rmstrans.names, term.label, iaspecial,
+                      class) {
+    ## prn(assume.code); prn(rmstrans.names); prn(term.label); prn(iaspecial); prn(class)
     ## Don't let >=i be translated to >i:
     rmst <- gsub('>=', '>>', rmstrans.names)
-    w <- if(assume.code == 1 ||
-            (length(iaspecial) && iaspecial)) term.label
+    w <- if(assume.code == 1)
+           ifelse(class == 'logical', paste(term.label, 'TRUE', sep=''),
+                  term.label)
+    else if(length(iaspecial) && iaspecial) term.label
     else if(assume.code == 5) gsub('=', '', rmst)
     else if(assume.code == 8)
       paste(term.label, gsub('.*=', '', rmst), sep='')
@@ -144,6 +147,7 @@ Design <- function(mf, allow.offset=TRUE, intercept=1) {
     if(i  != wts) {
       i1 <- i - response.pres
       xi <- mf[[i]]
+      cls <- rev(class(xi))[1]
       z <- attributes(xi)
       assu <- z$assume.code
       if(! length(assu) || assu != 9) i1.noia <- i1.noia + 1
@@ -179,7 +183,7 @@ Design <- function(mf, allow.offset=TRUE, intercept=1) {
         flabel <- c(flabel, z$label)
         asm <- c(asm, za)
         colnam[[i1]] <- z$colnames
-        mmn <- mmnames(za, colnam[[i1]], Term.labels[i1], z$iaspecial)
+        mmn <- mmnames(za, colnam[[i1]], Term.labels[i1], z$iaspecial, cls)
         mmcolnam[[i1]] <- mmn
         alt <- attr(mmn, 'alt')
         mmcolnamalt[[i1]] <- alt

man/ggplot.Predict.Rd

@@ -22,7 +22,7 @@
   \code{summary.rms}.
 }
 \usage{
-\method{ggplot}{Predict}(data, formula, groups=NULL,
+\method{ggplot}{Predict}(data, mapping, formula=NULL, groups=NULL,
      aestype=c('color', 'linetype'),
      conf=c('fill', 'lines'),
      varypred=FALSE, sepdiscrete=c('no', 'list', 'vertical', 'horizontal'),
@@ -39,10 +39,12 @@
      layout=NULL, addlayer,
      histSpike.opts=list(frac=function(f) 0.01 + 
          0.02 * sqrt(f - 1)/sqrt(max(f, 2) - 1), side=1, nint=100),
-     type=NULL, ggexpr=FALSE, ...)
+     type=NULL, ggexpr=FALSE, ..., environment)
 }
 \arguments{
   \item{data}{a data frame created by \code{Predict}}
+	\item{mapping}{kept because of \code{ggplot} generic setup.  If
+  specified it will be assumed to be \code{formula}.}
 	\item{formula}{
 		a \code{ggplot} faceting formula of the form \code{vertical variables
 		~ horizontal variables}, with variables separated by \code{*} if
@@ -196,6 +198,7 @@ current curve, \code{FALSE} otherwise.  See one of the latter examples.
   character string(s) constructed to invoke \code{ggplot} without
   executing the commands}
 \item{\dots}{ignored}
+\item{environment}{ignored; used to satisfy rules because of the generic ggplot}
 }
 \value{an object of class \code{"ggplot2"} ready for printing.  For the
   case where predictors were not specified to \code{Predict}, 

tests/rms.r

@@ -9,6 +9,7 @@ x2 <- runif(N)
 # Makes last colname x1 %ia% x2 which is really inconsistent:
 model.matrix(~ x1 + rcs(x2) + x1 %ia% x2)
 x3 <- c(rep('A', 33), rep('B', 33), rep('C', 34))
+x4 <- runif(N) > 0.5
 # Makes last 2 colnames x3 %ia% x2x3=B * x2,  x3 %ia% x2x3=C * x2
 model.matrix(~ x3 + rcs(x2) + x3 %ia% x2)
 cph(S ~ x3 + rcs(x2) + x3 %ia% x2)
@@ -20,3 +21,10 @@ cph(S ~ x1 + rcs(x2) + x1 %ia% rcs(x2))
 cph(S ~ x1 + rcs(x2) + x1 %ia% x2)
 
 cph(S ~ x1 * rcs(x2))
+
+ols(time ~ x1 + x4)
+cph(S ~ x1 + x4)
+colnames(model.matrix(~ x1 + x4 + x1 %ia% x4))
+cph(S ~ x1 + x4 + x1 %ia% x4)
+
+