Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Test parset shiny
#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")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.