Aspen Chen
Aspen Chen

Reputation: 735

Pass on the argument name and value within a function

I already have a few functions that manipulate both the name and other properties of the same object. While they operate fine individually, I am having trouble writing a "control" that would pass on the argument to all of them in one move.

So far, I have narrowed the problem down to the argument's name. To illustrate, the simplified code below shows the failure of passing on the name from the "control" (f2) down to the individual functions (f1).

x=7
f1<-function(a){
    label<-deparse(substitute(a))
    cat("f1 value:",a,"\n")
    cat("f1 label:",label,"\n")
}

f2<-function(b){
    label<-deparse(substitute(b))
    cat("f2 value:",b,"\n")
    cat("f2 label:",label,"\n")
    f1(b)
}
f2(x)


#>f2 value: 7 
#>f2 label: x 
#>f1 value: 7 
#>f1 label: b

It appears that the object x is properly passed on to f2, as the returned value 7 and name "x" indicates. But when calling f1 within f2, I could only pass on the value, not the name, of the object x. Correct me if I am wrong, but my understanding is that f1 only sees the binding between the name "b" and the value 7 through the argument.

Is there is a way to let f1 read both the name and value of "x" in this example? I am pretty new to R, and have tried to apply my half-baked understanding of environments, evaluation and calls to no avail. The only solution I found is to use assign "label" as global in f2 through <<-, which is far from ideal.

Thanks in advance for any input.

Edited: the full corrected code

Thanks to suggestions from MrFlick. Here's the code for the actual problem I was trying to solve (now fixed). Since I am new to R, I'd still appreciate suggestions on better ways to do it.

Basically I have a few dozen lmer (.99x version of lme4 package) models estimated, and like the associated output to be aggregated ultimately into an Excel file. In the code below, lmer.stats,lmer.fixef, and lmer.ranef all create data frames based on corresponding results. lmer.append are used to call three these functions and rbind the results.

Since there are so many models, I needed an additional id variable label created to tell one model from another in the aggregate output. The idea is to extract the argument name and make it an identifier variable, which I had trouble with until MrFlick's kind suggestions Now the ... fix works great.

## model summary statistics
lmer.stats<-function(lmer.name) {
    A<-AIC(lmer.name)
    B<-BIC(lmer.name)
    ll<-logLik(lmer.name)
    dv<-deviance(lmer.name)
    obs.TIME<-length(lmer.name@y)
    obs.CHILD<-sapply(ranef(lmer.name),nrow)[1]
    names(obs.CHILD)<-NULL
    obs.SCHOOL<-sapply(ranef(lmer.name),nrow)[2]
    names(obs.SCHOOL)<-NULL
    label<-deparse(substitute(lmer.name))
    df<-data.frame(label, "AIC"=A, "BIC"=B, "LL"=ll, "DEV"=dv, "N"=obs.TIME, "CHILD"=obs.CHILD, "SCHOOL"=obs.SCHOOL)
}
## random effects
lmer.ranef<-function(lmer.name){
    re<-data.frame(summary(lmer.name)@REmat)
    re<-subset(re,select=-Name)
    label<-deparse(substitute(lmer.name))   # identifier
    nr<-nrow(summary(lmer.name)@REmat)
    md<-data.frame(rep(label,nr))
    colnames(md)<-"Model"

    dfr<-data.frame(cbind(md,re))

    if (ncol(dfr)==4)   {       # random slope models have additional columns
        corr.col<-data.frame(rep(NA,nr))
        colnames(corr.col)<-"Corr"
        V6.col<-data.frame(rep(NA,nr))
        colnames(V6.col)<-"V6"
        dfr<-data.frame(cbind(dfr,corr.col,V6.col))
    }   else {
                dfr<-dfr
        }
}
## fixed effects
lmer.fixef<-function(lmer.name){
    beta<-data.frame("Beta"=fixef(lmer.name))
    se<-data.frame("S.E."=sqrt(diag(vcov(lmer.name))))
    vars<-data.frame(row.names(beta))
    colnames(vars)<-"Variable"
    vars$Variable<-gsub("\\)", "", vars$Variable)   # deal with (Intercept)
    vars$Variable<-gsub("\\(", "", vars$Variable)
    label<-deparse(substitute(lmer.name))   # identifier
    md<-data.frame(rep(label,length(lmer.name@fixef)))
    colnames(md)<-"Model"
    row.names(beta)<-NULL
    dff<-data.frame(cbind(md,vars,beta,se))
}
## controller
    lmer.append<-function(...,append=TRUE)  {
    label<<-deparse(substitute(...))
    if (!append){
        L.stats<<-lmer.stats(...)
        L.ranef<<-lmer.ranef(...)
        L.fixef<<-lmer.fixef(...)
    } else {
        L.stats<<-rbind(L.stats, lmer.stats(...))
        L.ranef<<-rbind(L.ranef, lmer.ranef(...))
        L.fixef<<-rbind(L.fixef, lmer.fixef(...))
    }
}

Upvotes: 0

Views: 1026

Answers (1)

MrFlick
MrFlick

Reputation: 206546

On possibility is to let the variable "fall-though" f1 into f2 via the "..." argument.

x=7
f1<-function(a){
    label<-deparse(substitute(a))
    cat("f1 value:",a,"\n")
    cat("f1 label:",label,"\n")
}

f2<-function(...) {
    label<-deparse(substitute(...))
    cat("f2 value:",eval(substitute(...)),"\n")
    cat("f2 label:",label,"\n")
    f1(...)
}
f2(x)

# f2 value: 7 
# f2 label: x 
# f1 value: 7 
# f1 label: x 

But it really depends on why you have this arrangement at all. A more natural way might be to do this

x=7
f1<-function(a, label=deparse(substitute(a))) {
    cat("f1 value:",a,"\n")
    cat("f1 label:",label,"\n")
}

f2<-function(b) {
    label<-deparse(substitute(b))
    cat("f2 value:",b,"\n")
    cat("f2 label:",label,"\n")
    f1(b, label)
}
f2(x)

Which also returns

# f2 value: 7 
# f2 label: x 
# f1 value: 7 
# f1 label: x 

and f1(x) still returns

# f1 value: 7 
# f1 label: x 

Upvotes: 1

Related Questions