diff --git a/NEWS b/NEWS index 48cb0fd4529..5ebe187e6b7 100644 --- a/NEWS +++ b/NEWS @@ -60,6 +60,8 @@ NEW FEATURES BUG FIXES + o menu(.) works for empty imput + o Changes to the PostScript device driver mean that the volume of output has been reduced to about a third of what it was. diff --git a/config.site b/config.site index 870bf6646aa..054f6ba503b 100644 --- a/config.site +++ b/config.site @@ -5,12 +5,12 @@ ### R is free software; you can redistribute it and/or modify it under ### the terms of the GNU General Public License as published by the Free ### Software Foundation; either version 2 of the License, or (at your -### option) any later version. +### option) any later version. ### ### R is distributed in the hope that it will be useful, but WITHOUT ANY ### WARRANTY; without even the implied warranty of MERCHANTABILITY or ### FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -### License for more details. +### License for more details. ### ### You should have received a copy of the GNU General Public License ### along with R; if not, you can obtain it via the World Wide Web at @@ -24,7 +24,7 @@ # The command used to spool PostScript files to the printer. # If unspecified, the system will look for either "lpr" or "lp" -# R_PRINTCMD= +R_PRINTCMD=prt- # The paper size for the local (PostScript) printer. # It must either be left blank or set to one of "a4" or "letter". @@ -39,14 +39,14 @@ # The command which runs the C compiler. # If unspecified, a search is made for gcc and cc (in that order). # To override this choice, specify the name of the command which runs -# the compiler here, for example `c89'. +# the compiler here, for example `c89'. # CC= # Debugging and optimization options for the C compiler. # Use this to specify CFLAGS for the version of the C compiler specified # above. If unspecified, defaults to "-g -O2" for gcc, and "-g" in all # other cases. -# CFLAGS= +CFLAGS="-g -O2 -Wall" # Header file search directory (`-IDIR') and any other miscellaneous # options for the C preprocessor and compiler. @@ -90,5 +90,5 @@ # FPICFLAGS= # Any special flags which are required by "ld" when creating shared -# libraries. This is usually automatically detected by configure. +# libraries. This is usually automatically detected by configure. # SHLIBLDFLAGS= diff --git a/src/library/base/R/anova.R b/src/library/base/R/anova.R index 6388b3f160d..999d2ba87aa 100644 --- a/src/library/base/R/anova.R +++ b/src/library/base/R/anova.R @@ -1,30 +1,24 @@ -print.anova <- function(x, digits = max(.Options$digits - 2, 3), - signif.stars= .Options$show.signif.stars, ...) -{ - heading <- attr(x, "heading") - if (!is.null(heading)) cat(heading, sep = "\n") - attr(x, "heading") <- NULL - nn <- names(x) +## *ANY* print method should return its argument invisibly! -###-- we should be able to do withOUT for() -###-- and use new print.coefmat(.), instead ! -- MM. - for (i in 1:NCOL(x)) { - xr <- x[[i]] - if (substr(nn[i],1,2) == "Pr") { - x[[i]] <- format.pval(xr, digits = max(1, min(5, digits - 1)), na="") - if(signif.stars) - x$Signif <- c(symnum(xr[!is.na(xr)], corr = FALSE, - cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), - symbols = c("***", "**", "*", ".", " ")), - "") ## 'nterms' ~= 'Residuals' have no P-value +##- nn <- names(x) +##- +##- for (i in 1:NCOL(x)) { +##- xr <- x[[i]] +##- if (substr(nn[i],1,2) == "Pr") { +##- x[[i]] <- format.pval(xr, digits = max(1, min(5, digits - 1)), na="") +##- if(signif.stars) +##- x$Signif <- c(symnum(xr[!is.na(xr)], corr = FALSE, +##- cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), +##- symbols = c("***", "**", "*", ".", " ")), +##- "") ## 'nterms' ~= 'Residuals' have no P-value +##- +##- } else if (!is.factor(xr) && is.numeric(xr)) { +##- cxr <- format(zapsmall(xr, digits=digits), digits=digits) +##- cxr[is.na(xr)] <- "" +##- x[[i]] <- cxr +##- } +##- } +##- print.data.frame(x) + - } else if (!is.factor(xr) && is.numeric(xr)) { - cxr <- format(zapsmall(xr, digits=digits), digits=digits) - cxr[is.na(xr)] <- "" - x[[i]] <- cxr - } - } - print.data.frame(x) -} -## which (invisibly) returns the newly changed, instead of the original x ! diff --git a/src/library/base/R/lm.R b/src/library/base/R/lm.R index d3ca9bcfee0..65824697c21 100644 --- a/src/library/base/R/lm.R +++ b/src/library/base/R/lm.R @@ -382,11 +382,10 @@ anova.lm <- function(object, ...) table[length(p),4:5] <- NA dimnames(table) <- list(c(attr(object$terms,"term.labels"), "Residual"), c("Df","Sum Sq", "Mean Sq", "F", "Pr(>F)")) - result <- list(table=table, - title=paste("Analysis of Variance Table\nResponse:", - formula(object)[[2]])) - class(result) <- "tabular" - result + + structure(table, heading = c("Analysis of Variance Table\n", + paste("Response:", formula(object)[[2]])), + class= "anova")# was "tabular" } anovalist.lm <- function (object, ..., test = NULL) @@ -430,16 +429,15 @@ anovalist.lm <- function (object, ..., test = NULL) "Sum-Sq", "F", "Pr(>F)")) ## construct table and title - title <- "Analysis of Variance Table" + title <- "Analysis of Variance Table\n" topnote <- paste("Model ", format(1:nmodels),": ", models, sep="", collapse="\n") ## calculate test statistic if needed - output <- list(table = table, title = title, topnote=topnote) - class(output) <- "tabular" - return(output) + structure(table, heading = c(title, topnote), class= "anova")# was "tabular" } +## Unused (0.63, Sept.25 1998) --- print.anova() now in ./print.R print.anova.lm <- function(x, digits = max(3, .Options$digits - 3), ...) { cat("\nAnalysis of Variance:\n\n") diff --git a/src/library/base/R/print.R b/src/library/base/R/print.R index b7bc71d951c..d1bac9f69f9 100644 --- a/src/library/base/R/print.R +++ b/src/library/base/R/print.R @@ -8,9 +8,14 @@ print.default <- print.atomic <- function(x,quote=TRUE,...) print.default(x,quote=quote) print.matrix <- function (x, rowlab = dn[[1]], collab = dn[[2]], - quote = TRUE, right = FALSE) { + quote = TRUE, right = FALSE, + na.print=NULL, print.gap=NULL) { x <- as.matrix(x) dn <- dimnames(x) + if(!is.null(print.gap)) warning("'print.gap' is not yet used") + ## and 'na.print' could be done in .Internal(.) as well: + if(!is.null(na.print) && any(ina <- is.na(x))) + x[ina] <- na.print .Internal(print.matrix(x, rowlab, collab, quote, right)) } prmatrix <- .Alias(print.matrix) @@ -73,37 +78,62 @@ print.coefmat <- if(is.null(d <- dim(x)) || length(d) != 2) stop("1st arg. 'x' must be coefficient matrix/d.f./...") - k <- d[2] - (if(missing(tst.ind)) 1 else length(tst.ind)) - has.Pvalue + nc <- d[2] + k <- nc - (if(missing(tst.ind)) 1 else length(tst.ind)) - has.Pvalue ##if(!missing(cs.ind)) && length(cs.ind) > k) stop("wrong k / cs.ind") Cf <- array("", dim=d, dimnames = dimnames(x)) + xm <- as.matrix(x) if(length(cs.ind)>0) { - acs <- abs(coef.se <- x[, cs.ind, drop=FALSE])# = abs(coef. , stderr) + acs <- abs(coef.se <- xm[, cs.ind, drop=FALSE])# = abs(coef. , stderr) ## #{digits} BEFORE decimal point -- for min/max. value: digmin <- 1+floor(log10(range(acs[acs != 0], na.rm= TRUE))) Cf[,cs.ind] <- format(round(coef.se,max(1,digits-digmin)),digits=digits) } if(length(tst.ind)>0) - Cf[, tst.ind]<- format(round(x[, tst.ind], dig=dig.tst), digits=digits) + Cf[, tst.ind]<- format(round(xm[, tst.ind], dig=dig.tst), digits=digits) if(length(zap.ind)>0) - Cf[, zap.ind]<- format(zapsmall(x[, zap.ind], dig=digits),digits=digits) - if(any(r.ind <- !(1:(k+1) %in% c(cs.ind, tst.ind, zap.ind))))#Remaining ind. - Cf[, r.ind] <- format(x[, r.ind], digits=digits) - if(any((not.both.0 <- (c(x)==0)!=(as.numeric(Cf)==0)),na.rm=TRUE)) { - ## not.both.0==TRUE: x !=0, but Cf[] is: --> fix these: - Cf[not.both.0] <- format(x[not.both.0], digits= max(1,digits-1)) + Cf[, zap.ind]<- format(zapsmall(xm[,zap.ind], dig=digits),digits=digits) + if(any(r.ind <- !((1:nc) %in% c(cs.ind, tst.ind, zap.ind))))#Remaining ind. + Cf[, r.ind] <- format(xm[, r.ind], digits=digits) + if(any((not.both.0 <- (c(xm)==0)!=(as.numeric(Cf)==0)),na.rm=TRUE)) { + ## not.both.0==TRUE: xm !=0, but Cf[] is: --> fix these: + Cf[not.both.0] <- format(xm[not.both.0], digits= max(1,digits-1)) } if(has.Pvalue) { - Cf[, d[2]] <- format.pval(x[, d[2]], digits = dig.tst) + Cf[, nc] <- format.pval(xm[, nc], digits = dig.tst) if(signif.stars) { - Signif <- symnum(x[, d[2]], corr = FALSE, + Signif <- symnum(xm[, nc], corr = FALSE, cutpoints = c(0, .001,.01,.05, .1, 1), symbols = c("***","**","*","."," ")) Cf <- cbind(Cf, Signif) } } else signif.stars <- FALSE - print(Cf, quote = FALSE, right = TRUE, ...) + print.matrix(Cf, quote = FALSE, right = TRUE, ...) if(signif.stars) cat("---\nSignif. codes: ",attr(Signif,"legend"),"\n") invisible(x) } +print.anova <- function(x, digits = max(.Options$digits - 2, 3), + signif.stars= .Options$show.signif.stars, ...) +{ + if (!is.null(heading <- attr(x, "heading"))) + cat(heading, sep = "\n") + nc <- (d <- dim(x))[2] + if(is.null(cn <- colnames(x))) stop("anova object must have colnames(.)!") + has.P <- substr(cn[nc],1,3) == "Pr(" # P-value as last column + zap.i <- 1:(if(has.P) nc-1 else nc) + tst.i <- if(length(i <- which(substr(cn,2,7) == " Value"))) { + zap.i <- zap.i[zap.i != i] + i + } else integer(0) + if(length(i <- which(substr(cn,1,2) == "Df"))) + zap.i <- zap.i[zap.i != i] + print.coefmat(x, digits=digits, signif.stars=signif.stars, has.Pvalue=has.P, + cs.ind = NULL, zap.ind = zap.i, tst.ind= tst.i, + na.print = "", # not yet in print.matrix: print.gap = 2, + ...) + invisible(x) +} + + diff --git a/src/main/format.c b/src/main/format.c index 471bf5cbc70..2a5b7fc2a16 100644 --- a/src/main/format.c +++ b/src/main/format.c @@ -19,8 +19,10 @@ * * Object Formatting * - * See ./printutils.c for general remarks on Printing and the Encode.. utils. * See ./paste.c for do_paste() , do_format() and do_formatinfo() + * See ./printutils.c for general remarks on Printing and the Encode.. utils. + * See ./print.c for do_printdefault, do_printmatrix, etc. + * * These formatFOO() functions determine the proper width, digits, etc. */ @@ -152,7 +154,7 @@ static void scientific(double *x, int *sgn, int *kpower, int *nsig) * kpower = Exponent of 10; * nsig = min(print_digits, #{significant digits of alpha} * - * where |x| = alpha * 10^kpower and 1 <= alpha < 10 + * where |x| = alpha * 10^kpower and 1 <= alpha < 10 */ register double alpha; register double r; @@ -233,7 +235,7 @@ void formatReal(double *x, int l, int *m, int *n, int *e) left = kpower + 1; sleft = sgn + ((left <= 0) ? 1 : left); /* >= 1 */ right = nsig - left; /* #{digits} right of '.' ( > 0 often)*/ - if (sgn) neg = 1; /* if any < 0, need extra space for sign */ + if (sgn) neg = 1; /* if any < 0, need extra space for sign */ /* Infinite precision "F" Format : */ if (right > rt) rt = right; /* max digits to right of . */ @@ -243,7 +245,7 @@ void formatReal(double *x, int l, int *m, int *n, int *e) if (nsig > mxns) mxns = nsig; /* max sig digits */ } } - /* F Format (NEW): use "F" format + /* F Format (NEW): use "F" format * WHENEVER we use not more space than 'E' * and still satisfy 'print_digits' * @@ -253,8 +255,8 @@ void formatReal(double *x, int l, int *m, int *n, int *e) * If the additional exponent digit is required *e is set to 2 */ - /*-- These 'mxsl' & 'rt' are used in F Format - * AND in the ____ if(.) "F" else "E" ___ below: */ + /*-- These 'mxsl' & 'rt' are used in F Format + * AND in the ____ if(.) "F" else "E" ___ below: */ if (mxl < 0) mxsl = 1 + neg; /* old?? if (mxl != mnl && mxl + rt > MAXDIG) rt = MAXDIG - mxl; */ if (rt < 0) rt = 0; @@ -265,7 +267,7 @@ void formatReal(double *x, int l, int *m, int *n, int *e) if (mxl > 100 || mnl < -99) *e = 2;/* 3 digit exponent */ else *e = 1; *n = mxns - 1; - *m = neg + (*n > 0) + *n + 4 + *e; /* width m for E format */ + *m = neg + (*n > 0) + *n + 4 + *e; /* width m for E format */ if (mF <= *m) { /* IFF it needs less space : "F" (Fixpoint) format */ *e = 0; @@ -308,7 +310,7 @@ void formatComplex(complex *x, int l, int *mr, int *nr, int *er, #endif neg = 0; - rt = mxl = mxsl = mxns = INT_MIN; + rt = mxl = mxsl = mxns = INT_MIN; i_rt= i_mxl= i_mxsl= i_mxns= INT_MIN; i_mnl = mnl = INT_MAX; @@ -354,7 +356,7 @@ void formatComplex(complex *x, int l, int *mr, int *nr, int *er, if (ISNAN(x[i].i)) inanflag = 1; else iposinf = 1; } - else + else #endif { scientific(&(x[i].i), &sgn, &kpower, &nsig); diff --git a/src/main/printutils.c b/src/main/printutils.c index 6f8356f9a01..4d69e984524 100644 --- a/src/main/printutils.c +++ b/src/main/printutils.c @@ -28,10 +28,12 @@ * ``standard error'' and is useful for error messages and warnings. * It is not redirected by sink(). * - *== see ./format.c for the format_FOO_ functions which provide - * ~~~~~~~~~~ the length, width, etc.. that are used here. + * See ./format.c for the format_FOO_ functions which provide + * ~~~~~~~~~~ the length, width, etc.. that are used here. + * See ./print.c for do_printdefault, do_printmatrix, etc. * - * Following UTILITIES: + * + * Here, the following UTILITIES are provided: * * The utilities EncodeLogical, EncodeFactor, EncodeInteger, EncodeReal * and EncodeString can be used to convert R objects to a form suitable