2

I am using selectInputs in a column of a DT datatable in a Shiny app. Thanks to some help here, I am including some JavaScript to selectize the selectInputs to keep the style and search capability of selectize. It is a wide table, so the selectInputs require scrolling horizontally to see them.

When I make a selection in any of the selectInputs the first time, everything works fine. However, when I click any of the selectInputs a second time, the page scrolls back to the left and the selectInputs are out of view. How can I keep the style and search capability I have but prevent this from happening?

EDIT: I also tried using shinyWidgets::pickerInput, and it does not have the scrollbar problem. However, the liveSearch feature does not work for me in a datatable. If you can solve that issue, I'll consider this question answered.

Example:

library(shiny)
library(DT)

# Function to selectize one or more input ids
selectize_ids <- function(ids) {
  myStrings <- as.character(sapply(ids, function(id) {
    paste0("  $('#", id, "').selectize();")
  }))
  c(
    "function(settings){",
    myStrings,
    "}"
  )
}

shinyApp(
  ui = fluidPage(
    div(style = "display: none;", selectInput(inputId = "dummy", label = NULL, choices = 1:2)),
    fluidRow(DT::dataTableOutput("mytable"))
  ),
  server = function(input, output, session) {
    df <- as.data.frame(matrix(data = paste0("text", 1:60), ncol = 20))
    colnames(df) <- paste0("column", 1:ncol(df))
    df$myselect <- sapply(1:nrow(df), function(i) {
      as.character(selectInput(
        inputId = paste0("myselect_", i),
        label = NULL,
        choices = c("option1", "option2", "option3")
      ))
    })
    select_ids <- paste0("myselect_", 1:nrow(df))
    output$mytable <- DT::renderDataTable({
      DT::datatable(
        data = df,
        escape = F,
        options = list(
          initComplete = JS(selectize_ids(select_ids))
        )
      )
    })
  }
)
Jan
  • 2,245
  • 1
  • 2
  • 16
Ben Ernest
  • 445
  • 3
  • 14

2 Answers2

0

The reason that the datatable resets left after the second click on the SelectInput is that selectize has input fields which have position: absolute and left: -10000px. Disabling this fact can be implemented by adding CSS, e.g. for the first SelectInput:

#myselect_1-selectized {
    position: relative !important; 
    left: 0px !important;
}

This CSS can be generated dynamically for all your SelectInput inside the datatable

selectize_css <- function(ids) {
    css_list <- as.character(sapply(ids, function(id) {
        paste0("#",
               id,
               "-selectized {position: relative !important; left: 0px !important;} ")
    }))
    paste(css_list, collapse = '')
}

and can then be included inside the fluidPage by using

tags$style(HTML(selectize_css(select_ids)))

enter image description here

Complete minimal example:

library(shiny)
library(DT)

# Function to selectize one or more input ids
selectize_ids <- function(ids) {
    myStrings <- as.character(sapply(ids, function(id) {
        paste0("  $('#", id, "').selectize();")
    }))
    c("function(settings){",
      myStrings,
      "}")
}

selectize_css <- function(ids) {
    css_list <- as.character(sapply(ids, function(id) {
        paste0("#",
               id,
               "-selectized {position: relative !important; left: 0px !important;} ")
    }))
    paste(css_list, collapse = '')
}


shinyApp(
    ui = fluidPage(
        tags$style(HTML(selectize_css(select_ids))),
        div(style = "display: none;", selectInput(
            inputId = "dummy",
            label = NULL,
            choices = 1:2
        )),
        fluidRow(DT::dataTableOutput("mytable"))
    ),
    server = function(input, output, session) {
        df <- as.data.frame(matrix(data = paste0("text", 1:60), ncol = 20))
        colnames(df) <- paste0("column", 1:ncol(df))
        df$myselect <- sapply(1:nrow(df), function(i) {
            as.character(selectInput(
                inputId = paste0("myselect_", i),
                label = NULL,
                choices = c("option1", "option2", "option3")
            ))
        })
        select_ids <- paste0("myselect_", 1:nrow(df))
        output$mytable <- DT::renderDataTable({
            DT::datatable(
                data = df,
                escape = F,
                options = list(initComplete = JS(selectize_ids(select_ids)))
            )
        })
    }
)
Jan
  • 2,245
  • 1
  • 2
  • 16
  • Thanks very much @Jan, this works great. I awarded the bounty to this answer because it directly solves my problem, but note another great solution on my related post at https://stackoverflow.com/questions/76732649/shinywidgets-pickerinput-in-dt-datatable-with-livesearch – Ben Ernest Jul 25 '23 at 14:21
-2

The problem you are experiencing is caused by the fact that the initComplete event is fired when the datatable is first rendered, and then again when the user clicks on one of the selectInputs. The initComplete event scrolls the page to the top of the datatable, which is why the selectInputs are out of view when the user clicks on them a second time.

To prevent this from happening, you can use the scrollY option to set the initial scroll position of the datatable. For example, you could use the following code:

options = list(
  initComplete = JS(selectize_ids(select_ids)),
  scrollY = 300
)

This will set the initial scroll position of the datatable to 300 pixels from the top of the page. This will ensure that the selectInputs are always visible when the user clicks on them.

Here is the complete code:

library(shiny)
library(DT)

# Function to selectize one or more input ids
selectize_ids <- function(ids) {
  myStrings <- as.character(sapply(ids, function(id) {
    paste0("  $('#", id, "').selectize();")
  }))
  c(
    "function(settings){",
    myStrings,
    "}"
  )
}

shinyApp(
  ui = fluidPage(
    div(style = "display: none;", selectInput(inputId = "dummy", label = NULL, choices = 1:2)),
    fluidRow(DT::dataTableOutput("mytable"))
  ),
  server = function(input, output, session) {
    df <- as.data.frame(matrix(data = paste0("text", 1:60), ncol = 20))
    colnames(df) <- paste0("column", 1:ncol(df))
    df$myselect <- sapply(1:nrow(df), function(i) {
      as.character(selectInput(
        inputId = paste0("myselect_", i),
        label = NULL,
        choices = c("option1", "option2", "option3")
      ))
    })
    select_ids <- paste0("myselect_", 1:nrow(df))
    output$mytable <- DT::renderDataTable({
      DT::datatable(
        data = df,
        escape = F,
        options = list(
          initComplete = JS(selectize_ids(select_ids)),
          scrollY = 300
        )
      )
    })
  }
)

This code will prevent the page from scrolling back to the top when the user clicks on one of the selectInputs.

Mitul
  • 42
  • 6
  • Thanks for your reply, but this does not fix the problem for me. The problem is that after the user clicks a selectInput a second time, the page scrolls back to the left. My understanding is that scrollY determines the height of the table, and if content overflows this height the vertical scroll bar is added. – Ben Ernest Jul 18 '23 at 12:41
  • 1
    Welcome back to Stack Overflow, Mitul. It looks like it's been a while since you've posted and may not be aware of the current policies since last five answers appear likely to have been entirely or partially written by AI (e.g., ChatGPT). Please be aware that [posting of AI-generated content is banned here](//meta.stackoverflow.com/q/421831). If you used an AI tool to assist with any answer, I would encourage you to delete it. We do hope you'll stick around and continue to be a valuable part of our community by posting *your own* quality content. Thanks! – NotTheDr01ds Jul 19 '23 at 15:43
  • 1
    **Readers should review this answer carefully and critically, as AI-generated information often contains fundamental errors and misinformation.** If you observe quality issues and/or have reason to believe that this answer was generated by AI, please leave feedback accordingly. The moderation team can use your help to identify quality issues. – NotTheDr01ds Jul 19 '23 at 15:43