У меня есть несколько пользовательских функций журнала, которые являются расширениями cat.Базовый пример примерно такой:
catt<-function(..., file = "", sep = " ", fill = FALSE, labels = NULL,
append = FALSE)
{
cat(..., format(Sys.time(), "(%Y-%m-%d %H:%M:%S)"), "\n", file = file,
sep = sep, fill = fill, labels = labels, append = append)
}
Теперь я много работаю с (самодельными) функциями и использую некоторые из этих функций журнала, чтобы увидеть прогресс, который работает довольно хорошо.Однако я замечаю, что я почти всегда использую эти функции следующим образом:
somefunc<-function(blabla)
{
catt("somefunc: start")
#do some very useful stuff here
catt("somefunc: some time later")
#even more useful stuff
catt("somefunc: the end")
}
Обратите внимание, как каждый вызов catt начинается с имени функции, из которой он вызывается.Очень аккуратно, пока я не начну реорганизовывать свой код и переименовывать функции и т.д.':
catw<-function(..., file = "", sep = " ", fill = FALSE, labels = NULL,
append = FALSE)
{
curcall<-sys.call(sys.parent(n=1))
prefix<-paste(match.call(call=curcall)[[1]], ":", sep="")
cat(prefix, ..., format(Sys.time(), "(%Y-%m-%d %H:%M:%S)"), "\n",
file = file, sep = sep, fill = fill, labels = labels, append = append)
}
Это очень хорошо, но не всегда работает, потому что:
- мои функции разбросаны по анонимным функциям, используемым в функциях типа
lapplyПримерно так:
aFunc<-function(somedataframe)
{
result<-lapply(seq_along(somedataframe), function(i){
catw("working on col", i, "/", ncol(somedataframe))
#do some more stuff here and return something
return(sum(is.na(somedataframe[[i]])))
}
}
-> для этих случаев, по-видимому (и понятно), мне нужно n = 3 в вызове sys.parent в моей функции catw.
- Я иногда использую
do.call: похоже, моя текущая реализация тоже не работает (еще раз я могу это понять, хотя и не до конца разобрался.
Итак, мой вопрос: есть ли способ найти первую функцию с именем выше в стеке вызовов (пропуская саму функцию регистрации и, возможно, некоторые другие "хорошо известные" исключения), чтопозвольте мне написать одну версию catw fили во всех случаях (чтобы я мог успешно провести рефакторинг, не беспокоясь о своем коде регистрации)?Как бы вы поступили примерно так?
Редактировать : эти случаи должны поддерживаться:
testa<-function(par1)
{
catw("Hello from testa, par1=", par1)
for(i in 1:2) catw("normal loop from testa, item", i)
rv<-sapply(1:2, function(i){catw("sapply from testa, item", i);return(i)})
return(rv)
}
testb<-function(par1, par2)
{
catw("Hello from testb, par1=", par1)
for(i in 1:2) catw("normal loop from testb, item", i)
rv<-sapply(1:2, function(i){catw("sapply from testb, item", i);return(i)})
catw("Will now call testa from testb")
rv2<-testa(par1)
catw("Back from testa call in testb")
catw("Will now do.call testa from testb")
rv2<-do.call(testa, list(par1))
catw("Back from testa do.call in testb")
return(list(rv, rv2))
}
testa(123)
testb(123,456)
do.call(testb, list(123,456))