R-beta: Source code: grep(.) and objects(..., pattern):

[Martin Maechler]

If you have many objects, in the users's GlobalEnv or in the system
SystemEnv,
you would like to be able to do something like	

	ls("lm*.t")
to get only the objects  starting with 'lm' and ending in '.t'.

The following code provides this and more:  
   "grep(.)" which should be  S-compatible and improved
   "objects(.)"  with new 'pattern' argument  (S-compatible).

It has been working for me, for a while now.
Only drawback:  It's port to  Windows or Macintosh
	requires a port of the  grep(..)  function which currently relies
	on Unix's availability of 'egrep'.

###>>> Please let me know of  bugs/ nice examples / suggestions for improvement!
###>  
###>  Martin Maechler <maechler at stat.math.ethz.ch>		 <><
###>  Seminar fuer Statistik, SOL G1
###>  ETH (Federal Inst. Technology)	8092 Zurich	 SWITZERLAND
###>  phone: x-41-1-632-3408		fax: ...-1086
###>  http://www.stat.math.ethz.ch/~maechler/

## The 'grep' function is modelled after S's one.

grep <- function(pattern, text)
{
  ##  Needs Unix's 'egrep' command via  system(.).
  if(length(pattern) > 1)
    pattern <- paste("(", pattern, ")", sep = "", collapse = "|")
  cmd <- paste("egrep -n -e \"", pattern, "\" |sed 's/:.*//'", sep = "")
  cmd <- paste("echo '", paste(text, collapse="\n"), "' | ", cmd, sep = "")
  as.numeric(system(cmd, intern = TRUE))
}

objects <- function (name, pos = -1, envir = NULL, all.files = FALSE,
		     pattern = NULL)
{
  ## R 0.16.1 and 0.50-2 --- + 'pattern' & numeric name by Martin Maechler
  if (!missing(name)) {
    pos <- if(is.numeric(name)) { #-- be compatible with S
      as.integer(name)
    } else {
      name <- substitute(name)
      if (!is.character(name)) name <- deparse(name)
      match(name, search())
    }
    if (is.na(pos)) stop("invalid name")
  } else if (!missing(pos)) {
    if (pos < 1 || pos > length(search())) stop("invalid pos value")
  } else if (!missing(envir)) { pos <- 0 } else { pos <- -1 }
  what <- .Internal(ls(pos, envir, all.files))
  if(is.null(pattern)) what else what[grep(pattern, what)]
}

pat2grep <- function(pattern)
{
  ## Purpose: Change "ls pattern" to "grep regular expression" pattern.
  ## -------------------------------------------------------------------------
  ## Author: Martin Maechler ETH Zurich, ~ 1991
  sed.cmd <- "'s/\\./\\\\./g;s/*/.*/g;s/?/./g; s/^/^/;s/$/$/; s/\\.\\*\\$$//'"
  system(paste("echo '", pattern, "'| sed ", sed.cmd, sep = ""),intern=TRUE)
}


lsR <- get("ls", env=.SystemEnv) # Save the original 

ls <- function(pattern = NULL, pos = 1, envir = NULL, all.files = FALSE)
{
  ##-- Substitute to 'standard' ls ---
  ## Author: Martin Maechler,  ETH Zurich, ~ 1991 for S-plus;   1997 for R
  objects(pos = pos,
	  pattern = if(is.null(pattern)) pattern else pat2grep(pattern),
	  envir = envir, all.files = all.files)
}
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
r-help 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-help-request at stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=