Hi
Consider the following example:
f <- function(expr) g(expr)
g <- function(expr) {
h(expr)
}
h <- function(expr) {
expr # evaluation happens here
i(expr)
}
i <- function(expr) {
expr # already evaluated, no costs here
invisible()
}
rprof <- tempfile()
Rprof(rprof)
f(replicate(1e2, sample.int(1e4)))
Rprof(NULL)
cat(readLines(rprof), sep = "\n")
#> sample.interval=20000
#> "sample.int" "FUN" "lapply" "sapply" "replicate" "h" "g" "f"
#> "sample.int" "FUN" "lapply" "sapply" "replicate" "h" "g" "f"
#> "sample.int" "FUN" "lapply" "sapply" "replicate" "h" "g" "f"
The evaluation of the slow replicate() call is deferred to the execution
of h(), but there's no replicate() call in h's definition. This makes
parsing the profile much more difficult than necessary.
I have pasted an experimental patch below (off of 3.6.2) that produces
the following output:
cat(readLines(rprof), sep = "\n")
#> sample.interval=20000
#> "sample.int" "FUN" "lapply" "sapply" "replicate" "f"
#> "sample.int" "FUN" "lapply" "sapply" "replicate" "f"
#> "sample.int" "FUN" "lapply" "sapply" "replicate" "f"
This attributes the cost to the replicate() call to f(), where the call
is actually defined. From my experience, this will give a much better
understanding of the actual costs of each part of the code. The SIGPROF
handler looks at sysparent and cloenv before deciding if an element of
the call stack is to be included in the profile.
Is there interest in integrating a variant of this patch, perhaps with
an optional argument to Rprof()?
Thanks!
Best regards
Kirill
Index: src/main/eval.c
===================================================================
--- src/main/eval.c (revision 77857)
+++ src/main/eval.c (working copy)
@@ -218,7 +218,10 @@
if (R_Line_Profiling)
lineprof(buf, R_getCurrentSrcref());
+ SEXP sysparent = NULL;
+
for (cptr = R_GlobalContext; cptr; cptr = cptr->nextcontext) {
+ if (sysparent != NULL && cptr->cloenv != sysparent &&
cptr->sysparent != sysparent) continue;
if ((cptr->callflag & (CTXT_FUNCTION | CTXT_BUILTIN))
&& TYPEOF(cptr->call) == LANGSXP) {
SEXP fun = CAR(cptr->call);
@@ -292,6 +295,8 @@
else
lineprof(buf, cptr->srcref);
}
+
+ sysparent = cptr->sysparent;
}
}
}
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
