>>>>> "BDR" == Prof Brian D Ripley
<ripley@stats.ox.ac.uk> writes:
....
BDR> BTW, ... I missed the masked() and conflicts()
BDR> functions of S. Yes, I know I could write one easily, and will
BDR> unless I missed anything in R that does the job.
I've missed them as well.
However, I propose to implement (additionally)
a more DRASTIC CHANGE :
attach() and
library() --- should check about conflicts and
warn on all of them [at least about masking of package:base].
~~~~~~~~~~~~~~~~~~~~
This most probably will suddenly give quite a few warnings for some
contributed packages.
But I think these warnings are important and should help package writers
from accidental overloading.
---------
In S-plus, we've been using a patched version of attach.default
for several years now, and our users have been very glad about it:
attach.default <- function(what = NULL, pos = 2,
name = if(is.character(what)) what else
if( is.name(TTT <- substitute(what)))
as.character(TTT) else "",
where, ... )
{
##----- Splus 3.2 + John Wallace's + Martin Maechler's patches AT END
---
##-#- Date: Tue, 28 Mar 1995 11:56:57 -0800 (PST)
##-#- From: John Wallace <jrw@fish.washington.edu>
##-#- Subject: Update to attach.default
##-#- To: S-news <s-news@utstat.toronto.edu>
old <- search()
if(!missing(where)) {
if(missing(pos))
pos <- where
else stop("canot give both `pos' and `where' in the argument
list")
}
value <- .Internal(attach.default(what, pos, name), "S_database")
if(exists("help.running", mode = "function") &&
help.running()) {
directory.dbs <- function(search.list)
{
## get names of directories on the search list
n <- length(search.list)
is.directory <- logical(n)
for(i in 1:n)
is.directory[i] <- database.type(i) = "directory"
return(search.list[is.directory])
}
dir.old <- directory.dbs(old)
dir.new <- directory.dbs(search())
if(length(dir.old) != length(dir.new) || any(dir.old != dir.new))
help.search()
}
##-- This is John Wallace's patch + Martin Maechler's improvements
##-- which warns you if ...
if(pos != 1) {
for(i in 1:(pos - 1)) {
dont.mind <- c("last.dump", "last.warning",
".Last.value", ".Random.seed")
objects.same <- match(objects(i), objects(pos), nomatch = 0)
if(any(objects.same))
if(length(same <- f.without( objects(pos)[objects.same], dont.mind)))
cat("\n\tObject(s) of the SAME name are in pos.", i,
":\n\n\t",
same, "\n\n")
}
}
invisible(value)
}
f.without <- function(set, elements)
{
## Purpose: return set WITHOUT elements { s1, s2,...} \ { e1, e2, ..}
## -------------------------------------------------------------------------
## Arguments: set = { s1, s2, ... }; elements = { e1, e2, .. }
## -------------------------------------------------------------------------
## Author: Martin Maechler, Date: 17 Feb 94, 16:45
set[ - match(elements, set, nomatch = length(set) + 1)]
}
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To:
r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._