Test parset shiny

testparse.r

#find top level expression
ancestor <- function(code.pd,id,ancestors_parent_id=0) {
  this <-  code.pd[code.pd$id == id,]
	if(this$parent == ancestors_parent_id) return(this)
	immediate_parent = code.pd[code.pd$id == this$parent,]
	if(immediate_parent$parent == ancestors_parent_id)
		return(immediate_parent)
	return(ancestor(code.pd,immediate_parent$id,ancestors_parent_id))
}


children <- function(code.pd,id) {
	code.pd[code.pd$parent %in% id,]
}

allDescendents <- function(code.pd,id) {
	this <- code.pd[code.pd$id %in% id,]
	if(all(this$terminal)) return ()
	descendents <- children(code.pd,id)
	id <- descendents$id	
	return(rbind(descendents,allDescendents(code.pd,id)))
}

isIsolated <- function(code.pd,id) {
	#traverse up to see what it's contained in
}

code <- parse("c:/temp/shinyalert/server.R")
code.pd <- getParseData(code)

# look for server function
shiny_server_expr_id <- code.pd$parent[code.pd$token == "SYMBOL_FUNCTION_CALL" & code.pd$text == "shinyServer"  ]
daddy <- ancestor(code.pd,shiny_server_expr_id)
ad <- allDescendents(code.pd,daddy$id)

# identify the shiny server code expresions

# traverse the code looking for 
shinyservercode <- NULL
for(expr in code) {
	if (length(grep("^shinyServer",expr))==1) {# find the code that starts off as shinyServer
		shinyservercode <-  expr
	}
}

inside <- shinyservercode[2] # this should be the code inside the shinyservercode

code1 <- parse(text=as.character(inside[1]))

code1.c <- as.character(code1)
#strip the function definition from code1
gsub("^.*\\{","",code1.c)

d <- gregexpr("^.*\\{",code1.c,perl=TRUE)

l <- attr(d[[1]],"match.length")

code2.c <- substr(code1,l+1,nchar(code1.c)-1) 

# now the code should be in functions
server.code.parse = parse(text=code2.c)

p <- server.code.parse[2]

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('"',macrps$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")