shiny-lib: Keboola Shiny Library

#' This is the configuration component library for managing app data loading / saving
#'
#' @import methods
#' @import shiny
#' @field session 
#' @field client Storage API client.
#' @field db Redshift driver connection.
#' @field bucket Bucket Id.
#' @field runId Run Id
#' @field lastSaveValue TODO
#' @field lastTable TODO
#' @field maxMemory TODO
#' @field sourceData TODO
#' @field memoryUsage TODO
#' @field loadList TODO 
#' @field allLoaded TODO 
#' @export KeboolaAppData
#' @exportClass KeboolaAppData
KeboolaAppData <- setRefClass(
    'KeboolaAppData',
    fields = list(
        session = 'ANY', # shiny server session
        client = 'ANY', # keboola.sapi.r.client::SapiClient
        db = 'ANY', # keboola.redshift.r.client::RedshiftDriver
        bucket = 'character',
        runId = 'character',
        lastSaveValue = 'numeric',
        lastTable = 'character', # last table loaded from SAPI 
        maxMemory = 'numeric', #maximum allowed table size in bytes
        sourceData = 'list', # Where we have the source data
        memoryUsage = 'numeric', 
        loadList = 'list',
        allLoaded = 'logical'
    ),
    methods = list(
        initialize = function(sapiClient, appConfig, dbConnection, maxMemory = 500000000, session = getDefaultReactiveDomain()) {
            "Constructor.
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{sapiClient} Storage API client.}
            \\item{\\code{bucketId} Bucket where config table is stored.}
            \\item{\\code{run_id} The runId of the data to load.}
            \\item{\\code{dbConnection} An established database connection.}
            \\item{\\code{maxMemory} Maximum sourceData memory allocation.}
            }}"
            if (is.null(client)) {
                stop("Can not initialize KeboolaAppData.  No valid Sapi Client.")
            }
            
            if (!inherits(session, "ShinySession"))
                stop("'session' is not a ShinySession object.")
            
            session <<- session
            
            client <<- sapiClient 
            bucket <<- appConfig$bucket
            if (is.null(appConfig$runId)) {
                runId <<- ''
            } else {
                runId <<- appConfig$runId        
            }
            lastTable <<- ''
            lastSaveValue <<- 0
            db <<- dbConnection
            maxMemory <<- maxMemory
            sourceData <<- list()
            memoryUsage <<- 0
            loadList <<- list()
            allLoaded <<- FALSE
        },
        
        loadTable = function(prettyName, table) {
            "Internal method to retrieve table data from Redshift 
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{prettyName} Table name to be used in labels throughout the app.}
            \\item{\\code{table} Name of table in SAPI.}
            }}
            \\subsection{Return Value}{data.frame with table data.}"
            print(paste("loading table ", prettyName, table))
            session$sendCustomMessage(
                type = "updateProgress",
                message = list(
                    id=paste0(table,"_progress"), 
                    parentId="data_retrieval",
                    text=paste("Retrieving", prettyName, "table."), value="In Progress", valueClass="text-primary"))
            
            lastTable <<- paste0("\"", .self$bucket, "\".\"", table, "\"")
            opts <- NULL
            
            if (nchar(.self$runId) > 0) {
                print("loading runid included table")
                sourceData[[prettyName]] <<- .self$db$select(paste0("SELECT * FROM ", .self$lastTable, " WHERE ", .self$lastTable, ".\"run_id\" = ?;"), .self$runId)
            } else {
                sourceData[[prettyName]] <<- .self$db$select(paste0("SELECT * FROM ", .self$lastTable))
            }    
            session$sendCustomMessage(
                type = "updateProgress",
                message = list(
                    id=paste0(table,"_progress"),
                    parentId="data_retrieval",
                    text=paste("Retrieving", prettyName, "table."), value="Completed", valueClass="text-success"))
            
        },
        
        getRecipeTables = function(options) {
            "TODO
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{options} List of options to pass on to the loadTables method.}
            }}
            \\subsection{Return Value}{List of tables. each element has required name, and optional reducible.}"
            query <- paste0("SELECT * FROM \"", .self$bucket, "\".\"finalResults\" WHERE \"", .self$bucket, "\".\"finalResults\".\"item_type\" = 'table' AND \"", .self$bucket, "\".\"finalResults\".\"value\" != '';")
            print(paste("getRecipeTable Query", query))
            tablesList <- .self$db$select(query)    
            tables <- list()
            for (i in 1:nrow(tablesList)) {
                tables[[tablesList[i, c("item")]]] <- list(name = tablesList[i,c("value")])
                if (!is.null(options$irReducibles) && tablesList[i, "value"] %in% options$irReducibles) {
                    tables[[tablesList[i, "item"]]][[reducible]] = TRUE
                }
            }
            # return the table list
            tables
        },
        
        loadTables = function(tables, options = list(cleanData = FALSE, description = FALSE)) {
            "Load tables from SAPI.
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{tables} List of tables key as R variable, value as table name (without bucket).}
            \\item{\\code{options} List with items:
            cleanData boolean TRUE to compute datatypes of cleanData table
            description boolean TRUE to include descriptor in returned dataSet.}
            }}
            \\subsection{Return Value}{List of data indexed by variable name given in tables argument keys.}"
            print(tables)
            tryCatch({
                for (name in names(tables)) {
                    print(paste("loading table", name))
                    loadTable(name,tables[[name]]$name)
                    print(paste("loaded table", name))
                }
                # Apply data type setting if the cleandata columns are present and the option is set
                if (options$cleanData && c("cleanTable", "columnTypes") %in% names(tables)) {
                    sourceData$columnTypes <<- .self$sourceData$columnTypes[,!names(.self$sourceData$columnTypes) %in% c("run_id")]
                    sourceData$cleanData <<- .self$getCleanData(.self$sourceData$columnTypes, .self$sourceData$cleanTable)
                }
                
                # Retrieve descriptor if option is set
                if (options$description) {
                    sourceData$descriptor <<- .self$getDescriptor()
                }  
                
                TRUE
            }, error = function(e) {
                # convert the error to a more descriptive message
                stop(paste0("Error loading table ", .self$lastTable, " from SAPI (", e, ')'))
            })
        },
        
        checkTables = function(tables) {
            "Checks the table list to see if maximum application memory will be exceeded by retrieving the data
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{tables} List of tables to load from SAPI.}
            }}
            \\subsection{Return Value}{If memory exceeded - a list of table metadata for each requested table, else NULL.}"
            tableMetaList <- list()
            for (table in names(tables)) {
                fullTableName <- paste0(.self$bucket, ".", tables[[table]]$name)
                tableMeta <- .self$client$getTable(fullTableName)
                tableMeta$shinyName <- table
                if (is.null(tables[[table]]$reducible)) {
                    tableMeta$reducible <- TRUE
                } else {
                    tableMeta$reducible <- tables[[table]]$reducible    
                }
                # check the table size
                print(paste("PRIOR mem usage at",.self$memoryUsage, "table",tableMeta$name, table))
                memoryUsage <<- .self$memoryUsage + as.numeric(tableMeta$dataSizeBytes)
                print(paste("POST mem usage at",.self$memoryUsage, "table",tableMeta$name))
                tableMetaList[[tables[[table]]$name]] <- tableMeta
            }
            if (.self$memoryUsage > .self$maxMemory) {
                print(paste("memoryUsage:", .self$memoryUsage, "maxMemory", .self$maxMemory))
                tableMetaList
            } else {
                NULL
            }
        },
                
        getDescriptor = function() {
            "Get results descriptor from SAPI
            \\subsection{Return Value}{Nested list of elements.}"
            print("getDescriptor")
            session$sendCustomMessage(
                type = "updateProgress",
                message = list(
                    id="descriptor_progress",
                    parentId="data_retrieval",
                    text="Retrieving summary table.", value="In Progress", valueClass="text-primary"))
            tryCatch({
                fullTableName <- paste0("\"", .self$bucket, "\".\"finalResults\"")
                columns <- c("item","run_id", "sequence", "value")
                fullColumns <- paste(paste0(fullTableName,".\"",columns,"\""),collapse=", ")
                
                print(paste("FULL COLUMNS",fullColumns))
                # fetch the data
                data <- .self$db$select(paste0(
                                "SELECT ", fullColumns, " FROM ", 
                                fullTableName,
                                " WHERE run_id = ?;"), .self$runId)
                
                # grab only descriptors - needs to deal with split values from Redshift
                descriptors <- data[which(data$item == 'descriptor'), ]
                # get indexes of duplicated values (can happen if the job is run multiple times)
                dupes <- duplicated(descriptors[, "sequence"])
                # get only non duplicate items
                descriptors <- descriptors[!dupes, ]
                descriptors$sequence <- as.integer(descriptors$sequence)
                # sort by sequence and get only the value
                descriptors <- descriptors[order(descriptors$sequence), 'value']
                # paste into a single string
                descriptor <- paste0(descriptors, collapse = '')
                # process JSON
                descriptor <- jsonlite::fromJSON(descriptor, simplifyVector = FALSE)
                print("getDescriptor finsihed")
                # inform the progress panel that we're finished
                session$sendCustomMessage(
                    type = "updateProgress",
                    message = list(
                        id="descriptor_progress",
                        parentId="data_retrieval",
                        text="Retrieving summary table.", value="Completed", valueClass="text-success"))
                return(descriptor)
            }, error = function(e) {
                stop(paste0("I cannot load descriptor (from finalResults table) from SAPI (", e, ")"))
            })
        },
        
        processSection = function(section, level, customElements) {
            "Internal method that returns HTML content for the given section node.
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{section} Node of the descriptor.}
            \\item{\\code{level} Heading level (1 = h2, 2 = h3).}
            \\item{\\code{customElements} Callback for processing custom elements.}
            }}
            \\subsection{Return Value}{List of HTML elements.}"
            print("processSection")
            sectionRet <- list()
            if (level == 1) {
                sectionRet[[length(sectionRet) + 1]] <- h2(section$title)
            } else {
                sectionRet[[length(sectionRet) + 1]] <- h3(section$title)
            }
            for (statement in section$statements) {
                if (length(statement) > 0) {
                    statementRet <- list()
                    if (statement$type == 'text') {
                        statementRet[[length(statementRet) + 1]] <- 
                            HTML(
                                paste0(
                                    '<p>',
                                    gsub('\\[(.*?)\\[([a-zA-Z0-9_]+)\\]\\]', '<span class="kb-hint" title="" id="\\2">\\1</span>', statement$content),
                                    '</p>'
                                )
                            )
                        for (hint in statement$hints) {
                            statementRet[[length(statementRet) + 1]] <- 
                                HTML(
                                    paste0("<script>$('#", hint$id, "').attr('title', '", gsub("'", "\\'", hint$hint, fixed = TRUE), "');</script>")
                                )
                        }
                    }
                    if (statement$type == 'image') {
                        statementRet[[length(statementRet) + 1]] <- img(src = statement$content, width = 900)
                    }
                    if (statement$type == 'table') {
                        df <- data.frame()
                        for (row in statement$content) {
                            if (class(row) == 'list') {
                                df <- rbind(df, unlist(row))
                                names(df) <- names(row)
                            } # else, ignore the row
                        }
                        
                        if (nrow(df) > 0) {
                            tid <- stringi::stri_rand_strings(n = 1, length = 8, pattern = "[A-Za-z]")
                            statementRet[[length(statementRet) + 1]] <- 
                                DT::datatable(
                                    df,
                                    class = 'table display',
                                    caption = statement$details
                                )
                        }
                    } 
                    if ((statement$type == 'plot') || (statement$type == 'custom')) {
                        if (!is.null(customElements)) {
                            statementRet[[length(statementRet) + 1]] <- p(customElements(statement$id, statement$content), class = 'lg-plot')
                        }
                    }
                    if (nchar(statement$example) > 0) {
                        statementRet[[length(statementRet) + 1]] <- p(statement$example, class = 'lg-example')
                    }
                    if (nchar(statement$details) > 0) {
                        # skip details for table, they have been already used as caption
                        statementRet[[length(statementRet) + 1]] <- tag('details', statement$details)
                    }
                    htmlDiv <- div(statementRet, class='lg-statement')
                    sectionRet[[length(sectionRet) + 1]] <- htmlDiv
                }
            }
            print("processSection end")
            return(sectionRet)
        },
        
        getDescription = function(appTitle, customElements, desc = NULL) {
            "Method returns HTML content for a descriptor.
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{appTitle} Title of the app.}
            \\item{\\code{customElements} Callback for printing custom elements, 
            signature: function(elementId, content)
            function should return a single HTML element. Pass NULL to ignore custom elements.}
            \\item{\\code{desc} Descriptor contents. If NULL, then \\code{getDescriptor} will be used.}
            }}
            \\subsection{Return Value}{TODO}"
            print("getDescription kdat")
            if (is.null(.self$client)) {
                return(NULL)
            }
            
            if (!is.null(desc)) {
                descriptor <- desc
            } else {
                if (is.null(.self$sourceData$descriptor)) {
                    sourceData$descriptor <<- .self$getDescriptor()    
                }
                descriptor <- .self$sourceData$descriptor
            }
            
            oldOptions <- options(stringsAsFactors = FALSE)
            contentRet <- list()
            contentRet[[length(contentRet) + 1]] <- h1(appTitle)
            cntr <- 0
            for (section in descriptor$sections) {
                if (length(section$subsections) == 0) {
                    sectionRet <- list()
                    sectionRet[[length(sectionRet) + 1]] <- processSection(section, 1, customElements)
                    contentRet[[length(contentRet) + 1]] <- tag('section', sectionRet)
                } else {
                    sectionRet <- list()
                    groups <- c()
                    for (subsection in section$subsections) {
                        groups <- c(groups, subsection$title)
                    }
                    groups <- as.list(groups)
                    
                    for (subsection in section$subsections) {
                        ld <- list()
                        ld[[length(ld) + 1]] <- processSection(subsection, 2, customElements)
                        sectionRet[[length(sectionRet) + 1]] <- tag('li', ld)
                    }
                    sectionRet[['class']] <- 'kb-enumeration'
                    ul <- tag('ul', sectionRet)
                    sectionRet <- list()
                    sectionRet[[length(sectionRet) + 1]] <- processSection(section, 1, customElements)
                    sectionRet[[length(sectionRet) + 1]] <- ul
                    contentRet[[length(contentRet) + 1]] <- tag('section', sectionRet)
                }
                cntr <- cntr + 1
                # progressBar$set(value=40 + 60/length(descriptor$sections)*cntr)
                print(paste("processed section", cntr))
            }
            options(oldOptions)
            print("getDescription exit kdat")
            return(contentRet)
        },

        getConvertedDataType = function(type, mode) {
            "Convert LG type definition to an R data type.
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{type} LG data type string ('integer', 'datetime', etc.).}
            \\item{\\code{mode} LG variable mode ('continuous', 'discrete').}
            }}
            \\subsection{Return Value}{R data type name.}"
            if (is.null(type) || is.na(type) || (length(type) == 0)) {
                ret <- 'character'
            } else if (type == "integer" || type == "float") {
                ret <- "numeric"
            } else if (type == "date") {
                ret <- "date"
            } else if (type == "datetime") {
                ret <- "posix"
            } else if (type == "string") {
                if (mode == "continuous") {
                    ret <- "character"
                } else {
                    ret <- "factor"
                }
            } else {
                ret <- "factor"
            }
            return(ret)
        },
        
        getCleanData = function(types, cleanData) {
            "Apply column types detected by LG to a data frame.
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{types} Data frame with contents of table with LG datatypes 
            (this table is usually named 'VAI__1' in SAPI).}
            \\item{\\code{cleanData} A data frame with actual data, its columns are
            expected to be listed as rows in the types table.}
            }}
            \\subsection{Return Value}{data.frame supplied in cleanData parameter with applied data types.}"
            # remove columns run_id and _timestamp which are internal only
            cleanData <- cleanData[,!names(cleanData) %in% c("run_id", "_timestamp")]
            out <- lapply(
                1:length(cleanData),
                FUN = function(i) {
                    varName <- colnames(cleanData)[i]
                    varType <- types[which(types$var_name == varName),]
                    # there may be still multiple definitions if a job was executed repeatedly, so pick the first one
                    type <- .self$getConvertedDataType(varType[1, "data_type"], varType[1, "mode"])
                    FUN1 <- switch(
                        type,
                        "posix" = as.POSIXlt,
                        "date" = as.Date,
                        "character" = as.character,
                        "numeric" = as.numeric,
                        "factor" = as.factor
                    )
                    if (type == "date" || type == "posix") {
                        cleanData[which(cleanData[,i] == ""), i] <- NA
                    }
                    FUN1(cleanData[,i])
                }
            )
            names(out) <- colnames(cleanData)
            return(as.data.frame(out))
        },
        
        saveDataFormUI = function(dataToSave) {
            "Get the UI elements for the data saving form
            \\subsection{Return Value}{List of html elements that make up the form.}"
            buckets <- .self$client$listBuckets()
            bucketNames <- lapply(buckets, function(x) { x$id }) 
            colnames <- paste(as.character(names(dataToSave())), collapse=", ")
            ret <- div(style = 'margin-top: 20px',
                helpText(paste("Save your currently filtered data to SAPI.  The table will have the following columns:", colnames)),
                wellPanel(
                    uiOutput("kb_saveResultUI"),
                    div(
                        selectInput("kb_outBucket", "Storage bucket", choices = bucketNames, selected = .self$bucket),
                        textInput("kb_outTable", "Table Name"),
                        actionButton("kb_saveIt", "Save It")
                    )
                )
            )    
        },
        
        saveResultUI = function(dataToSave) {
            "This method attempts to save the data.frame given by dataToSave, 
             and returns a UI element which alerts to the success or failure of the operation
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{dataToSave} the name of the data.frame that will be saved to SAPI}
            }}
            \\subsection{Return Value}{The success or failure alert dom element}"
            if (is.null(dataToSave)) {
                return(div())
            }
            if (session$input$kb_saveIt > .self$lastSaveValue) {
                if (nchar(session$input$kb_outTable) > 0) {
                    lastSaveValue <<- as.numeric(session$input$kb_saveIt)
                    print("Saving data")
                    tryCatch({
                        .self$client$saveTable(dataToSave(), session$input$kb_outBucket, session$input$kb_outTable)
                        ret <- div(class = 'alert alert-success', paste0("Table successfully saved as ", session$input$kb_outBucket, '.', session$input$kb_outTable, "."))
                    }, error = function(e) {
                        ret <- div(class = 'alert alert-danger', 
                                   paste0("Error saving table: ", e, 
                                        "\n Please note that table names may only contain alphanumeric characters, dashes '-', and underscores '_'"))
                        write(paste("Error saving table:", e),stderr())
                    })
                } else {
                    ret <- div(class = 'alert alert-warning', "Please enter table name.")
                }
            } else {
                ret <- div()
            }
            return(ret)
        },
        
        dataModalButton = function(dataToSave) {
            "Method for the config button that opens the save data modal dialog
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{dataToSave} the name of the data.frame that will be saved to sapi. }
            }}
            \\subsection{Return Value}{list(keboolaModalButton)}"
            list(
                keboolaModalButton(
                    "kb_dataModal",
                    label = "",
                    icon = icon("save"),
                    title = "Save Data to SAPI",
                    content = .self$saveDataFormUI(dataToSave)
                )
            )
        },
        
        previewData = function(tableMeta) {
            "Offers a limited view of sample data
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{tableMeta} The table object returned from SAPI}
            }}
            \\subsection{Return Value}{reactive construct.  updated DOM is stored in session$output}"
            reactive({
                columnFiltersUI <- 
                    lapply(session$input[[paste0("kb_",tableMeta$name,"_filters")]],function(arg){
                        if (!is.null(session$input[[paste0("kb_",arg,"_filter")]])) {
                            textInput(paste0("kb_",arg,"_filter"), paste(arg,"Filter"), value = session$input[[paste0("kb_",arg,"_filter")]])
                        } else {
                            textInput(paste0("kb_",arg,"_filter"), paste(arg,"Filter"))
                        }
                    })
                session$output[[paste0("kb_",tableMeta$name,"_columnFiltersUI")]] <- renderUI({
                    columnFiltersUI
                })
                refresh <- session$input[[paste0("kb_",tableMeta$name,"_refresh")]]
                load <- as.numeric(session$input[[paste0("kb_",tableMeta$name,"_load")]])
                isolate({
                    
                    fullTableName <- paste0("\"", tableMeta$bucket$id, "\".\"",tableMeta$name, "\"")
                    cols <- session$input[[paste0("kb_",tableMeta$name,"_columns")]]
                    fullColumnNames <- paste(paste0(fullTableName,".\"",cols,"\""),collapse=", ")
                    
                    filters <- session$input[[paste0("kb_",tableMeta$name,"_filters")]]
                    argstr <- ""
                    arglist <- list()
                    if (!is.null(filters) && length(filters) > 0) {
                        for (filter in filters) {
                            filterName <- paste0("kb_",filter,"_filter")
                            value <- session$input[[filterName]]
                            fullFilter <- paste0(fullTableName,".\"",filter,"\"")
                            arglist[[fullFilter]] <- value
                        }
                        argstrings <- paste(names(arglist)," != ?")
                        
                        argstr <- paste("WHERE",paste(argstrings,collapse=" AND "))
                        
                    }
                    if (load > .self$loadList[[tableMeta$name]]) {
                        print("laod button has been clicked")
                        limit <- ""
                        session$sendCustomMessage(
                            type = "updateProgress",
                            message = list(
                                id=paste0("kb_",tableMeta$name,"_progress"), 
                                parentId="data_retrieval",
                                text=paste("Retrieving", tableMeta$shinyName, "table."), value="In Progress", valueClass="text-primary"))
                        
                    } else {
                        limit <- " LIMIT 50"
                    }
                    query <- paste0("SELECT ",fullColumnNames," FROM ", fullTableName, argstr, limit)
                    print(paste("previewData query:",query))
                    
                    dat <- .self$db$select(query,arglist)
                    
                    
                    if (load > .self$loadList[[tableMeta$name]]) {
                        loadList[[tableMeta$name]] <<- load
                        
                        sourceData[[tableMeta$shinyName]] <<- dat
                        session$sendCustomMessage(
                            type = "updateProgress",
                            message = list(
                                id=paste0("kb_",tableMeta$name,"_progress"), 
                                parentId="data_retrieval",
                                text=paste("Retrieved", tableMeta$shinyName, "table.",print(object.size(dat),units='b')," bytes used."), value="Completed", valueClass="text-success"))
                        session$sendCustomMessage(
                            type = "renameButton",
                            message = list(
                                    buttonId=paste0("kb_",tableMeta$name,"_load"),
                                    text="Reload Selection"
                                ))
                        
                        dat <- data.frame(
                            status="Table successfully loaded.",
                            memory=format(object.size(dat),units='auto'),
                            rows=nrow(dat)
                        )
                    }
                    .self$setMemoryUsage(tableMeta)
                    if (.self$allLoaded) {
                        print(paste("ALL LOADED NAMES", names(.self$sourceData)))
                    }
                    dat
                })
            })
        },
        
        setMemoryUsage = function(tableMeta) {
            "TODO
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{tableMeta} TODO}
            }}
            \\subsection{Return Value}{TODO}"
            memoryUsage <<- 0
            
            print(paste("LOAD LIST",names(.self$loadList)))
            print(.self$loadList)
            print(paste("SOURCEDATA", names(.self$sourceData)))
            allLoaded <<- TRUE
            for (table in names(loadList)) {
                print(paste("CHECKING TABLE", table, " loaded? ", loadList[[table]]))
                if (loadList[[table]] == 0) {
                    print(paste("TABLE", table, " IS LOADED???  BUGGER"))
                    memoryUsage <<- .self$memoryUsage + tableMeta$dataSizeBytes
                    allLoaded <<- FALSE
                } else {
                    memoryUsage <<- .self$memoryUsage + as.numeric(object.size(.self$sourceData[[tableMeta$shinyName]]))
                    print(paste("SHINY NAME:", tableMeta$shinyName, "TOTAL MEM : ", .self$memoryUsage, "TABLE", table, "MEM", as.character(object.size(.self$sourceData[[tableMeta$shinyName]]))))
                }
            }
            print(paste("ALL LOADED?", .self$allLoaded, "mem usage", .self$memoryUsage, "maxmem", .self$maxMemory))
            if (.self$allLoaded && .self$memoryUsage < .self$maxMemory) {
                session$output$kb_detourMessage <- 
                    renderUI(
                        fluidRow(class="alert alert-success", 
                            column(9,div(
                                paste("The tables combine to (",as.character(.self$memoryUsage),"Bytes).  This is less than the memory limit (", .self$maxMemory, 
                                      "Bytes) for this application. "))),
                            column(3,actionButton("kb_continue", "Continue", class="navbar-right"))
                        )    
                    )
            }else {
                session$output$kb_detourMessage <- 
                    renderUI(
                        div(class="alert alert-warning", 
                            paste("The tables combine to (",as.character(.self$memoryUsage),"Bytes).  This is greater than the memory limit (", .self$maxMemory, 
                                  "Bytes) for this application. ",
                                  "Please discard any columns that you believe will not be of interest,",
                                  "and/or remove rows containing unwanted values."))    
                    )    
            }
        },
        
        problemTablesUI = function(problemTables) {
            "Creates and returns a UI for the user to reduce the amount of data being loaded to 'hopefully' under the memory limit
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{problemTables} A list of reducible tables that the UI will display as tabbed editors}
            }}
            \\subsection{Return Value}{A tabset panel with one tab per reducible table}"
            print(paste("trying to make tab for ", names(problemTables)))
            tabs <- lapply(names(problemTables),function(table){
                tableMeta <- problemTables[[table]]
                print(paste("loading table",tableMeta$name))
                if (tableMeta$reducible) {
                    loadList[[tableMeta$name]] <<- 0 #initiate the load button memory 
                    print(paste("adding tab for", table))
                    tabPanel(tableMeta$shinyName,.self$tableEditor(tableMeta))
                }else {
                    loaded <- .self$loadTable(tableMeta$shinyName, tableMeta$name)
                    loadList[[tableMeta$name]] <<- 1 # this table had reducible set so is auto-loaded
                    print(paste("loaded table",tableMeta$name))
                    NULL
                }
            })
            tabs <- Filter(Negate(is.null),tabs)
            print("made tabs")
            print(tabs)
            do.call(tabsetPanel, tabs)
        },
        
        tableEditor = function(tableMeta) {   
            "TODO
            \\subsection{Parameters}{\\itemize{
            \\item{\\code{tableMeta} TODO}
            }}
            \\subsection{Return Value}{TODO}"
            print("setting up the tabs")
            tags$div(id=tableMeta$name, class="tableEditor",
                fluidRow(
                    column(4,
                        selectInput(paste0("kb_",tableMeta$name,"_columns"),"Keep These Columns",choices=tableMeta$columns,selected=tableMeta$columns,multiple=TRUE)
                    ),
                    column(8,
                        fluidRow(
                            helpText("Use these filters to EXCLUDE rows containing unwanted values for the selected variables"),
                            column(6,
                                selectInput(paste0("kb_",tableMeta$name,"_filters"),"Filter by a Column",choices=tableMeta$columns,multiple=TRUE)
                                
                            ),
                            column(6,
                                uiOutput(paste0("kb_",tableMeta$name,"_columnFiltersUI"))
                            )
                        )
                    )
                ),
                div(
                    actionButton(paste0("kb_",tableMeta$name,"_load"),"Load Selection", class='navbar-right btn-primary table-editor-btn'),
                    actionButton(paste0("kb_",tableMeta$name,"_refresh"),class="btn-primary navbar-right icon-refresh table-editor-btn",list(icon("refresh"),"Refresh Data Preview"))
                ),
                div(
                    h4("Data Preview"),
                    renderDataTable(previewData(tableMeta)(), options=list(searching=FALSE,info=FALSE))
                )
            )
        }
    )
)