daqana / dqshiny Goto Github PK

View Code? Open in Web Editor NEW

60.0 60.0 10.0 963 KB

Enhance Shiny Apps with Customizable Modules

R 77.81% CSS 10.99% JavaScript 11.20%

dqshiny's People

Contributors

Stargazers

Watchers

Forkers

drroad mw201608 pc91 dskmh mmoisse sharlagelfand dee-sea ahmedkhaled945 hoppanda bene-stra

dqshiny's Issues

Autocomplete - Changing one autocomplete_input changes all other ones that contain that value in their options

I have a few autocomplete_input boxes that all have the same set of options. Changing one of these boxes changes all of them to the same value. Is this intended behavior? Is there a way to keep their values seperate?

For a complete example, the official example (https://rdrr.io/cran/dqshiny/man/autocomplete_input.html) actually suffers from this problem as well when I copy it into RStudio and run it.

update_autocomplete_input does not work if length for options is 1 unless coercing to list

Hi,

update_autocomplete_input() will not work if the length of the options is 1 unless coercing to list. Then when coercing to list if length is greater than 1 that doesn't work. I am really doing a filter on dataframe that is being passed so the vector can be many or just 1.

Examples that work:
update_autocomplete_input(session, "uniProtID", "UniProt ID:", options = c("Q44455", "P12345"))
update_autocomplete_input(session, "uniProtID", "UniProt ID:", options = list(c("Q44455")))

Examples that don't work:
update_autocomplete_input(session, "uniProtID", "UniProt ID:", options = list(c("Q44455", "P12345")))
update_autocomplete_input(session, "uniProtID", "UniProt ID:", options = c("Q44455"))

Really bizarre.

CRAN Release

Hello,

as far as I can tell your wonderful code is kind of stuck to GitHub at the moment, since the CRAN version is archived. Do you have any plans to release a newer version of your package to CRAN? It would be lovely to see it there too, since I use it in two of my projects, and can't download it direct from CRAN, which is a big hassle.

Thank You :-)

Autocomplete returns name rather than value & length of name

Hi all,

Autocomplete looks really cool. But it doesn't work correctly with named inputs.

As an example (reprex below), rather than returning Apple Inc. from input$auto2 I'd want to return AAPL so I could pull stock prices from the ticker.

Another thing I noticed is that long names are cutoff. Would it be hard to implement a boolean choice of whether the name was cutoff or the text was wrapped?

library(shiny)
library(dqshiny)
library(tidyverse)

opts <- read_csv("https://raw.githubusercontent.com/datasets/s-and-p-500-companies/master/data/constituents.csv")

opts <- setNames(opts$Symbol,opts$Name)

shinyApp(
  ui = fluidPage(
    fluidRow(
      column(3,
        autocomplete_input("auto2", "Named:", max_options = 1000,
          opts,create = T)
        # feel free to test this with select... and may get yourself a coffee
        # , selectInput("sel", "Select:", opts)
      ), column(3,
        tags$label("Value:"), verbatimTextOutput("val2", placeholder = TRUE)
      )
    )
  ),
  server = function(input, output) {
    output$val2 <- renderText(as.character(input$auto2))
  }
)

Example reactive data with dq_render_handsontable()

Could you kindly provide an example using a reactive data.frame? I'm trying to refactor code from renderDT to dq_render_handsontable, but I'm not able to pass the same reactive value. All I get is a non-descriptive error in RStudio:

Listening on http://127.0.0.1:6031
Error :

Thx!

autocomplete not really autocomplete

While the autocomplete does allow you to write in words that are not part of the choices, I am not actually able to get the value typed in. When testing it with a button to try and get the value I typed in, I get an empty string instead of the value typed in.

Output inside dq_accordion is not being rendered

When using output elements inside a dq_accordion only the output's in the first accordion are shown unless you force load all the outputs inside the accordion, or put output inside an module. However this trick does not work for DataTables

   library(shiny)

   mod_2_ui <- function(id){
      ns <- NS(id)
      tagList(
         uiOutput(ns("outUI"))
      )
   }
   
   mod_2_server <- function(input, output, session){
      ns <- session$ns
      
      vals <- reactiveValues(selected = NULL)
      
      output$outUI <- renderUI({
         tagList(
            selectizeInput(inputId = ns("selected"), label = "Select a slide", multiple = FALSE, choices = c(1:5), selected = 3)
         )
      })
      
      outputOptions(output, "outUI", suspendWhenHidden = FALSE)
      
      observeEvent(input$selected, {
         vals$selected = input$selected
      })
      
      return(vals)
   }

   content = list()
   
   content[["first"]] <- tagList(
      textOutput("testOut_1"),
      DT::dataTableOutput("table_1")
   )
   
   content[["second"]] <- tagList(
      textOutput("testOut_2")
   )
   
   content[["third"]] <- tagList(
      mod_2_ui(id = "selected_3")
   )
   
   content[["fourth"]] <- tagList(
      DT::dataTableOutput("table_2")
   )
   
   ui <- fluidPage(
      
      fluidRow(
         column(12, offset = 0,
                div(style="height:0px; top:20px"),
                dqshiny::dq_space("30px"),
                shiny::div(
                   class = "",
                   style = "max-height: 80vh;height:auto",
                   dqshiny::dq_accordion(
                      id =  "outer",
                      titles = names(content),
                      content = content,
                      bg_color = "#f7f9fc",
                      options = list(animate = 500, collapsible = TRUE, heightStyle = "content"),
                      sortable = FALSE,
                      hover = TRUE,
                      icons = c(rotate = "angle-right")
                   )
                )
         )
      )
   )

   server <- function(input, output) {
     
      selected_3 <- callModule(mod_2_server, "selected_3")
      
      output$testOut_1 <- renderText({"First output"})
      output$testOut_2 <- renderText({"Second output"})
      
      output$table_1 <- DT::renderDataTable({DT::datatable(datasets::iris)})
      output$table_2 <- DT::renderDataTable({DT::datatable(datasets::iris)})
      
      # Only works if you uncomment the line below
      # outputOptions(output, "testOut_2", suspendWhenHidden = FALSE)
      outputOptions(output, "table_2", suspendWhenHidden = FALSE)
   }

   shinyApp(ui = ui, server = server)

Session Info

> sessionInfo()
R version 3.6.3 (2020-02-29)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 18.04.5 LTS

Matrix products: default
BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.7.1
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.7.1

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_IE.UTF-8        LC_COLLATE=en_US.UTF-8    
 [5] LC_MONETARY=en_IE.UTF-8    LC_MESSAGES=en_US.UTF-8    LC_PAPER=en_IE.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C             LC_MEASUREMENT=en_IE.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] stats     graphics  grDevices utils     methods   base     

other attached packages:
[1] dqshiny_0.0.5  shiny_1.6.0    colorout_1.2-2

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.5        digest_0.6.27     later_1.1.0.1     mime_0.7          R6_2.4.0          lifecycle_1.0.0  
 [7] xtable_1.8-4      magrittr_2.0.1    evaluate_0.14     rlang_0.4.10      promises_1.1.1    ellipsis_0.3.1   
[13] rmarkdown_1.15    tools_3.6.3       yaml_2.2.1        xfun_0.9          httpuv_1.5.4      fastmap_1.0.1    
[19] compiler_3.6.3    htmltools_0.5.1.1 knitr_1.24

Drop down can't be seen when filtering only 1 column

I have an issue where I can't see the dropdown menu if there is only 1 row because the table is too small.
This issue is fixed if I add css tags$style(".handsontable {overflow: visible !important; }"), however, this breaks the filter alignment.

To fix this, I had to set a minimum height to the table. In dq_render_handsontable, when the function is sending arguments to rhandsontable, I added these lines:

if(!is.null(app_input[[ns("pageSize")]])){    
            params[[1L]]$height = min(
                c(
                    50 * as.integer(app_input[[ns("pageSize")]]),
                    100 + 50 * nrow(dqv$full)
                )
            )
        }

This fixed the issue by setting a minimum height to the table. It would be easy to alter this to have a user defined height as one number in the min argument, or if the user defines minimum height just skip this code block.

I also tried setting min-height in the css of my ui, but that broke the dropdown option menu for some reason. Hope this helps someone.

Applying parameters with col_param

edit: I was able to get around the first issue about colWidths, by being more specific in assigning colWidths earlier in the initialization. Whats interesting now is that the filters do not consistently align with the columns.

Hello,

If you could help me understand how your col_param works please. I am trying to pass parameters to different groups of columns, when I pass colWidths to a group of columns they receive the width but all other columns are set to whats seems to be 0.

I just inserted the issue into your demo code.

shinyApp(
  ui = fluidPage(
    dq_handsontable_output("randomTable", 9L)
  ),
  server = function(input, output, session) {
    hw <- c("Hello", "my", "funny", "world!")
    data <- data.frame(A = rep(hw, 500), B = hw[c(2,3,4,1)],
      C = 1:500, D = Sys.Date() - 0:499, stringsAsFactors = FALSE)
    
   dq_render_handsontable(
    "randomTable",
    data = data,
    width_align = TRUE,
    filters = c("Select"),
    table_param =
      list(
        height = 800,
        readOnly = TRUE,
        stretchH = "all",
        highlightCol = TRUE,
        highlightRow = TRUE
      ),
    col_param =
      list(list(col = c("A", "B"), readOnly = FALSE),
           list(col = c("C", "D"), colWidths = 300)
      ),
    horizontal_scroll = TRUE
   )
  }
)

I thought it would work how you would pass multiple hot_cols.
ex:

hot_col(
  c(
    "A",
    "B"
  ),
  readOnly = FALSE
) %>%
hot_col(
  c(
    "C",
    "D"
  ),
  colWidths = 300
)

Is it possible to set row and column highlight?

Hi,

I have been trying to get the row-highlight feature of rhandsontable to work with dq_render_handsontable. On the rhandsontable website, it shows this example of the feature in question:

DF = data.frame(val = 1:10, bool = TRUE, big = LETTERS[1:10],
                small = letters[1:10],
                dt = seq(from = Sys.Date(), by = "days", length.out = 10),
                stringsAsFactors = FALSE)
rhandsontable(DF, width = 550, height = 300) %>%
  hot_table(highlightCol = TRUE, highlightRow = TRUE)

Is there a way to enter hot_table(highlightCol = TRUE, highlightRow = TRUE) into dq_render_handsontable?

Thanks

Figured out the solution : table_param = list(highlightCol = TRUE, highlightRow = TRUE)

Changing the header background color

Hi, I'm looking for an easy way to change the header background color.
Currently, I am doing a bunch of crazy things to change the background color of the header:

I altered the dq_render_handsontable function by adding this line
res$x$colHeaders <- headerHtml
Where, headerHtml is given as follows:

headerHtml <- c(
    "<div class='sample' style = 'background:#CEC; color = green; position: absolute;
        top: 0;
        left: 0;
        width: 100%;
        height: 100%;'>My-Column-Name</div>
    "
)

This is the section of dq_render_handsontable which I had to alter:

app_output[[id]] <- rhandsontable::renderRHandsontable({
        if (is.null(hot())) 
            return()
        params[[1L]]$data <- hot()
        params[[1L]]$useTypes = FALSE #I added this
        params[[2L]]$hot <- do.call(rhandsontable::rhandsontable, 
            params[[1L]])
        res <- do.call(rhandsontable::hot_cols, params[[2L]])
        # result is an actual handson table with all the data next line #print will show in rstudio!
        ##print(res)

        for (x in params[[3L]]) {
            res <- do.call(rhandsontable::hot_col, append(list(res), 
                x))
        }
        for (x in params[[4L]]) {
            x$row <- match(x$row, rownames(hot()))
            x$row <- x$row[!is.na(x$row)]
            res <- do.call(dq_hot_cell, append(list(res), x))
        }
        res$dependencies <- append(res$dependencies, init())
        #res %>% hot_validate_numeric(cols = c(3), min = -50, max = 50)
        #res %>% myValidation(myNumericValidation)
        #res
        res$x$colHeaders <- headerHtml
        res
    })

So, while this will work for my given project, I'm wondering if there is a way to pass this into dq_render_handsontable as is? I tried passing colHeaders = headerHtml in table_param, col_param, cell_param, and cols_param, but it did not work and I got errors.

autocomplete_input update options dynamically

Thank you for the useful package.

Is it possible to update the options of the component dynamically as the user types rather than sourcing from a static list? One possible way is to enable one to set up an observeEvent that triggers as the user types or when they pause allowing them to run an update_autocomplete_input? Alternatively, have an option to update the options maybe when the user pauses typing?

I know the component solves the problem of slow large option lists, so this may not be a direct use case for it.

dq_render_handsontable trouble showing all of the column filters

I'm having a problem where I can't get dq_render_handsontable to show all of the column filters.

The filters cut off around the 5th or 6th filter

Could someone please help me out?

df = data.frame(hello1 = c("apple", "monkey", "carot", "potato"), stringsAsFactors = FALSE)
df2 = df
for(i in 1:20){
    df = cbind(df, df2)
}
names(df) = paste0(names(df), seq(20))

shinyApp(
    ui = fluidPage(
        dq_handsontable_output("randomTable")
    ),
    server = function(input, output, session) {
        dq_render_handsontable(
            "randomTable", 
            df,
            filters = "T",
            page_size = NULL,
            width_align = TRUE,
            horizontal_scroll = TRUE,
            table_param = list(width = (300 * ncol(df)))
        )
    }
)

autocomplete_input misses obvious matches

I am using autocomplete_input with a list of airports from airportr. You can search for three-letter IATA name or airport name. For the most part, this works well, but for some airports, (in my example "PIE"), it does not pull it up immediately. It finds PIE first in the middle of other airport names. Is it possible to search at the beginning before the middle?

Data:

airports <- airportr::airports %>%
  select(IATA, Name) %>%
  mutate(name2 = paste(IATA, " - ", Name)) %>%
  select(name2) %>% pull()

Shiny:

dqshiny::autocomplete_input("departure", "Departure Airport:", airports, max_options = 5, contains = TRUE)

Autocomplete with multiple inputs

Hi there

This is very handy, and i am using the autocomplete_input function as I have a really large list (>80 000 options) and selectizeInput was just way too slow.

But, I wanted to know if it's possible to use autocomplete_input to select multiple options? Similarly how in selectizeInput one would set multiple = TRUE.

Thanks!
Megan

Query: Possible to input custom value instead of selecting?

Hi, is it possible to input a custom input into textbox based on suggestions instead of selecting an input from options?

Thank you for your help

Can you please submit to CRAN?

Hi there - I was just wondering if you could submit the current version (0.0.3.9000) to CRAN? That would help a lot, thanks!

Undo, Redo and context menu

Wanted to ask about the ability to apply Undo, redo on table cells, also right click options like insert new row, insert row before, after and so on, are these applicable using the library?
Thanks.

bug with reactive data in dq_render_handsontable

When running dq_render_handsontable with a reactive input that changes the number of columns, I get an error when I add too many columns.

In the reproducible example below, you can add columns with the drop down bar. When I add columns with the app, I get this error: Warning: Error in [[: subscript out of bounds

library("rlist")
library(shinyWidgets)
library(shiny)
library(dqshiny)

shinyApp(
    ui = fluidPage(
        dq_handsontable_output("randomTable"),
        pickerInput(
            inputId = "extraCols", 
            label = "Add Columns", 
            choices = c(1, 5:10),
            selected = 0,
            multiple = FALSE
        )
    ),
    server = function(input, output, session) {
        colParams__ <- reactive({
            colParams_ = list()
            for(i in 1:ncol(df0())){
                colParams_ = list.append(colParams_,
                    list(
                        col = names(df0())[i], 
                        type = "dropdown", source = unique(df0()[, i])
                    )
                )
            }
            colParams_
        })
        df0 <- reactive({
            hw <- c("Hello", "my", "funny", "world!")
            df <- data.frame(A = rep(hw, 8), B = hw[c(2,3,4,1)],
            C = 1:8, D = 1:8, stringsAsFactors = FALSE)
            df$D = as.character(df$D)
            n <- as.numeric(input$extraCols)
            print(n)
            for(i in 1:n){
                df <- cbind(df, df[, 1])
            }
            names(df) = letters[1:ncol(df)]
            df
        })
        observeEvent(colParams__(), {
            dq_render_handsontable(
                "randomTable", 
                df0,
                filters = "T",
                page_size = NULL,
                width_align = TRUE,
                col_param = colParams__(),
                horizontal_scroll = TRUE
            )}
        )
    }
)

I noticed this problem is coming from the dq_render_handsontable function.

Below is a small segment of code from the dq_render_handsontable function. This part of the function is producing the error because it is running update_filters() without first adding filters for the new columns. I modified the code to add new filters to the list like so : filters <<- correct_filters(filters, shiny::isolate(dqv$full[, columns, drop = FALSE]))

This modification makes the app work.

else if (shiny::is.reactive(table_data)) {
          shiny::observeEvent(table_data(), {
              if (no_update) {
                  no_update <<- FALSE
              }
              else {
                  dqv$full <- as.data.frame(table_data())
                  # ----- I added the following 2 lines:
                  filters <<- correct_filters(filters, shiny::isolate(dqv$full[, 
                              columns, drop = FALSE]))
                  # ----- end of addition
                  if (!is.null(filters)) {
                    update_filters(dqv$full[, columns, drop = FALSE], 
                      filters, session)
                  }
              }
          }, ignoreInit = TRUE)
          dqv$full <- as.data.frame(shiny::isolate(table_data()))
      }

One issue with this mod is that it seems to make shiny::observeEvent(app_input[[id]], ...) run more frequently than it should.

I noticed that this observeEvent actually runs 2 + 2 * n times each time I update a cell in the table, where n is the number of times I update columns.

For example, if I add a column once (n=1), then try to edit a cell in the table, observeEvent(app_input[[id]], ...) will run twice and update dqv$full twice. Then it will run the observeEvent two more times, but the second two times nothing gets updated.

If I add another column so that (n=2), 2 + 2 * 2 = 4, so there will be 2 dqv$full update events (where the same data gets update twice. Then there will be 2 more observeEvents where dqv$full does not update. I assume !is.null(app_input[[id]]$changes$source is maybe NULL.

Do you know why this observeEvent runs more when I add more columns ? Also, do you think the way I fixed this bug is okay, or would you recommend something else?

Choosing option containing apostrophe

There is an issue when one tries to select an option that contains an apostrophe. It updates the component with the portion of the string before the apostrophe.

Desired option highlighted

After selecting the option

Column Widths

This is a very nice implementation of handsontable. Thank you!

I tried to change the column widths, would that be possible?

shinyApp(
  ui = fluidPage(dq_handsontable_output("myTable", 9L)),
  server = function(input, output, session) {
    hw <- c("Hello", "my", "funny", "world!")
    data <- data.frame(A = rep(hw, 100L), B = hw[c(2:4, 100L)], C = 1:100, D = 100:1)
    dq_render_handsontable("myTable", data,
                           filters = c("Sel", "Text", NA, "Auto"), sorting = TRUE,
                           page_size = c(17L, 5L, 500L, 1000L),
                           table_param = list(rowHeaders=FALSE,colWidths=c(50,50,50,50)),
                           col_param = list(list(col = 3L, format = "0.00")),
                                          
                           cell_param = list(list(row = 2:9, col = 2L, readOnly = TRUE))
    ) 
  }
)

update_autocomplete_input does not update value properly

when using update_autocomplete_input to update the value, the value shown in the input field is updated, but it is not transmitted to the corresponding input slot.

Example app:

library(shiny)
library(dqshiny)

words <- replicate(100, paste(sample(letters,5), collapse=""))

ui <- fluidPage(
  autocomplete_input("x", "vals", options = words),
  actionButton("y", "clear"),
  textOutput("sel")
)

server <- function(input, output, session) {

  output$sel <- renderText({
    input$x
  })
  observeEvent(input$y, {
    update_autocomplete_input(session, "x", value = words[1])
  })
}
shinyApp(ui, server)

Display full list of options regardless of match?

I recognize this may be a rare use case, but is there currently a way to display the full list of options rather than matching them based on input, or alternatively a way to override the way the options list filters things out? If not, is there another UI component that might fit this use case better?

For example, if my recommendations are "option1" and "option2", and i type "boat" I would like to still have the recommendations show under the text input.

Problem with single quote in `options`

I found that if the options in autocomplete_input contain single quotes ("Here 'tis", "Someone's problem"), the selection cannot be made (when clicking on the option, nothing happens).

An example:

library(shiny)
library(dqshiny)

opts <- c("Here 'tis", "Someone's problem", "OK text")


ui <- fluidPage(
  
  autocomplete_input("sel1", "Select", options = opts),
  
  tags$hr(),
  textOutput("txt_out")
  
  
)

server <- function(input, output, session) {
  
  output$txt_out <- renderText({
    
    input$sel1
    
  })
  
}

shinyApp(ui, server)

dq_render_handsontable not working when put in module

I'm having trouble getting a shiny module to display the dqshiny handsontable. I think it is a namespace issue, but really, I have no idea. The table data does not display in the module example below. I also include an example of the code working when not using modules.

Nonworking code example using module:

library(shiny)
library(rhandsontable)
library(dqshiny)

# module UI ->
myModuleUI <- function(id) {
  ns <- NS(id)
  tagList(
    fluidRow(
        dq_handsontable_output(ns("dataTable"))
    )
  )
}
# module server ->
myModule <- function(input, output, session, df) {
    dq_render_handsontable("dataTable", df)
}
# Use the module in an application
ui <- fluidPage(
  myModuleUI("myModule1")
)
server <- function(input, output, session) {
    df = data.frame(
        company = c('a', 'b', 'c', 'd'),
        bond = c(0.2, 1, 0.3, 0),
        equity = c(0.7, 0, 0.5, 1),
        cash = c(0.1, 0, 0.2, 0),
        stringsAsFactors = FALSE
    )
  callModule(myModule, "myModule1",  df = df)
}
shinyApp(ui, server)

The code below works without using modules:

shinyApp(
  ui = fluidPage(
    dq_handsontable_output("dataTable")
  ),
  server = function(input, output, session) {
    df = data.frame(
        company = c('a', 'b', 'c', 'd'),
        bond = c(0.2, 1, 0.3, 0),
        equity = c(0.7, 0, 0.5, 1),
        cash = c(0.1, 0, 0.2, 0),
        stringsAsFactors = FALSE
    )
    dq_render_handsontable("dataTable", df)
  }
)