Generating GraphViz code for visualizing Shiny reactive dependencies

genGraphVizCode.r

d <- parse("server stripped bare.R")
dc <- as.character(d)

reactives <- NULL
# find reactive sources
for(t in dc) {
	if( grepl("reactive(.*)$",t)) { #if it is reactive
		g <- gregexpr("^[A-Za-z0-9._]*",t)
		p <- as.numeric(g[[1]])
		l <- attr(g[[1]],"match.length")
		endpoint <-substr(t,p,p+l-1)
		reactives <- c(reactives,endpoint)
	}
}
reactives <- paste(unique(reactives),"\\(\\)",sep="")

# parse each expression
maps <- NULL
i <- 0
for(t in dc) {
	i <- i + 1
	# determine if the expression is reactive() or render
	if( grepl("reactive(.*)$",t)) { #if it is reactive
		g <- gregexpr("^[A-Za-z0-9\\._]*",t)
		p <- as.numeric(g[[1]])
		l <- attr(g[[1]],"match.length")
		endpoint <-substr(t,p,p+l-1)
		endpoint <- paste(unique(endpoint),"\\(\\)",sep="")
	} else if( grepl("^output\\$",t)) { #if it is output
		g <- gregexpr("^output\\$[A-Za-z0-9\\._]*",t)	
		p <- as.numeric(g[[1]])
		l <- attr(g[[1]],"match.length")
		endpoint <-substr(t,p,p+l-1)
	}
	# find input sources
	input.sources <- NULL
	g <- gregexpr("input\\$[A-Za-z0-9\\._]*",t)
	p <- as.numeric(g[[1]])
	l <- attr(g[[1]],"match.length")
	input.sources <- substr(rep(t,2),p,p+l-1)
	
	# find reactive sources
	a <- NULL
	a <- sapply(reactives,grepl,t)
	input.sources <- c(input.sources,names(a)[a])
	
	input.sources <- input.sources[input.sources != ""]
	
	map <- expand.grid(input.sources,endpoint)
	map$i <- rep(i,length(input.sources))

	maps <- rbind(maps,map)	
}

maps <- unique(maps)
graphviz.code <- paste("digraph {",
paste(
	paste('"',maps$Var1,'"',sep=""),
	paste('"',maps$Var2,'"',sep=""),sep="->",collapse=";"),"}");

write(graphviz.code,"c:/temp/g.txt")

intersected <- function(x,y) {
	length(intersect(x,y)) > 0
}

absorb <- function (x,y) {
	if(intersected(x,y)) {
		union(x,setdiff(y,x))
	} else {
		x
	}
}

#determine clusters
ui <- unique(maps$Var1)
ic <- sapply(ui,function(x) {maps$Var1[maps$Var1==x]})
uo <- unique(maps$Var2)
oc <- sapply(uo,function(x) {maps$Var1[maps$Var2==x]})

for(i in 1:length(ic)) {
	x = unique(ic[[i]])
	for(y in oc) {
		x <- absorb(x,y)	
	}
	ic[[i]] <- sort(x)
	#oc <- oc[which(sapply(oc,intersected,x)==FALSE)]
}
ic <- unique(ic)

ic2 <- ic 
for(i in 1:length(ic)) {
	x = ic[[i]]
	for(y in ic2) {
		x <- absorb(x,y)
	}
	ic[[i]] <- sort(x)
	#oc <- oc[which(sapply(oc,intersected,x)==FALSE)]
}
#ic
ic <- unique(ic)
length(unique(ic))

# these are all the clusters we want
ic

#write the clusters back to the map
clusters <- rep(-1,length(maps$i))
for(i in 1:length(ic)) {
	clusters[maps$Var1 %in% ic[[i]]] <- i
}
maps$clusters <- clusters

graphviz.cl.code  <- ""
for(i in 1:length(ic)) {
	graphviz.cl.code <- paste(graphviz.cl.code,paste("subgraph cluster",i,' { label = "cluster #',i,'";',
						   paste(
						   	paste('"',maps$Var1[maps$clusters==i],'"',sep=""),
						   	paste('"',maps$Var2[maps$clusters==i],'"',sep=""),sep="->",collapse=";"),"}",sep=""));

}
graphviz.cl.code <- paste('digraph { graph[rankdir="LR"] ',graphviz.cl.code,"}")

###The unclustered version was written above
###write(graphviz.code,"c:/temp/g.txt")
#The clustered version 
write(graphviz.cl.code,"c:/temp/g.txt")

server stripped bare.r

  
	# Reactive expression to generate the requested distribution. This is 
	# called whenever the inputs change. The renderers defined 
	# below then all use the value computed from this expression
	data <- reactive({  
		dist <- switch(input$dist.hello,
					   norm = rnorm,
					   unif = runif,
					   lnorm = rlnorm,
					   exp = rexp,
					   rnorm)
		
		dist(input$n)
	})
	
	# Generate a plot of the data. Also uses the inputs to build the 
	# plot label. Note that the dependencies on both the inputs and
	# the 'data' reactive expression are both tracked, and all expressions 
	# are called in the sequence implied by the dependency graph
	output$plot <- renderPlot({
		dist <- input$dist
		n <- input$n
		
		hist(data(), 
			 main=paste('r', dist, '(', n, ')', sep=''))
	})
	
	# Generate a summary of the data
	output$summary <- renderPrint({
		summary(data())
	})
	
	# Generate an HTML table view of the data
	output$table <- renderTable({
		data.frame(x=data())
	})