Swechhya / excelR

An Interface to 'jExcel.js' Library
https://swechhya.github.io/excelR/
Other
152 stars 19 forks source link

Add tableHeight parameter to excelTable #72

Closed FrankSchiro closed 4 years ago

FrankSchiro commented 4 years ago

Is your feature request related to a problem? Please describe. I could not alter the height of the excelTable in Shiny without using fullscreen = TRUE. However, fullscreen = TRUE would hide the searchbar under the shiny navbar, and I could not insert padding for some reason.

Adjusting height in excelOutput in the Shiny UI also had no effect.

Describe the solution you'd like adjust table height

Describe alternatives you've considered In order to fix this, I ended up adding a line of code to excelTable: paramList$tableHeight <- "500px"

This fixed the problem for me, because I can now set the table height myself. I'm unsure if this issue was caused by my R version being only 3.6.0. However, even with this R version, adjusting tableHeight parameter fixed the issue.

Additional context I posted this on stackoverflow: https://stackoverflow.com/questions/62050757/shiny-app-excelr-cant-control-table-height/62051461#62051461

example code with problem in R 3.6.0

shinyApp(
    ui =  navbarPage("title", selected = "main", 
        position = "fixed-top", 
        tags$style(type="text/css", "body {padding-top: 70px;}"),
        tabPanel("main", id = "main",
            fluidPage(                
                excelOutput("table", width = "100%", height = "100%")
            )
        )
    ),
    server = function(input, output, session) {
        output$table <-renderExcel(
            excelTable(
                data = iris,
                autoColTypes = FALSE,
                pagination = 5,
                #autoFill = TRUE,
                fullscreen = FALSE,
                lazyLoading = TRUE,
                search = TRUE  
            )
        )
    }
)

Fix I used

This is the fix, with the new parameter added at the bottom for tableHeight = 500px

shinyApp(
    ui =  navbarPage("title", selected = "main", 
        position = "fixed-top", 
        tags$style(type="text/css", "body {padding-top: 70px;}"),
        tabPanel("main", id = "main",
            fluidPage(                
                excelOutput("table", width = "100%", height = "100%")
                #htmlOutput("table", width = "100%", height = "500px")
            )
        )
    ),
    server = function(input, output, session) {
        output$table <-renderExcel(
            excelTable2(
                data = iris,
                autoColTypes = FALSE,
                autoFill = TRUE,
                fullscreen = FALSE,
                lazyLoading = TRUE,
                search = TRUE  
            )
        )
    }
)

excelTable2 = function (data = NULL, columns = NULL, colHeaders = NULL, rowHeight = NULL, 
    nestedHeaders = NULL, defaultColWidth = NULL, minDimensions = NULL, 
    columnSorting = TRUE, columnDrag = FALSE, columnResize = TRUE, 
    rowResize = FALSE, rowDrag = TRUE, editable = TRUE, allowInsertRow = TRUE, 
    allowInsertColumn = TRUE, allowDeleteRow = TRUE, allowDeleteColumn = TRUE, 
    allowRenameColumn = TRUE, allowComments = FALSE, wordWrap = FALSE, 
    selectionCopy = TRUE, mergeCells = NULL, search = FALSE, 
    pagination = NULL, fullscreen = FALSE, lazyLoading = FALSE, 
    loadingSpin = FALSE, style = NULL, autoColTypes = TRUE, showToolbar = FALSE, 
    dateFormat = "DD/MM/YYYY", digits = 4, autoWidth = TRUE, 
    autoFill = FALSE, getSelectedData = FALSE, ...) 
{
    paramList <- list()
    if (!is.null(data)) {
        if (is.data.frame(data) || is.matrix(data)) {
            paramList$data <- jsonlite::toJSON(data, dataframe = "values", 
                na = "null", digits = digits)
        }
        else {
            stop("'data' must be either a matrix or a data frame, cannot be ", 
                class(data))
        }
    }
    if (is.null(columns) && is.null(colHeaders)) {
        if (!is.null(data)) {
            warning("Since both column title and colHeaders are not specified 'data' column name will be used as column headers")
            paramList$colHeaders = colnames(data)
        }
    }
    else if (is.null(columns) && !is.null(colHeaders)) {
        if (!is.vector(colHeaders)) {
            stop("'colHeaders' must be a vector, cannot be ", 
                class(colHeaders))
        }
        if (!is.null(data)) {
            if (ncol(data) != length(colHeaders)) {
                stop("length of 'colHeader' should be equal the number of columns in the 'data', 'data' has ", 
                  ncol(data), "but the length of 'colHeader' is ", 
                  length(colHeaders))
            }
        }
        paramList$colHeaders <- jsonlite::toJSON(colHeaders)
    }
    else if (!is.null(columns)) {
        if (!is.data.frame(columns)) {
            stop("'columns' must be a dataframe, cannot be ", 
                class(columns))
        }
        if (!is.null(data)) {
            if (nrow(columns) != ncol(data)) {
                stop("number of rows in 'columns' should be equal to number of columns in 'data', expected number of rows in 'columns' to be ", 
                  ncol(data), " but got ", nrow(columns))
            }
        }
        if (!"title" %in% colnames(columns)) {
            if (is.null(colHeaders)) {
                if (!is.null(data)) {
                  warning("Since both column title and colHeaders are not specified 'data' column name will be used as column headers")
                  paramList$colHeaders = jsonlite::toJSON(colnames(data))
                }
            }
            else {
                paramList$colHeaders = jsonlite::toJSON(colHeaders)
            }
        }
        paramList$columns <- jsonlite::toJSON(columns)
    }
    if (autoColTypes && !is.null(data)) {
        if (is.null(columns)) {
            message("Since 'type' attribute is not specified and autoColTypes is true, detecting type from 'data'")
            colTypes <- get_col_types(data)
            columns <- data.frame(type = colTypes)
            columns <- add_source_for_dropdown_type(data, columns)
            paramList$columns <- jsonlite::toJSON(columns)
        }
        else {
            if (!"type" %in% colnames(columns) && autoColTypes) {
                message("Since 'type' attribute is not specified and autoColTypes is true, detecting type from 'data'")
                colTypes <- get_col_types(data)
                columns$type <- colTypes
                columns <- add_source_for_dropdown_type(data, 
                  columns)
                paramList$columns <- jsonlite::toJSON(columns)
            }
        }
    }
    if (!is.null(rowHeight)) {
        if (!is.data.frame(rowHeight) && !is.matrix(rowHeight)) {
            stop("'rowHeight' must either be a matrix or a dataframe, cannot be ", 
                class(rowHeight))
        }
        if (ncol(rowHeight) != 2) {
            stop("'rowHeight' must either be a matrix or a dataframe with two columns, but got ", 
                ncol(rowHeight), " column(s)")
        }
        paramList$rowHeight <- jsonlite::toJSON(rowHeight, dataframe = "values")
    }
    if (!is.null(nestedHeaders)) {
        if (!is.list(nestedHeaders)) {
            stop("'nestedHeaders' must be a list of dataframe(s), cannot be ", 
                class(nestedHeaders))
        }
        headerAttributes <- c("title", "colspan")
        for (nestedHeader in nestedHeaders) {
            if (!is.data.frame(nestedHeader)) {
                stop("'nestedHeaders' must be a list of dataframe(s), but got list of  ", 
                  class(nestedHeader), "(s)")
            }
            if (ncol(nestedHeader) < 2 || nrow(nestedHeader) < 
                1) {
                stop("the dataframe(s) in 'nestedHeaders must contain at least two columns and one row, 'title' and 'colspan', but got only ", 
                  ncol(nestedHeader), " column and ", nrow(nestedHeader), 
                  " row")
            }
            if (!"title" %in% colnames(nestedHeader)) {
                stop("one of the column in the dataframe in list of 'nestedHeaders' should have 'title' as header which will be used as title of the nested header")
            }
            if (!"colspan" %in% colnames(nestedHeader)) {
                stop("one of the column in the dataframe in list of 'nestedHeaders' should have 'colspan' as header which will be used to determine the number of column it needs to span")
            }
            if (!all(colnames(nestedHeader) %in% headerAttributes)) {
                warning("unknown headers(s) ", colnames(nestedHeader)[!colnames(nestedHeader) %in% 
                  headerAttributes], " for 'nestedHeader' found, ignoring column with those header(s)")
            }
        }
        paramList$nestedHeaders <- jsonlite::toJSON(nestedHeaders, 
            dataframe = "rows")
    }
    if (!is.null(defaultColWidth)) {
        if (!is.numeric(defaultColWidth) || length(defaultColWidth) > 
            1) {
            stop("'defaultColWidth' must be a numeric value of length 1 but got ", 
                class(defaultColWidth), " of length ", 
                length(defaultColWidth))
        }
        paramList$defaultColWidth <- defaultColWidth
    }
    if (!is.null(minDimensions)) {
        if (!is.vector(minDimensions)) {
            stop("'minDimensions' must be vector but got ", 
                class(minDimensions))
        }
        if (length(minDimensions) != 2) {
            stop("'minDimensions' must be a vector of length of 2 but got length of ", 
                length(minDimensions))
        }
        paramList$minDimensions <- minDimensions
    }
    for (arg in c("columnSorting", "columnDrag", 
        "columnResize", "rowResize", "rowDrag", 
        "editable", "allowInsertRow", "allowInsertColumn", 
        "allowDeleteRow", "allowDeleteColumn", "allowRenameColumn", 
        "allowComments", "wordWrap", "selectionCopy", 
        "search", "fullscreen", "lazyLoading", 
        "loadingSpin", "showToolbar", "autoWidth", 
        "autoFill", "getSelectedData")) {
        argvalue <- get(arg)
        if (!is.null(argvalue)) {
            if (is.logical(argvalue)) {
                paramList[[arg]] <- argvalue
            }
            else {
                warning("Argument ", arg, " should be either TRUE or FALSE.  Ignoring ", 
                  arg, ".", call. = FALSE)
                paramList[[arg]] <- NULL
            }
        }
    }
    if (!is.null(mergeCells)) {
        if (!is.list(mergeCells)) {
            stop("expected 'mergeCells' to be a list but got ", 
                class(mergeCells))
        }
        for (mergeCell in mergeCells) {
            if (!is.vector(mergeCell)) {
                stop("expected each parameter in 'mergeCells' list to be a vector but got ", 
                  class(mergeCell))
            }
            if (length(mergeCell) != 2) {
                stop("expected each parameter in 'mergeCells' list to be a vector of length  2 but got vector of length ", 
                  length(mergeCells))
            }
        }
        paramList$mergeCells <- mergeCells
    }
    if (!is.null(pagination)) {
        if (!is.numeric(pagination) || length(pagination) > 1) {
            stop("'pagination' must be an integer of length 1 but got ", 
                class(pagination), " of length ", length(pagination))
        }
        paramList$pagination <- pagination
    }
    if (!is.null(style)) {
        if (!is.list(style)) {
            stop("'style' should be a list but got ", class(style))
        }
        paramList$style <- style
    }
    if (!is.null(dateFormat)) {
        paramList$dateFormat <- dateFormat
    }
    paramList$tableHeight <- "500px"
    paramList <- append(paramList, list(...))
    htmlwidgets::createWidget(name = "jexcel", x = paramList, 
        width = if (fullscreen) 
            "100%"
        else 0, height = if (fullscreen) 
            "100%"
        else 0, package = "excelR", 
    )
}
FrankSchiro commented 4 years ago

I realized I can just pass this as a parameter into the original function, even though it's not explicitly stated as a parameter.