R-alpha: frametools v.0.0000001

[Peter Dalgaard BSA]

The following three functions are designed to make manipulation of
dataframes easier. I won't write detailed docs just now, but if you
follow the example below, you should get the general picture. Comments
are welcome, esp. re. naming conventions. 

Note that these functions are definitely not portable to S because
they rely on R's scoping rules. Not that difficult to fix, though: The
nm vector and the "parsing" functions need to get assigned to
(evaluation) frame 1 (the "expression frame" of S), and preferably
removed at exit.

data(airquality)
aq<-airquality[1:10,]
select.frame(aq,Ozone:Temp)
subset.frame(aq,Ozone>20)
modify.frame(aq,ratio=Ozone/Temp)

Notice that in modify.frame(), any *new* variable must appear as a
tag, not as the result of an assignment, i.e.:

modify.frame(aq,Ozone<-log(Ozone)) works as expected
modify.frame(aq,lOzone<-log(Ozone)) does not.

This is mainly because it was tricky to figure out what part of a left
hand side constitutes a new variable to be created (note that indexing
could be involved). So assignments to non-existing variables just
create them as local variables within the function. Making a virtue
out of necessity, that might actually be considered a feature...

----------------------------------------
"select.frame" <-
function (dfr, ...) 
{
        subst.call <- function(e) {
                if (length(e) > 1) 
                        for (i in 2:length(e)) e[[i]] <- subst.expr(e[[i]])
                e
        }
        subst.expr <- function(e) {
                if (is.call(e)) 
                        subst.call(e)
                else match.expr(e)
        }
        match.expr <- function(e) {
                n <- match(as.character(e), nm)
                if (is.na(n)) 
                        e
                else n
        }
        nm <- names(dfr)
        e <- substitute(c(...))
        dfr[, eval(subst.expr(e))]
}
"modify.frame" <-
function (dfr, ...) 
{
        nm <- names(dfr)
        e <- substitute(list(...))
        if (length(e) < 2) 
                return(dfr)
        subst.call <- function(e) {
                if (length(e) > 1) 
                        for (i in 2:length(e)) e[[i]] <- subst.expr(e[[i]])
                substitute(e)
        }
        subst.expr <- function(e) {
                if (is.call(e)) 
                        subst.call(e)
                else match.expr(e)
        }
        match.expr <- function(e) {
                if (is.na(n <- match(as.character(e), nm))) 
                        if (is.atomic(e)) 
                                e
                        else substitute(e)
                else substitute(dfr[, n])
        }
        tags <- names(as.list(e))
        for (i in 2:length(e)) {
                ee <- subst.expr(e[[i]])
                r <- eval(ee)
                if (!is.na(tags[i])) {
                        if (is.na(n <- match(as.character(tags[i]), 
                                nm))) {
                                n <- length(nm) + 1
                                dfr[[n]] <- numeric(nrow(dfr))
                                names(dfr)[n] <- tags[i]
                                nm <- names(dfr)
                        }
                        dfr[[tags[i]]][] <- r
                }
        }
        dfr
}
"subset.frame" <-
function (dfr, expr) 
{
        nm <- names(dfr)
        e <- substitute(expr)
        subst.call <- function(e) {
                if (length(e) > 1) 
                        for (i in 2:length(e)) e[[i]] <- subst.expr(e[[i]])
                e
        }
        subst.expr <- function(e) {
                if (is.call(e)) 
                        subst.call(e)
                else match.expr(e)
        }
        match.expr <- function(e) {
                if (is.na(n <- match(as.character(e), nm))) 
                        e
                else dfr[, n]
        }
        r <- eval(subst.expr(e))
        r <- r & !is.na(r)
        dfr[r, ]
}


-- 
   O__  ---- Peter Dalgaard             Blegdamsvej 3  
  c/ /'_ --- Dept. of Biostatistics     2200 Cph. N   
 (*) \(*) -- University of Copenhagen   Denmark      Ph: (+45) 35327918
~~~~~~~~~~ - (p.dalgaard@biostat.ku.dk)             FAX: (+45) 35327907
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
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
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-