Re: [Rd] Bug in plnorm (PR#11867)
Thank you, Goran, that's indeed a buglet (also for lower.tail=TRUE) that will be fixed shortly. Regards, Martin > "GB" == G¾¡Â¡öran Brostr¾¡Â¡öm <[EMAIL PROTECTED]> > on Mon, 30 Jun 2008 00:45:21 +0200 (CEST) writes: GB> Full_Name: Göran Broström Version: 2.7.1 OS: Ubuntu 8.04 GB> (x86_64) Submission from: (NULL) (85.11.40.53) >> plnorm(0, lower.tail = FALSE, log.p = TRUE) GB> returns 1 instead of the correct 0 (zero). GB> The same seems to hold for >> plnorm(x, lower.tail = FALSE, log.p = TRUE) GB> for any negative value of x. GB> __ GB> R-devel@r-project.org mailing list GB> https://stat.ethz.ch/mailman/listinfo/r-devel __ R-devel@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-devel
Re: [Rd] AIX 5.3 --enable-R-shlib make error with R-2.7.1
Hi Perhaps I think that there is a possibility that success of former link was my hallucination... Please try this patch if you like. http://prs.ism.ac.jp/~nakama/AIX/aix_R-2.7.1_Rshlib_include_configure.patch Some problems are left in gcc, but think that the make is possible. If you want to eat iconv, please cook the following. http://prs.ism.ac.jp/~nakama/AIX/AIX_iconv_CookBook.txt However, a problem occurred in checkFF and nls when I built it in gcc. Because nls and checkFF do not have any problem with a commercial compiler, I think that there is a problem in recent gcc side 2008/7/1 <[EMAIL PROTECTED]>: > Using AIX 5.3 and gcc-4.2.1 for building R-2.7.1 with the following > configure flags > > OBJECT_MODE=64 > CC="gcc -maix64" > CXX="g++ -maix64" > F77="gfortran -maix64" > FC="gfortran -maix64" > CFLAGS="-g -O3" > CXXFLAGS="-g -O3" > FFLAGS="-g -O3" > FCFLAGS="-g -O3" > LDFLAGS="-L/$HOME/usr/local/lib/ppc64 -L/$HOME/usr/local/lib" > CPPFLAGS="-I/$HOME/usr/include" > ./configure --disable-nls --without-iconv --prefix=$HOME/usr/local > --enable-R-shlib > > After a successful configuration, the make stops with the following > error on this system > > make[3]: Entering directory > `/home/apps/crm_cm/n731661x/src/R-2.7.1/src/main' > gcc -maix64 -std=gnu99 -I../../src/extra/zlib -I../../src/extra/bzip2 > -I../../src/extra/pcre -I. -I../../src/include -I../../src/include > -I//users/apps/crm_cm/n731661x/usr/include -DHAVE_CONFIG_H > -mminimal-toc -g -O3 -c Rmain.c -o Rmain.o > gcc -maix64 -std=gnu99 -Wl,-brtl -Wl,-bexpall -Wl,-bpT:0x1 > -Wl,-bpD:0x11000 -lc > -L//users/apps/crm_cm/n731661x/usr/local/lib/ppc64 > -L//users/apps/crm_cm/n731661x/usr/local/lib -o R.bin Rmain.o > -L../../lib -lR > ld: 0711-317 ERROR: Undefined symbol: R_running_as_main_program > ld: 0711-345 Use the -bloadmap or -bnoquiet option to obtain more > information. > collect2: ld returned 8 exit status > make[3]: *** [R.bin] Error 1 > make[3]: Leaving directory > `/home/apps/crm_cm/n731661x/src/R-2.7.1/src/main' > make[2]: *** [R] Error 2 > make[2]: Leaving directory > `/home/apps/crm_cm/n731661x/src/R-2.7.1/src/main' > make[1]: *** [R] Error 1 > make[1]: Leaving directory `/home/apps/crm_cm/n731661x/src/R-2.7.1/src' > make: *** [R] Error 1 > > On the other hand, no problems on this system with the above > configuration building R<=2.6.2. Can also successfully build R-2.7.1 > here without --enable-R-shlib. > > Will be glad to experiment or provide more details if needed anytime. > > Thanks, > Jagat > > > -- > Jagat K. Sheth > Prepayment Modeling and Economics > Wells Fargo Home Mortgage > 7911 Forsyth Boulevard > Suite 500, M5001-061 > Clayton, MO 63105 > > Tel: (314)-726-4496 > Fax: (314)-726-4483 > [EMAIL PROTECTED] > > __ > R-devel@r-project.org mailing list > https://stat.ethz.ch/mailman/listinfo/r-devel > > > -- EI-JI Nakama <[EMAIL PROTECTED]> "\u4e2d\u9593\u6804\u6cbb" <[EMAIL PROTECTED]> __ R-devel@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-devel
[Rd] Autoconf / Windows package building problem for device package
Dear list, Tadashi Kadowaki has developed a pdf device package that allows to add hyperlinks and popups to (currently) text, mtext and rect calls. The package passes R CMD check (minor warnings) and compiles on MacOS X and GNU/Linux, but we do not succeed in building the package for Windows. The current version of the package can be checked out as svn checkout svn://svn.r-forge.r-project.org/svnroot/pdf2/trunk Please find the 00install.out below. Could anyone tell why config.h is not found? My practical experience with the GNU build tools is very limited but I would have hoped config.h.in would be processed into config.h. Any pointer or hint will be appreciated. Many thanks in advance, Tobias P.S. 00install.out (using R 2.7.1 and a current Rtools28.exe): installing R.css in C:/DOCUME~1/tverbeke/WORKSP~2/pdf2/TRUNK~1.RCH -- Making package trunk ** WARNING: this package has a configure script It probably needs manual configuration ** adding build stamp to DESCRIPTION installing NAMESPACE file and metadata making DLL ... gcc -std=gnu99 -Ic:/R/R-2.7.0/include -Iinclude -DHAVE_CONFIG_H -O3 -Wall -c devPS.c -o devPS.o devPS.c:26:20: error: config.h: No such file or directory In file included from devPS.c:29: include/Defn.h:1022: error: expected '=', ',', ';', 'asm' or '__attribute__' before 'Rf_onsigusr1' include/Defn.h:1023: error: expected '=', ',', ';', 'asm' or '__attribute__' before 'Rf_onsigusr2' In file included from c:\rtools\mingw\bin\../lib/gcc/mingw32/4.2.1-sjlj/../../../../include/wchar.h:352, from include/Defn.h:1126, from devPS.c:29: c:\rtools\mingw\bin\../lib/gcc/mingw32/4.2.1-sjlj/../../../../include/stdint.h:66: error: conflicting types for 'intptr_t' include/Defn.h:204: error: previous declaration of 'intptr_t' was here c:\rtools\mingw\bin\../lib/gcc/mingw32/4.2.1-sjlj/../../../../include/stdint.h:75: error: conflicting types for 'uintptr_t' include/Defn.h:207: error: previous declaration of 'uintptr_t' was here devPS.c: In function 'pathcmp': devPS.c:449: error: 'FILESEP' undeclared (first use in this function) devPS.c:449: error: (Each undeclared identifier is reported only once devPS.c:449: error: for each function it appears in.) devPS.c: In function 'LoadEncoding': devPS.c:515: error: 'FILESEP' undeclared (first use in this function) devPS.c: In function 'PostScriptLoadFontMetrics': devPS.c:560: error: 'FILESEP' undeclared (first use in this function) devPS.c: In function 'PostScriptMetricInfo': devPS.c:862: warning: implicit declaration of function 'Riconv_open' devPS.c:862: warning: assignment makes pointer from integer without a cast devPS.c:872: warning: implicit declaration of function 'Riconv' devPS.c:874: warning: implicit declaration of function 'Riconv_close' devPS.c: In function 'mbcsToSbcs': devPS.c:4020: warning: assignment makes pointer from integer without a cast devPS.c:4029: error: 'EILSEQ' undeclared (first use in this function) devPS.c: In function 'PDF_NewPage': devPS.c:6406: warning: unused variable 'i' devPS.c: In function 'PDF_StrSize': devPS.c:7129: warning: unused variable 'face' devPS.c:7128: warning: unused variable 'pd' devPS.c: In function 'PDFAnnotBox': devPS.c:7469: warning: passing argument 5 of 'Rf_GConvert' from incompatible pointer type devPS.c:7470: warning: passing argument 5 of 'Rf_GConvert' from incompatible pointer type make[3]: *** [devPS.o] Error 1 make[2]: *** [srcDynlib] Error 2 make[1]: *** [all] Error 2 make: *** [pkg-trunk] Error 2 *** Installation of trunk failed *** Removing 'C:/DOCUME~1/tverbeke/WORKSP~2/pdf2/TRUNK~1.RCH/trunk' __ R-devel@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-devel
Re: [Rd] Autoconf / Windows package building problem for device package
Tobias, that package uses headers internal to R (a really bad thing to do). Although it attempts to supply them (very dangerous again since they are R-version-dependent) they rely on configured R sources which are not present on Windows. I don't have a Windows machine handy, but I dimly remember that you can find manually created config.h for Windows in fixed-h directory under gnuwin32. It's a hack (and I'm not sure if it helps), though, so I'd strongly suggest Tadashi to fix his package to use official API as was suggested a few times already. Cheers, Simon On Jul 1, 2008, at 9:57 AM, Tobias Verbeke wrote: Dear list, Tadashi Kadowaki has developed a pdf device package that allows to add hyperlinks and popups to (currently) text, mtext and rect calls. The package passes R CMD check (minor warnings) and compiles on MacOS X and GNU/Linux, but we do not succeed in building the package for Windows. The current version of the package can be checked out as svn checkout svn://svn.r-forge.r-project.org/svnroot/pdf2/trunk Please find the 00install.out below. Could anyone tell why config.h is not found? My practical experience with the GNU build tools is very limited but I would have hoped config.h.in would be processed into config.h. Any pointer or hint will be appreciated. Many thanks in advance, Tobias P.S. 00install.out (using R 2.7.1 and a current Rtools28.exe): installing R.css in C:/DOCUME~1/tverbeke/WORKSP~2/pdf2/TRUNK~1.RCH -- Making package trunk ** WARNING: this package has a configure script It probably needs manual configuration ** adding build stamp to DESCRIPTION installing NAMESPACE file and metadata making DLL ... gcc -std=gnu99 -Ic:/R/R-2.7.0/include -Iinclude -DHAVE_CONFIG_H -O3 -Wall -c devPS.c -o devPS.o devPS.c:26:20: error: config.h: No such file or directory In file included from devPS.c:29: include/Defn.h:1022: error: expected '=', ',', ';', 'asm' or '__attribute__' before 'Rf_onsigusr1' include/Defn.h:1023: error: expected '=', ',', ';', 'asm' or '__attribute__' before 'Rf_onsigusr2' In file included from c:\rtools\mingw\bin\../lib/gcc/mingw32/4.2.1- sjlj/../../../../include/wchar.h:352, from include/Defn.h:1126, from devPS.c:29: c:\rtools\mingw\bin\../lib/gcc/mingw32/4.2.1-sjlj/../../../../ include/stdint.h:66: error: conflicting types for 'intptr_t' include/Defn.h:204: error: previous declaration of 'intptr_t' was here c:\rtools\mingw\bin\../lib/gcc/mingw32/4.2.1-sjlj/../../../../ include/stdint.h:75: error: conflicting types for 'uintptr_t' include/Defn.h:207: error: previous declaration of 'uintptr_t' was here devPS.c: In function 'pathcmp': devPS.c:449: error: 'FILESEP' undeclared (first use in this function) devPS.c:449: error: (Each undeclared identifier is reported only once devPS.c:449: error: for each function it appears in.) devPS.c: In function 'LoadEncoding': devPS.c:515: error: 'FILESEP' undeclared (first use in this function) devPS.c: In function 'PostScriptLoadFontMetrics': devPS.c:560: error: 'FILESEP' undeclared (first use in this function) devPS.c: In function 'PostScriptMetricInfo': devPS.c:862: warning: implicit declaration of function 'Riconv_open' devPS.c:862: warning: assignment makes pointer from integer without a cast devPS.c:872: warning: implicit declaration of function 'Riconv' devPS.c:874: warning: implicit declaration of function 'Riconv_close' devPS.c: In function 'mbcsToSbcs': devPS.c:4020: warning: assignment makes pointer from integer without a cast devPS.c:4029: error: 'EILSEQ' undeclared (first use in this function) devPS.c: In function 'PDF_NewPage': devPS.c:6406: warning: unused variable 'i' devPS.c: In function 'PDF_StrSize': devPS.c:7129: warning: unused variable 'face' devPS.c:7128: warning: unused variable 'pd' devPS.c: In function 'PDFAnnotBox': devPS.c:7469: warning: passing argument 5 of 'Rf_GConvert' from incompatible pointer type devPS.c:7470: warning: passing argument 5 of 'Rf_GConvert' from incompatible pointer type make[3]: *** [devPS.o] Error 1 make[2]: *** [srcDynlib] Error 2 make[1]: *** [all] Error 2 make: *** [pkg-trunk] Error 2 *** Installation of trunk failed *** Removing 'C:/DOCUME~1/tverbeke/WORKSP~2/pdf2/TRUNK~1.RCH/trunk' __ R-devel@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-devel __ R-devel@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-devel
[Rd] [.data.frame speedup
Below is a version of [.data.frame that is faster
for subscripting rows of large data frames; it avoids calling
duplicated(rows)
if there is no need to check for duplicate row names, when:
i is logical
attr(x, "dup.row.names") is not NULL (S+ compatibility)
i is numeric and negative
i is strictly increasing
"[.data.frame" <-
function (x, i, j,
drop = if (missing(i)) TRUE else length(cols) == 1)
{
# This version of [.data.frame avoid wasting time enforcing unique
# row names.
mdrop <- missing(drop)
Narg <- nargs() - (!mdrop)
if (Narg < 3) {
if (!mdrop)
warning("drop argument will be ignored")
if (missing(i))
return(x)
if (is.matrix(i))
return(as.matrix(x)[i])
y <- NextMethod("[")
cols <- names(y)
if (!is.null(cols) && any(is.na(cols)))
stop("undefined columns selected")
if (any(duplicated(cols)))
names(y) <- make.unique(cols)
return(structure(y, class = oldClass(x),
row.names = .row_names_info(x, 0L)))
}
if (missing(i)) {
if (missing(j) && drop && length(x) == 1L)
return(.subset2(x, 1L))
y <- if (missing(j))
x
else .subset(x, j)
if (drop && length(y) == 1L)
return(.subset2(y, 1L))
cols <- names(y)
if (any(is.na(cols)))
stop("undefined columns selected")
if (any(duplicated(cols)))
names(y) <- make.unique(cols)
nrow <- .row_names_info(x, 2L)
if (drop && !mdrop && nrow == 1L)
return(structure(y, class = NULL, row.names = NULL))
else return(structure(y, class = oldClass(x),
row.names = .row_names_info(x, 0L)))
}
xx <- x
cols <- names(xx)
x <- vector("list", length(x))
x <- .Call("R_copyDFattr", xx, x, PACKAGE = "base")
oldClass(x) <- attr(x, "row.names") <- NULL
# Do not want to check for duplicates if don't need to
noDuplicateRowNames <- (is.logical(i) ||
(!is.null(attr(x, "dup.row.names"))) ||
(is.numeric(i) && min(i, 0, na.rm=TRUE) < 0) ||
(!notSorted(i, strict = TRUE)))
if (!missing(j)) {
x <- x[j]
cols <- names(x)
if (drop && length(x) == 1L) {
if (is.character(i)) {
rows <- attr(xx, "row.names")
i <- pmatch(i, rows, duplicates.ok = TRUE)
}
xj <- .subset2(.subset(xx, j), 1L)
return(if (length(dim(xj)) != 2L) xj[i] else xj[i,
, drop = FALSE])
}
if (any(is.na(cols)))
stop("undefined columns selected")
nxx <- structure(seq_along(xx), names = names(xx))
sxx <- match(nxx[j], seq_along(xx))
}
else sxx <- seq_along(x)
rows <- NULL
if (is.character(i)) {
rows <- attr(xx, "row.names")
i <- pmatch(i, rows, duplicates.ok = TRUE)
}
for (j in seq_along(x)) {
xj <- xx[[sxx[j]]]
x[[j]] <- if (length(dim(xj)) != 2L)
xj[i]
else xj[i, , drop = FALSE]
}
if (drop) {
n <- length(x)
if (n == 1L)
return(x[[1L]])
if (n > 1L) {
xj <- x[[1L]]
nrow <- if (length(dim(xj)) == 2L)
dim(xj)[1L]
else length(xj)
drop <- !mdrop && nrow == 1L
}
else drop <- FALSE
}
if (!drop) {
if (is.null(rows))
rows <- attr(xx, "row.names")
rows <- rows[i]
if ((ina <- any(is.na(rows))) | (dup <- !noDuplicateRowNames &&
any(duplicated(rows {
if (ina)
rows[is.na(rows)] <- "NA"
if (dup)
rows <- make.unique(as.character(rows))
}
if (any(duplicated(nm <- names(x
names(x) <- make.unique(nm)
if (is.null(rows))
rows <- attr(xx, "row.names")[i]
attr(x, "row.names") <- rows
oldClass(x) <- oldClass(xx)
}
x
}
[[alternative HTML version deleted]]
__
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Re: [Rd] [.data.frame speedup
There is a bug in the standard version of [.data.frame;
it mixes up handling duplicates and NAs when subscripting rows.
x <- data.frame(x=1:3, y=2:4, row.names=c("a","b","NA"))
y <- x[c(2:3, NA),]
y
It creates a data frame with duplicate rows, but won't print.
In the previous message I included a version of [.data.frame;
it fails for the same example, for a different reason. Here
is a fix.
"subscript.data.frame" <-
function (x, i, j,
drop = if (missing(i)) TRUE else length(cols) == 1)
{
# This version of [.data.frame avoid wasting time enforcing unique
# row names if possible.
mdrop <- missing(drop)
Narg <- nargs() - (!mdrop)
if (Narg < 3) {
if (!mdrop)
warning("drop argument will be ignored")
if (missing(i))
return(x)
if (is.matrix(i))
return(as.matrix(x)[i])
y <- NextMethod("[")
cols <- names(y)
if (!is.null(cols) && any(is.na(cols)))
stop("undefined columns selected")
if (any(duplicated(cols)))
names(y) <- make.unique(cols)
return(structure(y, class = oldClass(x),
row.names = .row_names_info(x, 0L)))
}
if (missing(i)) {
if (missing(j) && drop && length(x) == 1L)
return(.subset2(x, 1L))
y <- if (missing(j))
x
else .subset(x, j)
if (drop && length(y) == 1L)
return(.subset2(y, 1L))
cols <- names(y)
if (any(is.na(cols)))
stop("undefined columns selected")
if (any(duplicated(cols)))
names(y) <- make.unique(cols)
nrow <- .row_names_info(x, 2L)
if (drop && !mdrop && nrow == 1L)
return(structure(y, class = NULL, row.names = NULL))
else return(structure(y, class = oldClass(x),
row.names = .row_names_info(x, 0L)))
}
xx <- x
cols <- names(xx)
x <- vector("list", length(x))
x <- .Call("R_copyDFattr", xx, x, PACKAGE = "base")
oldClass(x) <- attr(x, "row.names") <- NULL
# Do not want to check for duplicates if don't need to
noDuplicateRowNames <- (is.logical(i) ||
(!is.null(attr(x, "dup.row.names"))) ||
(is.numeric(i) && min(i, 0, na.rm=TRUE) < 0) ||
(!anyMissing(i) && !notSorted(i, strict = TRUE)))
if (!missing(j)) {
x <- x[j]
cols <- names(x)
if (drop && length(x) == 1L) {
if (is.character(i)) {
rows <- attr(xx, "row.names")
i <- pmatch(i, rows, duplicates.ok = TRUE)
}
xj <- .subset2(.subset(xx, j), 1L)
return(if (length(dim(xj)) != 2L) xj[i] else xj[i,
, drop = FALSE])
}
if (any(is.na(cols)))
stop("undefined columns selected")
nxx <- structure(seq_along(xx), names = names(xx))
sxx <- match(nxx[j], seq_along(xx))
}
else sxx <- seq_along(x)
rows <- NULL
if (is.character(i)) {
rows <- attr(xx, "row.names")
i <- pmatch(i, rows, duplicates.ok = TRUE)
}
for (j in seq_along(x)) {
xj <- xx[[sxx[j]]]
x[[j]] <- if (length(dim(xj)) != 2L)
xj[i]
else xj[i, , drop = FALSE]
}
if (drop) {
n <- length(x)
if (n == 1L)
return(x[[1L]])
if (n > 1L) {
xj <- x[[1L]]
nrow <- if (length(dim(xj)) == 2L)
dim(xj)[1L]
else length(xj)
drop <- !mdrop && nrow == 1L
}
else drop <- FALSE
}
if (!drop) {
if (is.null(rows))
rows <- attr(xx, "row.names")
rows <- rows[i]
if(any(is.na(rows)))
rows[is.na(rows)] <- "NA"
if(!noDuplicateRowNames && any(duplicated(rows)))
rows <- make.unique(as.character(rows))
if (any(duplicated(nm <- names(x
names(x) <- make.unique(nm)
if (is.null(rows))
rows <- attr(xx, "row.names")[i]
attr(x, "row.names") <- rows
oldClass(x) <- oldClass(xx)
}
x
}
# That requires anyMissing from the splus2R package,
# plus notSorted (or a version of is.unsorted with argument 'strict' added).
notSorted <- function(x, decreasing = FALSE, strict = FALSE, na.rm = FALSE){
# return TRUE if x is not sorted
# If decreasing=FALSE, check for sort in increasing order
# If strict=TRUE, ties correspond to not being sorted
n <- length(x)
if(length(n) < 2)
return(FALSE)
if(!is.atomic(x) || (!na.rm && any(is.na(x
return(NA)
if(na.rm && any(ii <- is.na(x)))
x <- x[!ii]
if(decreasing){
ifelse1(strict,
any(x[-1] >= x[-n]),
any(x[-1] > x[-n]))
} else { # check for sort in increasing order
ifelse1(strict,
any(x[-1] <= x[-n]),
any(x[-1] < x[-n]))
}
}
On Tue, Jul 1, 2008 at 11:20 AM, Tim Hesterberg <[EMAIL PROTECTED]>
wrote:
> Below is a version of [.data.frame that is faster
> for subscripting rows of large data frames; it avoids calling
> duplicated(rows)
> if there is no need to check for duplicate row names, when:
> i is logical
> attr(x, "dup.row.names") is not NULL (S+ compatibility)
> i is numeric and negative
> i is strictly increasing
>
[[alternat
Re: [Rd] get ...
On 30/06/2008 10:56 AM, Luke Tierney wrote:
On Sat, 28 Jun 2008, Peter Dalgaard wrote:
Gabor Grothendieck wrote:
Suppose we do this:
f <- function(...) environment()
e <- f(a = 1, b = 2)
ls(e, all = TRUE)
[1] "..."
e$...
<...>
class(e$...)
[1] "..."
Is there any way of getting a and b given e without
modifying f?
evalq(list(...),e)
$a
[1] 1
$b
[1] 2
I'm wondering though whether we should allow the internal DOTSXP value
of "..." to escape to the user level. Might be more appropriate for
get(e,"..."), e$... (and as.list.environment and maybe a few other
things) to give the "Error: '...' used in an incorrect context" error
if the value is a DOTSXP.
On the other hand, what Gabor sees in e is what he would see inside f:
f <- function(...) { ls(all=T) }
f(a=1, b=2)
[1] "..."
I don't think we should distinguish between user level in .GlobalEnv and
what a user sees inside a function he writes. Stopping a user from
seeing ... inside a function would break all sorts of things.
Duncan Murdoch
__
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Re: [Rd] [.data.frame speedup
Here is a revised version of notSorted; change argument order (to be more
like
is.unsorted) and fix blunder.
notSorted <- function(x, na.rm = FALSE, decreasing = FALSE, strict = FALSE){
# return TRUE if x is not sorted
# If decreasing=FALSE, check for sort in increasing order
# If strict=TRUE, ties correspond to not being sorted
n <- length(x)
if(n < 2)
return(FALSE)
if(!is.atomic(x) || (!na.rm && any(is.na(x
return(NA)
if(na.rm && any(ii <- is.na(x))){
x <- x[!ii]
n <- length(x)
}
if(decreasing){
ifelse1(strict,
any(x[-1] >= x[-n]),
any(x[-1] > x[-n]))
} else { # check for sort in increasing order
ifelse1(strict,
any(x[-1] <= x[-n]),
any(x[-1] < x[-n]))
}
}
On Tue, Jul 1, 2008 at 3:23 PM, Tim Hesterberg <[EMAIL PROTECTED]>
wrote:
> There is a bug in the standard version of [.data.frame;
> it mixes up handling duplicates and NAs when subscripting rows.
> x <- data.frame(x=1:3, y=2:4, row.names=c("a","b","NA"))
> y <- x[c(2:3, NA),]
> y
> It creates a data frame with duplicate rows, but won't print.
>
> In the previous message I included a version of [.data.frame;
> it fails for the same example, for a different reason. Here
> is a fix.
>
>
> "subscript.data.frame" <-
> function (x, i, j,
> drop = if (missing(i)) TRUE else length(cols) == 1)
> {
> # This version of [.data.frame avoid wasting time enforcing unique
> # row names if possible.
>
> mdrop <- missing(drop)
> Narg <- nargs() - (!mdrop)
> if (Narg < 3) {
> if (!mdrop)
> warning("drop argument will be ignored")
> if (missing(i))
> return(x)
> if (is.matrix(i))
> return(as.matrix(x)[i])
> y <- NextMethod("[")
> cols <- names(y)
> if (!is.null(cols) && any(is.na(cols)))
> stop("undefined columns selected")
> if (any(duplicated(cols)))
> names(y) <- make.unique(cols)
> return(structure(y, class = oldClass(x),
> row.names = .row_names_info(x, 0L)))
> }
> if (missing(i)) {
> if (missing(j) && drop && length(x) == 1L)
> return(.subset2(x, 1L))
> y <- if (missing(j))
> x
> else .subset(x, j)
> if (drop && length(y) == 1L)
> return(.subset2(y, 1L))
> cols <- names(y)
> if (any(is.na(cols)))
> stop("undefined columns selected")
> if (any(duplicated(cols)))
> names(y) <- make.unique(cols)
> nrow <- .row_names_info(x, 2L)
> if (drop && !mdrop && nrow == 1L)
> return(structure(y, class = NULL, row.names = NULL))
> else return(structure(y, class = oldClass(x),
> row.names = .row_names_info(x, 0L)))
> }
> xx <- x
> cols <- names(xx)
> x <- vector("list", length(x))
> x <- .Call("R_copyDFattr", xx, x, PACKAGE = "base")
> oldClass(x) <- attr(x, "row.names") <- NULL
> # Do not want to check for duplicates if don't need to
> noDuplicateRowNames <- (is.logical(i) ||
> (!is.null(attr(x, "dup.row.names"))) ||
> (is.numeric(i) && min(i, 0, na.rm=TRUE) < 0) ||
> (!anyMissing(i) && !notSorted(i, strict = TRUE)))
>
> if (!missing(j)) {
> x <- x[j]
> cols <- names(x)
> if (drop && length(x) == 1L) {
> if (is.character(i)) {
> rows <- attr(xx, "row.names")
> i <- pmatch(i, rows, duplicates.ok = TRUE)
> }
> xj <- .subset2(.subset(xx, j), 1L)
> return(if (length(dim(xj)) != 2L) xj[i] else xj[i,
> , drop = FALSE])
> }
> if (any(is.na(cols)))
> stop("undefined columns selected")
> nxx <- structure(seq_along(xx), names = names(xx))
> sxx <- match(nxx[j], seq_along(xx))
> }
> else sxx <- seq_along(x)
> rows <- NULL
> if (is.character(i)) {
> rows <- attr(xx, "row.names")
> i <- pmatch(i, rows, duplicates.ok = TRUE)
> }
> for (j in seq_along(x)) {
> xj <- xx[[sxx[j]]]
> x[[j]] <- if (length(dim(xj)) != 2L)
> xj[i]
> else xj[i, , drop = FALSE]
> }
> if (drop) {
> n <- length(x)
> if (n == 1L)
> return(x[[1L]])
> if (n > 1L) {
> xj <- x[[1L]]
> nrow <- if (length(dim(xj)) == 2L)
> dim(xj)[1L]
> else length(xj)
> drop <- !mdrop && nrow == 1L
> }
> else drop <- FALSE
> }
> if (!drop) {
> if (is.null(rows))
> rows <- attr(xx, "row.names")
> rows <- rows[i]
> if(any(is.na(rows)))
> rows[is.na(rows)] <- "NA"
> if(!noDuplicateRowNames && any(duplicated(rows)))
> rows <- make.unique(as.character(rows))
> if (any(duplicated(nm <- names(x
> names(x) <- make.unique(nm)
> if (is.null(rows))
> rows <- attr(xx, "row.names")[i]
> attr(x, "row.names") <- rows
> oldClass(x) <- oldClass(xx)
> }
> x
> }
>
> # That requires anyMissing from the splus2R package,
> # plus notSorted (or a version of is.unsorted with argument 'stri
