[Roxygen-commits] r123 - pkg/sandbox

[noreply at r-forge.r-project.org]

Author: pcd
Date: 2008-07-29 05:49:03 +0200 (Tue, 29 Jul 2008)
New Revision: 123

Modified:
   pkg/sandbox/callgraph.R
Log:
non-fdp; too small


Modified: pkg/sandbox/callgraph.R
===================================================================
--- pkg/sandbox/callgraph.R	2008-07-28 15:09:53 UTC (rev 122)
+++ pkg/sandbox/callgraph.R	2008-07-29 03:49:03 UTC (rev 123)
@@ -1,3 +1,6 @@
+library(graph)
+library(Rgraphviz)
+
 source('../R/roxygen.R')
 source('../R/functional.R')
 source('../R/list.R')
@@ -41,17 +44,24 @@
 
 calls <- NULL
 
-is.callable <- function(name) {
+is.callable <- function(name, include.primitives) {
   f <- tryCatch(get(name, mode='function'), error=function(e) NULL)
+###   !is.null(f) && ifelse(include.primitives,
+###                         is.primitive(f),
+###                         TRUE)
   !is.null(f) && !is.primitive(f)
 }
 
 exprofundum <- expression(roxygenize)
+exprofundum <- expression(append)
 
-discover.subcalls <- function(exprofundum, depth=1)
+discover.subcalls <- function(exprofundum,
+                              depth=2,
+                              include.primitives=FALSE)
   if (is.name(exprofundum)) {
     subcall <- as.character(exprofundum)
-    if (is.callable(subcall) && call.stack$top <= depth) {
+    if (is.callable(subcall, include.primitives) &&
+        call.stack$top <= depth) {
       supercall <-
         if (call.stack$is.empty())
           NULL
@@ -75,20 +85,62 @@
     }
   }
 
+## discover.subcalls <- Curry(include.primitives=TRUE,
+##                            depth=1)
+
 preorder.walk.expression(discover.subcalls, exprofundum)
 
+## graphviz <- function(subcalls) {
+##   cat('digraph G { graph [splines=true]; node [fontname=monospace]; ')
+##   supercalls <- ls(subcalls)
+##   for (supercall in supercalls) {
+##     cat(sprintf('"%s"; ', supercall))
+##     subsupercalls <- subcalls[[supercall]]
+##     for (subsupercall in subsupercalls)
+##       cat(sprintf('"%s" -> "%s"; ',
+##                   supercall,
+##                   subsupercall))
+##   }
+##   cat('}')
+## }
+
 graphviz <- function(subcalls) {
-  cat('digraph G { graph [splines=true]; node [fontname=monospace]; ')
   supercalls <- ls(subcalls)
-  for (supercall in supercalls) {
-    cat(sprintf('"%s"; ', supercall))
-    subsupercalls <- subcalls[[supercall]]
-    for (subsupercall in subsupercalls)
-      cat(sprintf('"%s" -> "%s"; ',
-                  supercall,
-                  subsupercall))
-  }
-  cat('}')
+  graph <- new('graphNEL', nodes=supercalls)
+  attrs <- list(graph=list(size=NULL))
+  nodeAttrs <- makeNodeAttrs(graph,
+                             fixedsize=FALSE,
+                             shape='ellipsis')
+  for (supercall in supercalls)
+    for (subsupercall in subcalls[[supercall]])
+      try(graph <- addEdge(supercall,
+                           subsupercall,
+                           graph))
+  plot(agopen(graph,
+              'roxygenize'
+###               attrs=attrs,
+###               nodeAttrs=nodeAttrs
+       ))
+###   agraph <- agopenSimple(graph, 'roxygenize')
+###   graphDataDefaults(agraph, 'size') <- NULL
+###   nodeDataDefaults(agraph, c('shape', 'fixedsize')) <-
+###     c('ellipsis', FALSE)
+###   toFile(agraph,
+###          layoutType='fdp',
+###          filename='test.ps',
+###          fileType='ps')
+###   plot(agraph, 'fdp')
+###   toFile(agopen(graph,
+###                 name='roxygenize',
+###                 attrs=getDefaultAttrs(attrs)),
+###          layoutType='fdp',
+###          filename='test.ps',
+###          fileType='ps'
+### ###               attrs=list(nodes=
+### ###                 list(shape='ellipsis',
+### ###                      fixedsize=FALSE),
+### ###                 graph=list(size=NULL))
+###          )
 }
 
 graphviz(subcalls)