/ / Przekaż nazwę i wartość argumentu w funkcji - r

Przekaż nazwę argumentu i wartość wewnątrz funkcji - r

Mam już kilka funkcji, które manipulujązarówno nazwa, jak i inne właściwości tego samego obiektu. Chociaż działają one indywidualnie indywidualnie, mam problem z napisaniem „kontrolki”, która przekazałaby argument wszystkim w jednym ruchu.

Do tej pory zawęziłem problem donazwa argumentu. Aby to zilustrować, uproszczony kod poniżej pokazuje niepowodzenie przekazania nazwy z „kontroli” (f2) do poszczególnych funkcji (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

Wygląda na to, że obiekt x został poprawnie przekazanyna f2, jak wskazuje zwrócona wartość 7 i nazwa „x”. Ale wywołując f1 w obrębie f2, mogłem przekazać tylko wartość, a nie nazwę obiektu x. Popraw mnie, jeśli się mylę, ale rozumiem, że f1 widzi tylko argument między nazwą „b” a wartością 7.

Czy istnieje sposób, aby f1 odczytał obie nazwyi wartość „x” w tym przykładzie? Jestem całkiem nowy w R i starałem się zastosować moje na wpół uparte rozumienie środowisk, oceny i wezwania bezskutecznie. Jedynym rozwiązaniem, jakie znalazłem, jest użycie przypisania „etykiety” jako globalnej w f2 przez << - co jest dalekie od ideału.

Z góry dziękuję za wszelkie uwagi.

Edytowano: w pełni poprawiony kod

Dzięki sugestiom MrFlick. Oto kod rzeczywistego problemu, który próbowałem rozwiązać (teraz naprawiony). Ponieważ jestem nowy w R, nadal doceniam sugestie na temat lepszych sposobów, aby to zrobić.

Zasadniczo mam kilkadziesiąt lmer (.99x wersja lme4 pakiet) oszacowano i podobnie jak skojarzone dane wyjściowe zostaną ostatecznie zagregowane do pliku Excel. W poniższym kodzie lmer.stats,lmer.fixef, i lmer.ranef wszystkie tworzą ramki danych na podstawie odpowiednich wyników. lmer.append są używane do wywołania trzech tych funkcji i rbind wyniki.

Ponieważ jest tyle modeli, potrzebowałem dodatkowej zmiennej id etykieta utworzony, aby odróżnić jeden model od drugiego włączna produkcja. Chodzi o to, aby wyodrębnić nazwę argumentu i uczynić ją zmienną identyfikatora, z którą miałem problem, dopóki miłe sugestie MrFlick'a nie ... fix działa świetnie.

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

Odpowiedzi:

1 dla odpowiedzi № 1

Możliwe jest, aby zmienna „wpadła” f1 w f2 za pomocą argumentu „...”.

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

Ale to naprawdę zależy od tego, dlaczego w ogóle masz takie ustawienie. Bardziej naturalny sposób może to zrobić

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)

Który również zwraca

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

i f1(x) wciąż wraca

# f1 value: 7
# f1 label: x