/ / Passar o nome e o valor do argumento dentro de uma função - r

Passar o nome do argumento e valor dentro de uma função - r

Eu já tenho algumas funções que manipulamo nome e outras propriedades do mesmo objeto. Enquanto eles funcionam bem individualmente, estou tendo problemas para escrever um "controle" que passaria o argumento para todos eles em um movimento.

Até agora, eu reduzi o problema aoPara ilustrar, o código simplificado abaixo mostra a falha de passar o nome do "controle" (f2) para as funções individuais (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

Parece que o objeto x foi passado corretamentepara f2, como o valor retornado 7 e o nome "x" indica. Mas ao chamar f1 dentro de f2, eu só poderia passar o valor, não o nome, do objeto x. Corrija-me se estiver errado, mas meu entendimento é que f1 vê apenas a ligação entre o nome "b" e o valor 7 através do argumento.

Existe uma maneira de deixar f1 ler tanto o nomee valor de "x" neste exemplo? Eu sou muito novo no R e tentei aplicar minha compreensão de ambientes, avaliação e chamadas sem sucesso. A única solução que encontrei é usar assign "label" como global em f2 a << -, o que está longe de ser ideal.

Agradecemos antecipadamente por qualquer entrada.

Editado: o código completo corrigido

Graças a sugestões do MrFlick. Aqui está o código para o problema real que eu estava tentando resolver (agora corrigido). Desde que eu sou novo em R, eu ainda aprecio sugestões sobre melhores maneiras de fazê-lo.

Basicamente eu tenho algumas dúzias lmer (Versão. lme4 pacote) modelos estimados, e como a saída associada a ser agregada, finalmente, em um arquivo do Excel. No código abaixo, lmer.stats,lmer.fixefe lmer.ranef todos criam quadros de dados com base nos resultados correspondentes. lmer.append são usados ​​para chamar três dessas funções e rbind os resultados.

Como existem tantos modelos, precisei de uma variável de identificação adicional rótulo criado para dizer um modelo de outro nosaída agregada. A idéia é extrair o nome do argumento e torná-lo uma variável identificadora, com a qual tive problemas até as sugestões do Sr. Flick. ... Correção funciona muito bem.

## 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(...))
}
}

Respostas:

1 para resposta № 1

Na possibilidade é deixar a variável "cair" f1 para dentro f2 através do argumento "...".

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

Mas isso realmente depende de porque você tem esse arranjo. Uma maneira mais natural pode ser fazer isso

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)

Que também retorna

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

e f1(x) ainda retorna

# f1 value: 7
# f1 label: x