R/proftools-GUI.R

In ltierney/Rpkg-proftools-GUI: A Graphical User Interface for Examining R Profile Output

offspring <- function(path, win) {
    DF <- attr(win, 'env')$offspringDF
    self.gc <- attr(win, 'env')$self.gc
    if(length(path) > 0){
        pathLength <- length(path)
        path <- paste(path, collapse=" -> ")
        offspringDF <- DF[path == sapply(strsplit(DF$path, " -> "), 
                                       function(x){ if(length(x) > pathLength)
                                                        x <- x[1:pathLength]
                                                    paste(x, collapse=" -> ")}),]
        sonsDepth <- offspringDF$depth[1]+1
        sons <- which(offspringDF$depth==sonsDepth)
        if(sons[length(sons)] == nrow(offspringDF))
            nextDepths <- c(offspringDF$depth[sons[-length(sons)]+1], 0)
        else nextDepths <- offspringDF$depth[sons+1]
        haveSons <- (nextDepths > offspringDF$depth[sons])
        offspringDF <- data.frame(Function=offspringDF$name[sons], 
                                  haveSons=haveSons, 
                                  total=offspringDF$total[sons], 
                                  self=offspringDF$self[sons],
                                  GC=offspringDF$GC[sons],
                                  GC.Self=offspringDF$GC.Self[sons], 
                                  alloc=offspringDF$alloc[sons], 
                                  allocself=offspringDF$allocself[sons], 
                                  stringsAsFactors=FALSE)
    }    
    else{ 
        foundingFathers <- which(DF$depth==1)
        if(foundingFathers[length(foundingFathers)] == nrow(DF))
            nextDepths <- c(DF$depth[foundingFathers[-length(foundingFathers)]+1]
                            , 0)
        else nextDepths <- DF$depth[foundingFathers+1]
        haveSons <- (nextDepths > DF$depth[foundingFathers])
        offspringDF <- data.frame(Function=DF$name[foundingFathers], 
                                  haveSons=haveSons, 
                                  total=DF$total[foundingFathers], 
                                  self=DF$self[foundingFathers],
                                  GC=DF$GC[foundingFathers],
                                  GC.Self=DF$GC.Self[foundingFathers], 
                                  alloc = DF$alloc[foundingFathers], 
                                  allocself = DF$allocself[foundingFathers], 
                                  stringsAsFactors=FALSE)
    }
    if(!self.gc[1]) {
        offspringDF$self = NULL
        offspringDF$GC.Self = NULL
        offspringDF$allocself = NULL
    }
    if(!self.gc[2]) {
        offspringDF$GC = NULL
        offspringDF$GC.Self = NULL
    }
    if(!self.gc[3]) {
        offspringDF$alloc = NULL
        offspringDF$allocself = NULL
    }
    return(offspringDF)
}

setOffspringDF <- function(pd, value = c("pct", "time", "hits"),
                           self = FALSE, srclines = TRUE, gc = TRUE, memory = FALSE,
                           maxdepth = 10){
    pathData <- hotPaths(pd, value, self, srclines, gc, memory, maxdepth = maxdepth, short = "-> ")
    x <- strsplit(pathData$path, "-> ")
    ## Plugs function names into paths and gets depth of each line
    y <- sapply(1:length(x), 
                function(i) {
                    x[[i]][length(x[[i]])] <<- sub("^(.+?) *$", "\\1", 
                                                   x[[i]][length(x[[i]])])
                    if(length(x[[i]])>1)
                        x[[i]][1:length(x[[i]])-1] <<- x[[i-1]][1:length(x[[i]])-1]
                    c(paste(x[[i]], collapse=" -> "), x[[i]][length(x[[i]])], 
                      length(x[[i]]))
                }
          )
    pathData <- fixSumDF(pathData, self, gc, value, memory)
    ## Reason for global assignment is tcltk toolkit has problems passing the 
    ## dataframe to get children of foundingFathers
    data.frame(path=as.character(y[1,]), 
                                 name=as.character(y[2,]), depth=as.numeric(y[3,]), 
                                 total=pathData$total, self=pathData$self,
                                 GC=pathData$gc, GC.Self=pathData$gcself,
                                 alloc=pathData$alloc, allocself = pathData$allocself,
                                 stringsAsFactors = FALSE)
}

fixSumDF <- function(DF, self, gc, value, memory){
    names(DF) <- sub(paste(".", value[1], sep=""), "", names(DF), fixed=T)
    if(!gc){
        DF$gc <- rep("", nrow(DF))
        DF$gcself <- rep("", nrow(DF))
    }
    if(!memory){
        DF$alloc <- rep("", nrow(DF))
        DF$allocself <- rep("", nrow(DF))
    }
    if(!self){
        DF$self <- rep("", nrow(DF))
        DF$gcself <- rep("", nrow(DF))
        DF$allocself <- rep("", nrow(DF))
    }
    DF
}

offspringFunSum <- function(path, win) {
    callSum <- attr(win, 'env')$callSum
    fcnSummary <- attr(win, 'env')$fcnSummary
    self.gc <- attr(win, 'env')$self.gc
    if(length(path) > 0){
        fcnName <- path[length(path)]

        calledFcns <- grep(fcnName, callSum$callers, fixed=TRUE)
        calledFcns <- callSum[calledFcns,]
        haveSons <- sapply(calledFcns$callees, 
                           function(x) { any(grepl(x, callSum$callers,
                                             fixed=TRUE)) })
        offspringDF <- data.frame(Function = calledFcns$callees, 
                                  haveSons = haveSons, 
                                  total=calledFcns$total, 
                                  self=calledFcns$self,
                                  GC=calledFcns$gc,
                                  GC.Self=calledFcns$gcself, 
                                  alloc = calledFcns$alloc,
                                  allocself = calledFcns$allocself,
                                  stringsAsFactors=FALSE)
    }    
    else{ 
        foundingFathers <- fcnSummary$fun
        haveSons <- sapply(foundingFathers, 
                           function(x) { any(grepl(x, callSum$callers,
                                             fixed=TRUE)) })       
        offspringDF <- data.frame(Function = foundingFathers, 
                                  haveSons = haveSons, 
                                  total=fcnSummary$total, 
                                  self=fcnSummary$self,
                                  GC=fcnSummary$gc,
                                  GC.Self=fcnSummary$gcself,
                                  alloc=fcnSummary$alloc,
                                  allocself=fcnSummary$allocself,
                                  stringsAsFactors=FALSE)
    }
    if(!self.gc[1]) {
        offspringDF$self = NULL
        offspringDF$GC.Self = NULL
        offspringDF$allocself = NULL
    }
    if(!self.gc[2]) {
        offspringDF$GC = NULL
        offspringDF$GC.Self = NULL
    }
    if(!self.gc[3]) {
        offspringDF$alloc = NULL
        offspringDF$allocself = NULL
    }
    return(offspringDF)
}
                     
proftoolsGUI <- function(pd = NULL, method = c("gwidgets", "shiny"),
                     value = c("pct", "time", "hits"), self = FALSE, 
                     gc = TRUE, memory = FALSE, srclines = TRUE){
    value <- match.arg(value)
    if(method == "gwidgets")
        startWidget(pd, value, self, gc, memory, srclines)
    else if(method == "shiny")
        runShiny(pd, value, self, gc, memory, srclines)
}
                        
                        
startWidget <- function(pd = NULL, value = c("pct", "time", "hits"),
                        self = FALSE, gc = TRUE, memory = FALSE, srclines = TRUE,
                        maxdepth = 10, interval = NULL,
                        treeType="funSum", toolkit="RGtk2"){
    if (is.character(pd))
        pd <- readProfileData(pd)
    value <- match.arg(value)
    options(guiToolkit = toolkit)
    win <- gWidgets2::gwindow("Hot Path Tree", height=700, width=1000)
    ## Remove widgetMenu from previous session
    # if(exists("widgetMenu")) 
        # remove(widgetMenu, pos=.GlobalEnv)
    processWidget(pd, value, self, srclines, gc, memory, maxdepth, interval, treeType,
                  win)
}

attemptAnnot <- function(pd, value, gc, show=FALSE){
    tryCatch(srcAnnotate <- annotateSource(pd, value, gc, show=FALSE), 
             error = function(e) srcAnnotate <<- NULL,
             warning = function(w){srcAnnotate <<- NULL})
    srcAnnotate
}

processWidget <- function(pd, value = c("pct", "time", "hits"),
                          self = FALSE, srclines = TRUE, gc = TRUE, memory = FALSE,
                          maxdepth = 10, interval, treeType="funSum", win){
    group <- gWidgets2::ggroup(horizontal=FALSE,container=win)
    # we use if statement below to preserve the menu if it exists
    # if it does, we modify its svalue later
    if(is.null(attr(win, 'env')))
        attr(win, 'env') <- new.env()
    attr(win, 'env')$self.gc <- c(self, gc, memory)
    if(!is.null(pd)){
        buttonCont <- gWidgets2::ggroup(container=group)
        passedList <- list(pd=pd, value=value, self=self, srclines=srclines, 
                           gc=gc, memory = memory, maxdepth=maxdepth, interval=interval,
                           treeType=treeType, win=win, group=group)
        gWidgets2::glabel("Summary: ", container=buttonCont)
        SummaryView <- ifelse(treeType == "funSum", "Function", "Hot Paths")
        summaryCombo <- gWidgets2::gcombobox(c(SummaryView, "Function", "Hot Paths"), 
                                  container=buttonCont, handler=summaryHandler, 
                                  action=passedList)
        gWidgets2::size(summaryCombo) <- c(100, -1)
        gWidgets2::glabel("Units: ", container=buttonCont)
        units <- gWidgets2::gcombobox(c(value[1], "pct", "time", "hits"), container=buttonCont, 
                           handler=unitsHandler, action=passedList)
        gWidgets2::size(units) <- c(50, -1)
        checkBoxes <- c("self", "gc", "memory", "srclines"); checked=c(self,gc,memory,srclines)
        if(!pd$haveGC){
            checkBoxes <- checkBoxes[-2]
            checked <- checked[-2]
            gc <- FALSE
        }
        if(!pd$haveMem){
            checkBoxes <- checkBoxes[-3]
            checked <- checked[-3]
            memory <- FALSE
        }
        gWidgets2::gcheckboxgroup(checkBoxes, checked=checked, 
                                   container=buttonCont, horizontal=T,
                                   handler=checkHandler, action=passedList)
        addSpinners(pd, value, self, srclines, gc, memory, maxdepth, interval, treeType, win, group)
        spinnerCont <- gWidgets2::gpanedgroup(container=group)
        gWidgets2::ggroup(container=spinnerCont)
        spinnerGroup <- gWidgets2::ggroup(container=spinnerCont)
        gWidgets2::svalue(spinnerCont) <- .5
        gWidgets2::glabel("Max Nodes: ", container=spinnerGroup)
        maxnodes <- gWidgets2::gspinbutton(from=5, to=200, by=1, value=30, cont=spinnerGroup)
        gWidgets2::glabel("Drop Threshold: ", container=spinnerGroup)
        dropBelow <- gWidgets2::gspinbutton(from=0, to=99, by=1, value=0, cont=spinnerGroup)
        trimCallgraph <- gWidgets2::gbutton("Show trimmed Callgraph", cont=spinnerGroup)
        if(!is.null(interval))
            filteredPD <- filterProfileData(pd, interval = interval)
        else filteredPD <- pd
        srcAnnotate <- attemptAnnot(filteredPD, value, gc, show=FALSE); conf <- FALSE
        if(is.null(srcAnnotate))
            conf <- gWidgets2::gconfirm(paste0('Could not find source files in the ',
                                    'working directory, press OK to locate the', 
                                    ' directory with source files, or Cancel',
                                    ' to continue without source annotations.'), 
                             title="Source files not found", icon="warning")
        if(conf){
            directory <- gWidgets2::gfile(type="selectdir")
            setwd(directory)
            srcAnnotate <- attemptAnnot()
        }
        if(treeType=="funSum")
            funSumTree(filteredPD, value, self, srclines, gc, memory, srcAnnotate, 
                       maxnodes, dropBelow, trimCallgraph, win, group)
        else
            hotPathsTree(filteredPD, value, self, srclines, gc, memory, maxdepth, 
                         srcAnnotate, maxnodes, dropBelow, trimCallgraph, win, 
                         group)
        stats::update(win)
    }
    graphics::plot.new()
    plotProfileCallGraph(pd, style = google.style, maxnodes = gWidgets2::svalue(maxnodes),
                         total.pct = gWidgets2::svalue(dropBelow))
}

addSpinners <- function(pd, value = c("pct", "time", "hits"), self = FALSE, 
                      srclines = TRUE, gc = TRUE, memory = FALSE, maxdepth=10, interval, 
                      treeType, win, group){
    if(is.null(interval)) interval <- c(1, pd$total)
    spinnerCont <- gWidgets2::gframe(text = "Filter Selection", container=group, 
                         horizontal = FALSE)
    sCont <- gWidgets2::ggroup(container=spinnerCont)
    gWidgets2::glabel("Start: ", container=sCont)
    s1Handler <- function(h, ...){
        if(gWidgets2::svalue(s1) > gWidgets2::svalue(s2))
            gWidgets2::svalue(s1) <- gWidgets2::svalue(s2)
        interval <<- c(gWidgets2::svalue(s1), gWidgets2::svalue(s2))
    }
    s2Handler <- function(h, ...){
        if(gWidgets2::svalue(s2) < gWidgets2::svalue(s1))
            gWidgets2::svalue(s2) <- gWidgets2::svalue(s1)
        interval <<- c(gWidgets2::svalue(s1), gWidgets2::svalue(s2))
    }
    filterHandler <- function(h, ...){
        gWidgets2::delete(win, group)
        processWidget(pd, value, self, srclines, gc, memory, maxdepth, 
                      interval, treeType, win)
        
    }    
    s1 <- gWidgets2::gspinbutton(from=1, to=pd$total, by=1, value=interval[1], 
                  handler = s1Handler, cont=sCont)
    gWidgets2::glabel("Stop: ", container=sCont)
    s2 <- gWidgets2::gspinbutton(from=1, to=pd$total, by=1, value=interval[2], 
                  handler = s2Handler, cont=sCont) 
    gWidgets2::gbutton("Filter Selection", handler = filterHandler, 
                            cont=sCont)
}
# addMenu <- function(pd, value = c("pct", "time", "hits"), self = FALSE, 
                    # srclines = TRUE, gc = TRUE, maxdepth=10, interval, treeType, 
                    # win, group){
    # browseStack <- function(h, ...){
        # stackBrowse <- gWidgets2::gfile("Choose a Stack file", quote=FALSE, filter = 
                             # list("Stack files"=list(patterns=c("*.out", "*.txt"))))
        # pd <- readProfileData(stackBrowse)
        # stopIfEmpty(pd, group)
        # gWidgets2::delete(win, group)
        # processWidget(pd, value, self, srclines, gc, maxdepth, interval, 
                      # treeType, win)
    # }
    
    # browseR <- function(h, ...){
        # sourceBrowse <- gWidgets2::gfile("Source and profile an R file", quote=FALSE,
                              # filter = list("Stack files"=
                                            # list(patterns=c("*.R", "*.txt"))))
        # Rprof(tmp <- tempfile(), gc.profiling = TRUE, line.profiling = TRUE)
        # source(sourceBrowse)
        # Rprof(NULL)
        # pd <- readProfileData(tmp)
        # stopIfEmpty(pd, group)
        # gWidgets2::delete(win, group)
        # processWidget(filterProfileData(pd, focus = "source"), value, self,
                      # srclines, gc, maxdepth, interval, treeType, win)
        # unlink(tmp)
    # }    
    # profileRCode <- function(h, ...){
        # profileCode(pd, value, self, srclines, gc, maxdepth, NULL, treeType, win, group)
    # }    
    # mn <- list(); mn$File <- list();
    # mn$File[['Select a stack file']] <- gWidgets2::gaction("Select a stack file", 
                                                # handler=browseStack) 
    # mn$File[['Source an R file']] <- gWidgets2::gaction("Source an R file", handler=browseR)   
    # mn$File[['Profile some R code']] <- gWidgets2::gaction("Profile some R code", 
                                                # handler=profileRCode) 
    # if(!is.null(interval))
        # filteredPD <- filterProfileData(pd, interval = interval)
    # else filteredPD <- pd
    # mn$Plot <- list();
    # attr(win, 'env')$plotType <- 'plotCallgraph'
    # mn$Plot[['Plot Callgraph']] <- gWidgets2::gaction('Plot Callgraph', handler=function(h,...){
        # gWidgets2::visible(gg) <- TRUE
        # attr(win, 'env')$plotObj <- plotProfileCallGraph(filteredPD, style = google.style)
        # attr(win, 'env')$plotType <- 'plotCallgraph'
    # })
    # mn$Plot[['Plot Tree Map']] <- gWidgets2::gaction('Plot Tree Map', handler=function(h,...){
        # gWidgets2::visible(gg) <- TRUE
        # attr(win, 'env')$plotObj <- calleeTreeMap(filteredPD)
        # attr(win, 'env')$plotType <- 'plotTreemap'
    # })
    # mn$Plot[['Plot Flame Graph']] <- gWidgets2::gaction('Plot Flame Graph', handler=function(h,...){
        # gWidgets2::visible(gg) <- TRUE
        # attr(win, 'env')$plotObj <- flameGraph(filteredPD, order="hot")
        # attr(win, 'env')$plotType <- 'plotFlamegraph'
    # })
    # mn$Plot[['Plot Time Graph']] <- gWidgets2::gaction('Plot Time Graph', handler=function(h,...){
        # gWidgets2::visible(gg) <- TRUE
        # attr(win, 'env')$plotObj <- flameGraph(filteredPD, order="time")
        # attr(win, 'env')$plotType <- 'plotTimegraph'
    # }) 

        # trying the below was problematic because 'menu' object exists by default
        # if(exists("menu", envir = attr(win, 'env')))
        # gWidgets2::svalue(attr(win, 'env')$menu) <- mn
    # if(exists("m", envir = attr(win, 'env')))
        # gWidgets2::svalue(attr(win, 'env')$m) <- mn
    # else
        # attr(win, 'env')$m <- gmenu(mn, container=win)
# }
addMenu <- function(pd, value = c("pct", "time", "hits"), self = FALSE, 
                    srclines = TRUE, gc = TRUE, memory = FALSE, maxdepth=10, treeType, 
                    win, group, gg){
    browseStack <- function(h, ...){
        stackBrowse <- gWidgets2::gfile("Choose a Stack file", quote=FALSE, filter = 
                             list("Stack files"=list(patterns=c("*.out", "*.txt"))))
        pd <- readProfileData(stackBrowse)
        stopIfEmpty(pd, group)
        gWidgets2::delete(win, group)
        processWidget(pd, value, self, srclines, gc, memory, maxdepth, NULL, treeType, win)
    }
    
    browseR <- function(h, ...){
        sourceBrowse <- gWidgets2::gfile("Source and profile an R file", quote=FALSE,
                              filter = list("Stack files"=
                                            list(patterns=c("*.R", "*.txt"))))
        utils::Rprof(tmp <- tempfile(), gc.profiling = TRUE, line.profiling = TRUE, memory.profiling = memory)
        source(sourceBrowse)
        utils::Rprof(NULL)
        pd <- readProfileData(tmp)
        stopIfEmpty(pd, group)
        gWidgets2::delete(win, group)
        processWidget(filterProfileData(pd, focus = "source"), value, self,
                      srclines, gc, memory, maxdepth, NULL, treeType, win)
        unlink(tmp)
    }    
    profileRCode <- function(h, ...){
        profileCode(pd, value, self, srclines, gc, memory, maxdepth, NULL, treeType, win, group)
    }    
    mn <- list(); mn$File <- list();
    mn$File[['Select a stack file']] <- gWidgets2::gaction("Select a stack file", 
                                                handler=browseStack) 
    mn$File[['Source an R file']] <- gWidgets2::gaction("Source an R file", handler=browseR)   
    mn$File[['Profile some R code']] <- gWidgets2::gaction("Profile some R code", 
                                                handler=profileRCode) 

    mn$Plot <- list();
    attr(win, 'env')$plotType <- 'plotCallgraph'
    mn$Plot[['Plot Callgraph']] <- gWidgets2::gaction('Plot Callgraph', handler=function(h,...){
        gWidgets2::visible(gg) <- TRUE
        attr(win, 'env')$plotObj <- plotProfileCallGraph(pd, style = google.style)
        attr(win, 'env')$plotType <- 'plotCallgraph'
    })
    mn$Plot[['Plot Tree Map']] <- gWidgets2::gaction('Plot Tree Map', handler=function(h,...){
        gWidgets2::visible(gg) <- TRUE
        attr(win, 'env')$plotObj <- calleeTreeMap(pd)
        attr(win, 'env')$plotType <- 'plotTreemap'
    })
    mn$Plot[['Plot Flame Graph']] <- gWidgets2::gaction('Plot Flame Graph', handler=function(h,...){
        gWidgets2::visible(gg) <- TRUE
        attr(win, 'env')$plotObj <- flameGraph(pd, order="hot")
        attr(win, 'env')$plotType <- 'plotFlamegraph'
    })
    mn$Plot[['Plot Time Graph']] <- gWidgets2::gaction('Plot Time Graph', handler=function(h,...){
        gWidgets2::visible(gg) <- TRUE
        attr(win, 'env')$plotObj <- flameGraph(pd, order="time")
        attr(win, 'env')$plotType <- 'plotTimegraph'
    }) 

        # trying the below was problematic because 'menu' object exists by default
        # if(exists("menu", envir = attr(win, 'env')))
        # gWidgets2::svalue(attr(win, 'env')$menu) <- mn
    if(exists("m", envir = attr(win, 'env')))
        gWidgets2::svalue(attr(win, 'env')$m) <- mn
    else
        attr(win, 'env')$m <- gWidgets2::gmenu(mn, container=win)
}
profileCode <- function(pd, value = c("pct", "time", "hits"), self = FALSE, 
                        srclines = TRUE, gc = TRUE, memory = FALSE, maxdepth=10, interval,
                        treeType, win, group){
    codeWindow <- gWidgets2::gwindow("Profile R code", width=500, height=500)
    codeGroup <- gWidgets2::ggroup(horizontal=FALSE,container=codeWindow)
    profileText <- gWidgets2::gtext("## Enter some R code here to profile", 
                         container=codeGroup, wrap=FALSE, 
                         font.attr=list(family="monospace"), expand=TRUE, 
                         fill="both")
    btn <- gWidgets2::gbutton("Profile It", container=codeGroup)
    gWidgets2::addHandlerChanged(btn, handler = function(h, ...) {
        tmp1 <- paste(tempfile(), ".R", sep="")
        write(gWidgets2::svalue(profileText), file=tmp1)
        utils::Rprof(tmp <- tempfile(), gc.profiling = TRUE, line.profiling = TRUE, memory.profiling = memory)
        source(tmp1)
        utils::Rprof(NULL)
        pd <- readProfileData(tmp)
        stopIfEmpty(pd, group)
        mydepth <- length(sys.calls())
        pd <- proftools:::skipPD(pd, mydepth+4)
        gWidgets2::delete(win, group)
        gWidgets2::dispose(codeWindow)
        processWidget(pd, value, self, srclines, gc, memory, maxdepth, NULL, treeType,
                      win)
    })
}
# Give an error message if stack file is empty
stopIfEmpty <- function(pd, group){
    if(pd$total == 0){
        gWidgets2::gmessage('Your code produced a stack file of zero lines', title = "Error", 
                 icon = "error", parent=group)
        stop('Your code produced a stack file of zero lines')         
    }
}

prepareCallSum <- function(pd, byTotal = TRUE, value, srclines, gc, memory){
    callSum <- format(callSummary(pd, byTotal = TRUE, value, srclines, gc, memory))
    callerCallee <- do.call(rbind, strsplit(callSum[,1], " -> "))
    callSum <- cbind(callerCallee, callSum[,-1])
    names(callSum)[1:2] <- c("callers", "callees")
    callSum
    # callSumDF <- data.frame(row.names = 1:nrow(callSum))
    # 
    # callSumDF$callers <- callerCallee[,1]
    # callSumDF$callees <- callerCallee[,2]
    # callSum <- callSum[,2:ncol(callSum)]
    # class(callSum) <- "numeric"
    # callSumDF <- cbind(callSumDF, callSum)
    # callSumDF
}

prepareFcnSummary <- function(pd, byTotal = TRUE, value, srclines, gc, memory){
    fcnSumm <- format(funSummary(pd, byTotal = TRUE, value, srclines, gc, memory))
    fcnSumm[,1] <- trimws(fcnSumm[,1])
    names(fcnSumm)[1] <- "fun"
    fcnSumm
    # fcnSummary <- data.frame(row.names = 1:nrow(fcnSumm))
    # fcnSummary$fun <- fcnSumm[,1]
    # fcnSumm <- fcnSumm[,2:ncol(fcnSumm)]
    # class(fcnSumm) <- "numeric"
    # fcnSummary <- cbind(fcnSummary, fcnSumm)
    # fcnSummary
}

funSumTree <- function(pd, value = c("pct", "time", "hits"), self = FALSE, 
                       srclines = TRUE, gc = TRUE, memory = FALSE, srcAnnotate,maxnodes,
                       dropBelow, trimCallgraph, win, group){
    treeType <- "funSum"
    
    # callers <- paste0(callSum$caller, ifelse(is.na(callSum$caller.line), '', 
                                            # paste0(' ', '(', callSum$caller.file, 
                                                   # ':', callSum$caller.line, ')')))
    # callees <- paste0(callSum$callee, ifelse(is.na(callSum$callee.line), '', 
                                            # paste0(' ', '(', callSum$callee.file, 
                                                   # ':', callSum$callee.line, ')')))
    callSumDF <- prepareCallSum(pd, byTotal = TRUE, value, srclines, gc, memory)
    attr(win, 'env')$callSum <- fixSumDF(callSumDF, self, gc, value, memory)
    fcnSummary <- prepareFcnSummary(pd, byTotal = TRUE, value, srclines, gc, memory)
    attr(win, 'env')$fcnSummary <- fixSumDF(fcnSummary, self, gc, value, memory)
    gPane <- gWidgets2::gpanedgroup(horizontal=FALSE, container=group, expand=TRUE)
    g <- gWidgets2::gpanedgroup(container=gPane)
    treeCont <- gWidgets2::gframe(text="Function Summary", container=g, expand=TRUE)
    gg <- gWidgets2::ggraphics(container=g, expand=TRUE)
    gWidgets2::svalue(g) <- .5
    fcnAnnotCont <- gWidgets2::gframe(text="Function Annotations", container=gPane, 
                           expand=TRUE, fill="both")
    tree <- gWidgets2::gtree(offspring=offspringFunSum, offspring.data = win,
                  container=treeCont, expand=TRUE, fill="both")
    fcnAnnot <- gWidgets2::gtext("", container=fcnAnnotCont, wrap=FALSE,
                      font.attr=list(family="monospace"), expand=TRUE, 
                      fill="both")
    addMenu(pd, value, self, srclines, gc, memory, maxdepth=10, treeType, win, group, gg)
    addHandlers(tree, fcnAnnot, treeType, srcAnnotate, pd, maxnodes,
                dropBelow, trimCallgraph, gg, win)
}

hotPathsTree <- function(pd, value = c("pct", "time", "hits"), self = FALSE,
                         srclines = TRUE, gc = TRUE, memory = FALSE, maxdepth = 10, srcAnnotate,
                         maxnodes, dropBelow, trimCallgraph, win, group){
    treeType <- "hotPaths"
    attr(win, 'env')$offspringDF <- setOffspringDF(pd, value, self, srclines, gc, memory, maxdepth)
    gPane <- gWidgets2::gpanedgroup(horizontal=FALSE, container=group, expand=TRUE)
    g <- gWidgets2::gpanedgroup(container=gPane)
    treeCont <- gWidgets2::gframe(text="Hot Paths", container=g, expand=TRUE, 
                       fill="both")
    gg <- gWidgets2::ggraphics(container=g, expand=TRUE)
    gWidgets2::svalue(g) <- .5
    fcnAnnotCont <- gWidgets2::gframe(text="Function Annotations", container=gPane, 
                           expand=TRUE, fill="both")
    tree <- gWidgets2::gtree(offspring = offspring, offspring.data = win, 
                  container=treeCont, expand=TRUE, fill="both")
    fcnAnnot <- gWidgets2::gtext("", container=fcnAnnotCont, wrap=FALSE,
                      font.attr=list(family="monospace"), expand=TRUE, 
                      fill="both")
    addMenu(pd, value, self, srclines, gc, memory, maxdepth=10, treeType, win, group, gg)
    addHandlers(tree, fcnAnnot, treeType, srcAnnotate, pd, maxnodes,
                dropBelow, trimCallgraph, gg, win)
}

parseOffspring <- function(path, treetype, win, id=NULL){
    if(treetype == 'hotpaths') 
        offspringDF <- offspring(path, win)
    else offspringDF <- offspringFunSum(path, win)
    paste(sapply(1:nrow(offspringDF), parseSon, offspringDF, path, id, treetype, win), 
          collapse=",")
}
## gets function name without line info
getFname <- function(annotName){
    fcnName <- annotName
    hasLine <- regexpr("(", fcnName, fixed=T)
    if(hasLine[1]>0)
        fcnName <- substr(fcnName, 1, hasLine[1]-2)
    fcnName
}
## Matches a vector in a sequence
vecIn <- function(a,b){
    which(Reduce('+', lapply(seq_along(y <- lapply(b, '==', a)), 
                             function(x){
                                y[[x]][x:(length(a) - length(b) +x)]
                             })) == length(b))
} 
## this is old parseSon, uses hardcoded column names
parseSon <- function(i, offspringDF, path, id, treetype, win){
    if(length(path)) parent <- paste0(',"_parentId":', id)
    else parent <- NULL
    #parentID <- substr(id[1], 1, nchar(id[1])-1)
    newID <- paste0(length(path)+1,id,i)
    x <- paste("{\"id\":", newID, ",\"name\":\"", offspringDF$Function[i],
    "\",\"total\":\"", offspringDF$total[i], "\",\"self\":\"",
    offspringDF$self[i], "\",\"GC\":\"", offspringDF$GC[i], "\",\"GCself\":\"",
    offspringDF$GC.Self[i], "\"", parent, sep="")
    if(length(path) && (treetype == "funSum")){
        # lastTwo <- c(getFname(path[length(path)]), 
                     # getFname(as.character(offspringDF$Function[i])))
        # makeSons <- !(any(as.logical(lapply(cycles, vecIn, lastTwo)), na.rm=TRUE) 
                      # || (lastTwo[1] == lastTwo[2]) 
                      # || (length(path) >= 2))
        makeSons <- !(length(path) >= 2)
    }
    else
        makeSons <- TRUE
    if(offspringDF$haveSons[i] && makeSons)
        x <- paste(x, "},",
                   parseOffspring(c(path, as.character(offspringDF$Function[i]))
                                  , treetype, win, newID))
    else
        x <- paste(x,"}")
    x
}
parseSon <- function(i, offspringDF, path, id, treetype, win){
    if(length(path)) parent <- paste0(',"_parentId":', id)
    else parent <- NULL
    #parentID <- substr(id[1], 1, nchar(id[1])-1)
    newID <- paste0(length(path)+1,id,i)
    fieldNames <- names(offspringDF)
    fields <- paste(sapply(fieldNames, 
                           function(x) paste0('"',x,'":"', offspringDF[[x]][i], '"')),
                    collapse = ",")
                    
    fields <- paste('{"id":', newID, ',', fields, parent)
    if(length(path) && (treetype == "funSum")){
        # lastTwo <- c(getFname(path[length(path)]), 
                     # getFname(as.character(offspringDF$Function[i])))
        # makeSons <- !(any(as.logical(lapply(cycles, vecIn, lastTwo)), na.rm=TRUE) 
                      # || (lastTwo[1] == lastTwo[2]) 
                      # || (length(path) >= 2))
        makeSons <- !(length(path) >= 2)
    }
    else
        makeSons <- TRUE
    if(offspringDF$haveSons[i] && makeSons)
        fields <- paste(fields, ',"state":"closed"},',
                   parseOffspring(c(path, as.character(offspringDF$Function[i]))
                                  , treetype, win, newID))
    else
        fields <- paste(fields,"}")
    fields
}
generateJSON <- function(pd, path, winHotpaths, winFunsum){
    # cycles <- profileDataCycles(pd, TRUE)
    # cycles <<- lapply(cycles, function(x) c(x, x[1]))
    write(c("{\"rows\":[",parseOffspring(c(), 'hotpaths', winHotpaths),"]}"), 
          file.path(path, "tempDir", "hotpaths.JSON"))         
    write(c("{\"rows\":[",parseOffspring(c(), 'funSum', winFunsum),"]}"), 
          file.path(path, "tempDir", "funsum.JSON")) 
}

shinyPD <- local({
    pd <- NULL
    function(new) {
        if (! missing(new))
            pd <<- new
        pd
    }
})
arg <- local({
    arg <- NULL
    function(new) {
        if (! missing(new))
            arg <<- new
        arg
    }
})
shinyFilename <- local({
    shinyFilename <- NULL
    function(new) {
        if (! missing(new))
            shinyFilename <<- new
        shinyFilename
    }
})


runShiny <- function(pd, value = c("pct", "time", "hits"),
                     self = FALSE, gc = TRUE, memory = FALSE, srclines = TRUE,
                     maxdepth = 10){
    value <- match.arg(value)
    if(!pd$haveMem) memory <- FALSE 
    if(!pd$haveGC) gc <- FALSE 
    
    pd$files <- normalizePath(pd$files)
    shinyPD(pd)
    arg(list(self, gc, memory, value, srclines))
    # srcAnnotate <<- annotateSource(pd, value, gc, show=FALSE)
    # cols <- c("<th field=\"self\" width=\"150\">Self</th>",
              # "<th field=\"GC\" width=\"150\">GC</th>",
              # "<th field=\"GCself\" width=\"150\">GC.Self</th>")
    # if(!gc)
        # cols[2:3] <- ""
    # if(!self)
        # cols[c(1,3)] <- ""
    path <- system.file("appdir", package="proftoolsGUI")
    #path <- "C:/Users/Big-Rod/Documents/GitHub/Rpkg-proftools-GUI/inst/appdir"
    # index <- readLines(file.path(path, "www", "index.html"))
    # index[288] <- paste0('  <option value="', value, '" selected>', value, '</option>')
    # checked <- ifelse(c(self, gc), rep(' checked', 2), c('', ''))
    # index[293:295] <- paste0(c('<input id="total" type="hidden" name="count" value="',
                               # '<input id="self" type="checkbox" name="self" value="1"',
                               # '<input id="gc" type="checkbox" name="gc" value="1" '),
                             # c(pd$total, checked), c('">', '> Self', '> GC'))
    # write(index,file.path(path, "www", "index.html"))
    winHotpaths <- winFunsum <- c(1)
    attr(winHotpaths, 'env') <- attr(winFunsum, 'env') <- new.env()
    attr(winHotpaths, 'env')$self.gc <- attr(winFunsum, 'env')$self.gc <- c(self, gc, memory)
    attr(winHotpaths, 'env')$offspringDF <- setOffspringDF(pd, value, self, srclines=TRUE, 
                                                           gc, memory, maxdepth=10)
    # callSum <- callSummary(pd, byTotal = TRUE, value, srclines=TRUE, gc)
    # callSum$fun <- paste(" ", callSum$fun, sep="")
    callSumDF <- prepareCallSum(pd, byTotal = TRUE, value, srclines, gc, memory)
    attr(winFunsum, 'env')$callSum <- fixSumDF(callSumDF, self, gc, value, memory)
    fcnSummary <- prepareFcnSummary(pd, byTotal = TRUE, value, srclines, gc, memory)
    attr(winFunsum, 'env')$fcnSummary <- fixSumDF(fcnSummary, self, gc, value, memory) 
    tempDir <- tempdir()
    dir.create(file.path(tempDir, "tempDir"), showWarnings = FALSE)
    shiny::addResourcePath("tempDir", file.path(tempDir, "tempDir"))
    generateJSON(pd, tempDir, winHotpaths, winFunsum)
    shiny::runApp(path)
}

prepareShiny <- function(pd, value = c("pct", "time", "hits"),
                     self = FALSE, gc = TRUE, memory = FALSE, srclines = TRUE,
                     maxdepth = 10){
    value <- match.arg(value)
    if(!pd$haveMem) memory <- FALSE 
    if(!pd$haveGC) gc <- FALSE 
    
    pd$files <- normalizePath(pd$files)
    shinyPD(pd)
    arg(list(self, gc, memory, value, srclines))
    # srcAnnotate <<- attemptAnnot(pd, value, gc, show=FALSE)
    # cols <- c("<th field=\"self\" width=\"150\">Self</th>",
              # "<th field=\"GC\" width=\"150\">GC</th>",
              # "<th field=\"GCself\" width=\"150\">GC.Self</th>")
    # if(!gc)
        # cols[2:3] <- ""
    # if(!self)
        # cols[c(1,3)] <- ""
    # path <- system.file("appdir", package="proftoolsGUI")
    #path <- "C:/Users/Big-Rod/Documents/GitHub/Rpkg-proftools-GUI/inst/appdir"
    # index <- readLines(file.path(path, "www", "index.html"))
    # index[288] <- paste0('  <option value="', value, '" selected>', value, '</option>')
    # checked <- ifelse(c(self, gc), rep(' checked', 2), c('', ''))
    # index[293:295] <- paste0(c('<input id="total" type="hidden" name="count" value="',
                               # '<input id="self" type="checkbox" name="self" value="1"',
                               # '<input id="gc" type="checkbox" name="gc" value="1" '),
                             # c(pd$total, checked), c('">', '> Self', '> GC'))
    # write(index,file.path(path, "www", "index.html"))
    winHotpaths <- winFunsum <- c(1)
    attr(winHotpaths, 'env') <- attr(winFunsum, 'env') <- new.env()
    attr(winHotpaths, 'env')$self.gc <- attr(winFunsum, 'env')$self.gc <- c(self, gc, memory)
    attr(winHotpaths, 'env')$offspringDF <- setOffspringDF(pd, value, self, srclines=TRUE, 
                                                           gc, memory, maxdepth=10)
    # callSum <- callSummary(pd, byTotal = TRUE, value, srclines=TRUE, gc)
    # callSum$fun <- paste(" ", callSum$fun, sep="")
    callSumDF <- prepareCallSum(pd, byTotal = TRUE, value, srclines, gc, memory)
    attr(winFunsum, 'env')$callSum <- fixSumDF(callSumDF, self, gc, value, memory)
    fcnSummary <- prepareFcnSummary(pd, byTotal = TRUE, value, srclines, gc, memory)
    attr(winFunsum, 'env')$fcnSummary <- fixSumDF(fcnSummary, self, gc, value, memory) 
    tempDir <- tempdir()
    dir.create(file.path(tempDir, "tempDir"), showWarnings = FALSE)
    shiny::addResourcePath("tempDir", file.path(tempDir, "tempDir"))
    generateJSON(pd, tempDir, winHotpaths, winFunsum)
}

outputAnnot <- function(output, fcnAnnot = NULL, font.attr = NULL, where = 'end'){
    ## Below runs only if Shiny, since fcnAnnot (which is the annotion textbox)
    ## will be null in this case    
    if(is.null(fcnAnnot))
        if(is.null(font.attr))
            cat('<br />', paste(output, collapse='<br />'), sep='')
        else
            cat('<br />', paste('<span id="selectedLine" class="red">', 
                                paste(output, collapse='<br />'),
                                '</span>',sep=''), sep='')
    else
        gWidgets2::insert(fcnAnnot, output, font.attr = font.attr, where = where)
}
# annotName is the name along with possible line info, fcnName strips those
functionAnnotate <- function(fcnName, annotName, path, srcAnnotate, fileName, 
                             lineNumber, treeType, fcnAnnot, win){
    ## fileName used in Shiny
    # fileName <<- NULL
    if(is.null(srcAnnotate)) {
        outputAnnot("R file could not be found in the working directory", fcnAnnot)
        return()
    }
    fcnAnnotate <- functionAnnotation(fcnName, srcAnnotate, fileName, lineNumber,
                                      fcnAnnot)
    # Can't find function annotation or code, try the same for its first child                                  
    if(is.null(fcnAnnotate) && (length(path) > 1)){
        if(treeType=="hotPaths")
            siblingsDF <- offspring(path[-length(path)], win) 
        else siblingsDF <- offspringFunSum(path[-length(path)],win)
        fcnDF <- siblingsDF[siblingsDF$Function==annotName,]
        if(fcnDF$haveSons){
            if(treeType=="hotPaths")
                sonsDF <- offspring(path, win)
            else sonsDF <- offspringFunSum(path, win)
            for(i in 1:nrow(sonsDF)){
                fcnInfo <- parseLineInfo(as.character(sonsDF$Function[i]),
                                         srcAnnotate)
                fcnAnnotate <- unlist(lapply(fcnInfo$fcnName, functionAnnotation,
                                             srcAnnotate, fcnInfo$fileName, 
                                             fcnInfo$lineNumber, fcnAnnot))
                if(!is.null(fcnAnnotate)){
                    return(invisible(TRUE))
                }    
            }
            outputAnnot("Selected Function has no available annotations", fcnAnnot)
        }
        else
            outputAnnot("Selected Function has no available annotations", fcnAnnot)
    }
}
functionAnnotation <- function(fcnName, srcAnnotate, fileName, lineNumber, 
                               fcnAnnot){
    if(length(fileName)){
        # Not needed for now
        # x <- srcAnnotate[[fileName]][lineNumber]
        fileEnd <- length(srcAnnotate[[fileName]])
        ends <- min(lineNumber+7, fileEnd)
        if(lineNumber != 1)
            outputAnnot(srcAnnotate[[fileName]][1:(lineNumber-1)],fcnAnnot)
        outputAnnot(srcAnnotate[[fileName]][lineNumber], fcnAnnot, 
                    font.attr=list(color="red"))
        if(lineNumber != ends)
            outputAnnot(srcAnnotate[[fileName]][(lineNumber+1):ends], fcnAnnot)
        if(ends != fileEnd)
            outputAnnot(srcAnnotate[[fileName]][(ends+1):fileEnd], 
                        fcnAnnot=fcnAnnot, where="at.cursor")
        return(TRUE)
    }
    else{
        unlist(lapply(seq_along(srcAnnotate), findFunction, fcnName, fcnAnnot, srcAnnotate))
    }
}

findFunction <- function(i, fcnName, fcnAnnot, srcAnnotate){
    srcCode <- srcAnnotate[[i]]
    defineFcns <- grep("function", srcCode, fixed=T)
    haveFcn <- grep(paste("[[:blank:]]+", 
                          sub(".", "\\.", fcnName, fixed=T), 
                          "[[:blank:]]*(<-|=)[[:blank:]]*function", 
                          sep=""), srcCode[defineFcns])
    if(length(haveFcn)){
        # Not needed for now
        # x <- srcCode[defineFcns[haveFcn]]
        lineNumber <- defineFcns[haveFcn]
        fileEnd <- length(srcCode)
        ends <- min(lineNumber+7, fileEnd)
        if(lineNumber != 1)
            outputAnnot(srcCode[1:(lineNumber-1)], fcnAnnot)
        outputAnnot(srcCode[lineNumber], fcnAnnot, 
                    font.attr=list(color="red"))
        if(lineNumber != ends)
            outputAnnot(srcCode[(lineNumber+1):ends], fcnAnnot)
        if(ends != fileEnd)
            outputAnnot(srcCode[(ends+1):fileEnd], fcnAnnot=fcnAnnot,
                        where="at.cursor")
        ## fileName used in Shiny
        shinyFilename(names(srcAnnotate)[i])
        return(TRUE)
    }
    else{
        shinyFilename(NULL)
        NULL
    }
        
}
parseLineInfo <- function(fcnName, srcAnnotate){
    hasLine <- regexpr("(", fcnName, fixed=T)
    if(hasLine[1]>0){
        lineProf <- unlist(strsplit(substr(fcnName, hasLine[1]+1, 
                                           nchar(fcnName)-1), ":", fixed=T))
        fileName <- lineProf[1]
        fileName <- grep(fileName, names(srcAnnotate), value=TRUE, fixed=TRUE)
        lineNumber <- as.numeric(lineProf[2])
        fcnName <- substr(fcnName, 1, hasLine[1]-2)
    }
    else{
        fileName <- lineNumber <- NULL
    }
    list(fcnName=fcnName,lineNumber=lineNumber,fileName=fileName)
}

addHandlers <- function(tree, fcnAnnot, treeType, srcAnnotate, pd, maxnodes,
                       dropBelow, trimCallgraph, gg, win){
    fcnNameRClick <- NULL
    gWidgets2::addHandlerClicked(tree, handler=function(h,...) {
        gWidgets2::visible(gg) <- TRUE
        fcnAnnot <- h$action
        path <- gWidgets2::svalue(h$obj, drop=FALSE)
        if(length(path) == 0){
            plotProfileCallGraph(pd, style = google.style)
            return(FALSE)
        }
        annotName <- path[length(path)]
        parseLine <- parseLineInfo(annotName, srcAnnotate)
        fcnNameRClick <<- parseLine$fcnName
        do.call(attr(win, 'env')$plotType, list())
        gWidgets2::svalue(fcnAnnot) <- ''
        functionAnnotate(parseLine$fcnName, annotName, path, 
                         srcAnnotate, parseLine$fileName, 
                         parseLine$lineNumber, treeType, fcnAnnot, win)
    }, action=fcnAnnot)
    gWidgets2::addHandlerClicked(gg, handler=function(h,...) {
        if(attr(win, 'env')$plotType != 'plotCallgraph'){
            p <- attr(win, 'env')$plotObj
            idx <- which(h$x >= p$left & h$x <= p$right &
                         h$y >= p$bottom & h$y <= p$top)
            if (length(idx) > 0) 
                if(attr(win, 'env')$plotType == 'plotTreemap'){
                    # we skip the first element because it's empty
                    len <- length(p$label[idx])
                    if(len < 12)
                        gWidgets2::tooltip(h$obj) <- p$label[idx][-1]
                    else
                        gWidgets2::tooltip(h$obj) <- c(p$label[idx][2:6], "...",
                                            p$label[idx][(len-4):len])
                }
                else
                    gWidgets2::tooltip(h$obj) <- p$label[idx]
        }
        

    })
    plotCallgraph <- function(h, ...){
        filtered <- filterProfileData(pd, focus = fcnNameRClick)
        plotProfileCallGraph(filtered, style = google.style,
                             maxnodes = gWidgets2::svalue(maxnodes), 
                             total.pct = gWidgets2::svalue(dropBelow))
        attr(win, 'env')$plotType <- 'plotCallgraph'        
    }
    plotTreemap <- function(h, ...){
        filtered <- filterProfileData(pd, focus = fcnNameRClick)
        attr(win, 'env')$plotObj <- calleeTreeMap(filtered)    
        attr(win, 'env')$plotType <- 'plotTreemap'        
    }
    plotFlamegraph <- function(h, ...){
        filtered <- filterProfileData(pd, focus = fcnNameRClick)
        attr(win, 'env')$plotObj <- flameGraph(filtered, order="hot")
        attr(win, 'env')$plotType <- 'plotFlamegraph'
    }
    plotTimegraph <- function(h, ...){
        filtered <- filterProfileData(pd, focus = fcnNameRClick)
        attr(win, 'env')$plotObj <- flameGraph(filtered, order="time")
        attr(win, 'env')$plotType <- 'plotTimegraph'        
    }
    gWidgets2::addHandlerClicked(trimCallgraph, plotCallgraph)
    ml <- list()
    ml[['Plot Callgraph']] <- gWidgets2::gaction('Plot Callgraph', handler=plotCallgraph)
    ml[['Plot Tree Map']] <- gWidgets2::gaction('Plot Tree Map', handler=plotTreemap)    
    ml[['Plot Flamegraph']] <- gWidgets2::gaction('Plot Flamegraph', handler=plotFlamegraph)
    ml[['Plot Timegraph']] <- gWidgets2::gaction('Plot Timegraph', handler=plotTimegraph)    
    gWidgets2::addRightclickPopupMenu(tree,menulist=ml)
}
summaryHandler <- function(h, ...){
    summaryView <- ifelse(gWidgets2::svalue(h$obj) == "Function", "funSum", "hotPaths")
    gWidgets2::delete(h$action$win, h$action$group)
    processWidget(h$action$pd, h$action$value, h$action$self, h$action$srclines, 
                  h$action$gc,h$action$memory, h$action$maxdepth, h$action$interval, summaryView, h$action$win)
}
unitsHandler <- function(h, ...){
    value <- gWidgets2::svalue(h$obj)
    gWidgets2::delete(h$action$win, h$action$group)
    processWidget(h$action$pd, value, h$action$self, h$action$srclines, 
                  h$action$gc, h$action$memory, h$action$maxdepth, h$action$interval, h$action$treeType, h$action$win)
}
checkHandler <- function(h, ...){
    self.gc <- c("self", "gc", "memory", "srclines") %in% gWidgets2::svalue(h$obj)
    gWidgets2::delete(h$action$win, h$action$group)
    processWidget(h$action$pd, h$action$value, self.gc[1], self.gc[4],
                  self.gc[2], self.gc[3], h$action$maxdepth, h$action$interval, h$action$treeType, h$action$win)
}
file.choose2 <- function(...) {
  pathname <- NULL;
  tryCatch({
    pathname <- file.choose();
  }, error = function(ex) {
  })
  pathname;
}
myShiny <- function(input, output, session) {
# shiny::observe({
    # insertUI(
      # selector = "#uploadHolder",
      # where = "beforeBegin",
      # ui = fileInput(paste0("uploadStack", input$self), "Upload Stack File", multiple = FALSE, accept = ".Rprof", 
                     # buttonLabel = "Browse...", placeholder = "No file selected")
    # )
# })


    pdFun <- shiny::reactive({
        if(!is.null(input$uploadStack)){
            pdTemp <- readProfileData(input$uploadStack$datapath)
            cat(input$uploadStack$datapath)
            prepareShiny(pdTemp)
            pdTemp
        }
        else shinyPD()
    })
    arg <- arg()
    filtered <- shiny::reactive({
        pd <- pdFun()
        if(input$sliderLower != '')
            filterProfileData(pd, interval = c(input$sliderLower, input$sliderUpper))
        else
            pd
    })
    shiny::observe({
        pd <- pdFun()
        session$sendCustomMessage(type = 'have', 
                                  message = list(haveMem = as.numeric(pd$haveMem),
                                                 haveGC = as.numeric(pd$haveGC),
                                                 self = as.numeric(arg[[1]]),
                                                 gc = as.numeric(arg[[2]]),
                                                 memory = as.numeric(arg[[3]]),
                                                 value = arg[[4]],
                                                 srclines = arg[[5]],
                                                 total = pd$total))
    })
    dataInput <- shiny::reactive({
        filteredPD <- filtered()
        winHotpaths <- winFunsum <- c(1)
        if(is.null(input$ready)){
            self <- arg[[1]]
            gc <- arg[[2]]
            memory <- arg[[3]]
            value <- arg[[4]]
            srclines <- arg[[5]]
        }
        else{
            self <- input$self
            gc <- input$gc
            memory <- input$memory
            value <- input$value
            srclines <- ifelse(input$srcLines==1, TRUE, FALSE)
        }
        attr(winHotpaths, 'env') <- attr(winFunsum, 'env') <- new.env()
        attr(winHotpaths, 'env')$self.gc <- attr(winFunsum, 'env')$self.gc <- c(self, gc, memory)
        attr(winHotpaths, 'env')$offspringDF <- setOffspringDF(filteredPD, value, self, srclines=srclines, gc, memory, maxdepth=10)
        callSumDF <- prepareCallSum(filteredPD, byTotal = TRUE, value, srclines=srclines, gc, memory)
        attr(winFunsum, 'env')$callSum <- fixSumDF(callSumDF, self, gc, value, memory)
        fcnSummary <- prepareFcnSummary(filteredPD, byTotal = TRUE, value, srclines=srclines, gc, memory)
        attr(winFunsum, 'env')$fcnSummary <- fixSumDF(fcnSummary, self, gc, value, memory) 
        list(winHotpaths = winHotpaths, winFunsum = winFunsum)
    })
    
    srcAnnotate <- shiny::reactive({
        filteredPD <- filtered()
        if(nchar(input$value))
            temp <- annotateSource(filteredPD, input$value, input$gc, show=FALSE)
        temp
    })
    
    shiny::observe({
        filteredPD <- filtered()
        # path <- system.file("appdir", package="proftoolsGUI")
        #path <- "C:/Users/Big-Rod/Documents/GitHub/Rpkg-proftools-GUI/inst/appdir"
        wins <- dataInput()
        generateJSON(filteredPD, file.path(tempdir()), wins$winHotpaths, 
                     wins$winFunsum)
        session$sendCustomMessage(type = 'updateTable', 
                                  message = list(value = input$value))
    })

    shiny::observe({
        session$sendCustomMessage(type = 'tickBox', 
                                  message = list(self = input$self,
                                                 gc = input$gc,
                                                 memory = input$memory))
    })
    
    output$fileChoose <- shiny::renderPrint({ cat(input$uploadStack$datapath) })
    
    session$onSessionEnded(function() {
        shiny::stopApp()
    })
    shiny::observe({
        if(input$closing == 'closing')
            shiny::stopApp()
    })
    fName <- shiny::reactive({
        if(nchar(input$fcnName))
            fileName <- shinyFilename()
        fileName
    })
    output$fcnAnnot <- shiny::renderPrint({
        if(nchar(input$fcnName)){
            ## get srcAnnotate from reactive expression
            srcAnnotate <- srcAnnotate()
            path <- rev(unlist(strsplit(input$fcnName, ",", fixed = TRUE)))
            parseLine <- parseLineInfo(path, srcAnnotate)
            if(input$treeType == 'hotpaths')
                win <- dataInput()$winHotpaths
            else
                win <- dataInput()$winFunsum
            functionAnnotate(parseLine$fcnName, path[length(path)], path,
                             srcAnnotate, parseLine$fileName, 
                             parseLine$lineNumber, "hotPaths", NULL, win)
            if(!is.null(parseLine$fileName))
                shinyFilename(parseLine$fileName)
            cat()
            session$sendCustomMessage(type = 'scrollAnnot', message = list())
        }
    })
    
    output$fileName <- shiny::renderPrint({
        if(nchar(input$fcnName)){
            fileName <- fName()
            cat(paste('File: ', fileName))
        }
        else
            cat('File: ')
    })
    
    plotObj <- NULL
    output$labelObj <- shiny::renderPrint({
        if(input$plotType != 'plotCallgraph'){
            p <- plotObj
            idx <- which(input$plot_hover$x >= p$left & input$plot_hover$x <= p$right &
                         input$plot_hover$y >= p$bottom & input$plot_hover$y <= p$top)
            if (length(idx) > 0) 
                if(input$plotType == 'plotTreemap'){
                    # we skip the first element because it's empty
                    len <- length(p$label[idx])
                    if(len < 12)
                        cat(paste(p$label[idx][-1], "<br />"))
                    else
                        cat(paste(c(p$label[idx][2:6], "...",
                                            p$label[idx][(len-4):len]), "<br />"))
                }
                else
                    cat(p$label[idx])
        }
    })    
    output$plot <- shiny::renderPlot({
        maxNodes <- as.numeric(input$maxNodes)
        dropBelow <- as.numeric(input$dropBelow)
        filteredPD <- filtered()
        if(nchar(input$fcnName)){
            ## get srcAnnotate from reactive expression
            srcAnnotate <- srcAnnotate()
            path <- rev(unlist(strsplit(input$fcnName, ",", fixed = TRUE)))
            parseLine <- parseLineInfo(path[length(path)], srcAnnotate)
            filtered <- filterProfileData(filteredPD, focus = parseLine$fcnName)
            if(input$plotType == 'plotCallgraph')
                plotProfileCallGraph(filtered, style = google.style,
                                     maxnodes = maxNodes,
                                     total.pct = dropBelow)
            else if(input$plotType == 'plotTreemap')
                plotObj <<- calleeTreeMap(filtered)
            else if(input$plotType == 'plotFlamegraph')
                plotObj <<- flameGraph(filtered, order="hot")
            else if(input$plotType == 'plotTimegraph')
                plotObj <<- flameGraph(filtered, order="time")
        }
        else if(input$plotType == 'plotCallgraph')
            plotProfileCallGraph(filteredPD, style = google.style, 
                                 maxnodes = maxNodes,
                                 total.pct = dropBelow)
        else if(input$plotType == 'plotTreemap')
            plotObj <<- calleeTreeMap(filteredPD)
        else if(input$plotType == 'plotFlamegraph')
            plotObj <<- flameGraph(filteredPD, order="hot")
        else if(input$plotType == 'plotTimegraph')
            plotObj <<- flameGraph(filteredPD, order="time")
  })    

}

GUIGadget <- function(){
    path <- system.file("appdir", package="proftoolsGUI")
    # if(.Platform$OS.type == 'unix'){
        # profDir <- '~/.rstudio-desktop/profiles-cache/'
    # } 
    # else {
        # profDir <- paste0(Sys.getenv("USERPROFILE"), '\\AppData\\Local\\RStudio-Desktop\\profiles-cache')
    # }
    profDir <- options("profvis.prof_output")$profvis.prof_output
    stackFiles <- list.files(profDir,pattern="*.Rprof")
    if(length(stackFiles) > 0){
        details = file.info(paste0(profDir, .Platform$file.sep, stackFiles))
        details = details[order(as.POSIXct(details$mtime), decreasing = TRUE), ]
        files = rownames(details)
        files <- files[1]
        pd <- readProfileData(files)
    }
    else pd <- readProfileData(system.file("samples", "Rprof-lmfit-mem.out", package = "proftoolsGUI"))
    prepareShiny(pd)
    shiny::runGadget(shiny::shinyAppDir(path),
                     viewer = shiny::browserViewer())
}
# Always keep an empty final line or annotateSource will break