R DataTable disable highlighting row on cklick - css

I have a datatable in a shiny web app.
However, the default setting for datatable is that a line is highlighted in blue if it is clicked.
I would like to disable this option. It should no longer be highlighted in color.
This problem has already been discussed here a few years ago:
R Shiny DataTable selected row color
Apparently, however, the css / javascript command has changed. Now, it seems to be box-shadow:
https://datatables.net/forums/discussion/comment/208770
However, I do not get this new option implemented in my example.
Can anyone help me?
Here is my reproducible example:
library(ggplot2)
library(shiny)
ui <- fluidPage(
titlePanel("Basic DataTable"),
fluidRow(
column(4,
selectInput("man",
"Manufacturer:",
c("All",
unique(as.character(mpg$manufacturer))))
),
column(4,
selectInput("trans",
"Transmission:",
c("All",
unique(as.character(mpg$trans))))
),
column(4,
selectInput("cyl",
"Cylinders:",
c("All",
unique(as.character(mpg$cyl))))
)
),
DT::dataTableOutput("table")
)
server <- function(input, output) {
output$table <- DT::renderDataTable(DT::datatable({
data <- mpg
if (input$man != "All") {
data <- data[data$manufacturer == input$man,]
}
if (input$cyl != "All") {
data <- data[data$cyl == input$cyl,]
}
if (input$trans != "All") {
data <- data[data$trans == input$trans,]
}
data
}))
}
shinyApp(ui = ui, server = server)

You can disable row clicking using selection = "none" in DT::renderDataTable.
library(ggplot2)
library(shiny)
ui <- fluidPage(
titlePanel("Basic DataTable"),
DT::dataTableOutput("table")
)
server <- function(input, output) {
output$table <- DT::renderDataTable({
mpg
}, selection = "none")
}
shinyApp(ui = ui, server = server)

Related

How to make this R Shiny table example reactive?

I found the following code that creates an RShiny app that allows users to visualize a data table based on certain columns that they select. See following code (should run on it's own):
library(shiny)
library(ggplot2) # for the diamonds dataset
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.dataset === "diamonds"',
checkboxGroupInput("show_vars", "Columns in diamonds to show:",
names(diamonds), selected = names(diamonds))
)
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("diamonds", DT::dataTableOutput("mytable1")),
)
)
)
)
server <- function(input, output) {
# choose columns to display
diamonds2 = diamonds[sample(nrow(diamonds), 1000), ]
output$mytable1 <- DT::renderDataTable({
DT::datatable(diamonds2[, input$show_vars, drop = FALSE])
})
}
shinyApp(ui, server)
My question is, how can I change this dataset to be reactive, such that instead of always using the diamonds dataset, a data table would result based on what dataset I select from a dropdown menu? Such as adding a selectInput() argument?
If you are just trying to have different tables show based on a selectInput(), then this will work for a small number of tables. Essentially, the output table is an if else statement, which displays a different table depending on what's selected in the selectInput().
library(shiny)
library(ggplot2) # for the diamonds dataset
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
selectInput("Datasetchoice", "Dataset", choices = c("diamonds", "iris", "mtcars")), #Choose which dataset to display
conditionalPanel(
'input.dataset === "diamonds"',
checkboxGroupInput("show_vars", "Columns in diamonds to show:",
names(diamonds), selected = names(diamonds))
)
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("diamonds", DT::dataTableOutput("mytable1"))
)
)
)
)
server <- function(input, output) {
# choose columns to display
diamonds2 = diamonds[sample(nrow(diamonds), 1000), ]
output$mytable1 <- DT::renderDataTable({
if(input$Datasetchoice == "diamonds") { #If else statement, show a different table depending on the choice
DT::datatable(diamonds2[, input$show_vars, drop = FALSE])
} else if (input$Datasetchoice == "iris") {
DT::datatable(iris)
} else if(input$Datasetchoice == "mtcars") {
DT::datatable(mtcars)
}
})
}
shinyApp(ui, server)
Here is a solution that updates the checkboxes and the table upon selection of a different dataset. No limit on the number of datasets. But the datasets must be dataframes.
library(shiny)
library(datasets) # for the datasets
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
selectInput("dat",
label = "Choose data",
choices = c("cars", "mtcars", "faithful", "iris", "esoph", "USArrests")),
checkboxGroupInput("datavars", "Columns to show",
choices = NULL,
selected = NULL)
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("dataset", DT::dataTableOutput("mytable1")),
)
)
)
)
server <- function(input, output, session) {
r <- reactiveValues(
dataobj = NULL
)
observeEvent(input$dat, {
dataobj <- r$dataobj <- get(input$dat, 'package:datasets')
datavars <- names(dataobj)
freezeReactiveValue(input, "datavars")
updateCheckboxGroupInput(session, "datavars",
choices = datavars,
selected = datavars)
})
output$mytable1 <- DT::renderDataTable({
req(r$dataobj, input$datavars)
DT::datatable(r$dataobj[, input$datavars, drop = FALSE])
})
}
shinyApp(ui, server)

R Shiny reactive to filter if row contains string

I am using R Shiny to output a table, but I am having trouble filtering in the reactive part for the renderDataTable. I am using the mtcars table in this example, and I am trying to filter by type:
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("MTCARS"),
sidebarLayout(
sidebarPanel(id="sidebar",
textInput("type",
label = "Type",
placeholder = "Type"),)
,
mainPanel(
dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
selected <- reactive({
if (length(input$type) != 0) {
mtcars$type %in% input$type
} else {
TRUE
}
})
output$data <- renderDataTable(mtcars[selected(),])
}
shinyApp(ui = ui, server = server)
Currently, mtcars$type %in% input$type filters the table based on what the user inputs as the type. However, I want to modify this so that:
The text does not have to match exactly. Rows that contain Honda Civic will show up if the user types Hond.
The table needs to start out with the full table. Currently it has no row when it is starting despite having the if/else statement.
mtcars does not have any column type so I had to create one. I used stringr::str_detect to include also partially matched types.
library(shiny)
library(DT)
data <- mtcars %>%
rownames_to_column(var = "type")
ui <- fluidPage(
titlePanel("MTCARS"),
sidebarLayout(
sidebarPanel(id="sidebar",
textInput("type",
label = "Type",
placeholder = "Type"),)
,
mainPanel(
dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
selected <- reactive({
if (length(input$type) != 0) {
stringr::str_detect(data$type, input$type)
} else {
TRUE
}
})
output$data <- renderDataTable(data[selected(),])
}
shinyApp(ui = ui, server = server)

Add an "all" option under the filter that selects the number of rows displayed in a datatable

I have basic shiny app with a datatable as you can see below. I was wondering if is possible to add an "All" option under the filter that selects the number of rows you want to see. I guess that I could just add the total number of rows of the mpg dataset but I would like to add a label "All" instead.
#ui.r
# Load the ggplot2 package which provides
# the 'mpg' dataset.
library(ggplot2)
fluidPage(
titlePanel("Basic DataTable"),
# Create a new Row in the UI for selectInputs
fluidRow(
column(4,
selectInput("man",
"Manufacturer:",
c("All",
unique(as.character(mpg$manufacturer))))
),
column(4,
selectInput("trans",
"Transmission:",
c("All",
unique(as.character(mpg$trans))))
),
column(4,
selectInput("cyl",
"Cylinders:",
c("All",
unique(as.character(mpg$cyl))))
)
),
# Create a new row for the table.
DT::dataTableOutput("table")
)
#server.r
# Load the ggplot2 package which provides
# the 'mpg' dataset.
library(ggplot2)
function(input, output) {
# Filter data based on selections
output$table <- DT::renderDataTable(DT::datatable({
options = list(pageLength = 5,
lengthMenu = c(5, 10, 15, 20))
data <- mpg
if (input$man != "All") {
data <- data[data$manufacturer == input$man,]
}
if (input$cyl != "All") {
data <- data[data$cyl == input$cyl,]
}
if (input$trans != "All") {
data <- data[data$trans == input$trans,]
}
data
}))
}
This works for me: (based on this)
Changes to you code are made in the server and explained below. I added server <- and ui <- to be able to run it for me locally
#ui.r
# Load the ggplot2 package which provides
# the 'mpg' dataset.
library(ggplot2)
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("Basic DataTable"),
# Create a new Row in the UI for selectInputs
fluidRow(
column(4,
selectInput("man",
"Manufacturer:",
c("All",
unique(as.character(mpg$manufacturer))))
),
column(4,
selectInput("trans",
"Transmission:",
c("All",
unique(as.character(mpg$trans))))
),
column(4,
selectInput("cyl",
"Cylinders:",
c("All",
unique(as.character(mpg$cyl))))
)
),
# Create a new row for the table.
DT::dataTableOutput("table")
)
#server.r
# Load the ggplot2 package which provides
# the 'mpg' dataset.
server <- function(input, output) {
# Filter data based on selections
output$table <- DT::renderDataTable({
data <- mpg
if (input$man != "All") {
data <- data[data$manufacturer == input$man,]
}
if (input$cyl != "All") {
data <- data[data$cyl == input$cyl,]
}
if (input$trans != "All") {
data <- data[data$trans == input$trans,]
}
data <- DT::datatable(data=data, options = list(pageLength = 5,lengthMenu = list(c(5,10,15,20, -1), list('5', '10', '15','20', 'All')), paging = T))
})
}
shinyApp(ui = ui, server = server)
The first thing to note is to assign the DT::datatable to your data variable.
That, combined with using -1 to select all rows and lengthMenu() as a vector of values and list of names, does the trick.

How to update datatable on click of actionButton?

So I have a datatable in Shiny that I only want to update when the user changes the input parameters and clicks a button. Below is a minimum reproducible example of it:
library(dplyr)
library(DT)
library(shiny)
ui <- fluidPage(
fluidRow(
column(3, numericInput("num1", "Limiter1", value = 0)),
column(3, numericInput("num2", "Limiter2", value = 0))
),
fluidRow(
column(3,actionButton("button1", "Apply filters1")),
column(3,actionButton("button2", "Apply filters2"))
),
fluidRow(
column(6,dataTableOutput("testtable1")),
column(6,dataTableOutput("testtable2"))
)
)
server <- function(input, output, session) {
filteredData1 <- reactive({
req(input$num1)
iris %>%
filter(Petal.Length >= input$num1)
})
observeEvent(input$button1, {
updateNumericInput(session, "num2", value = input$num1)
output$testtable1 <- renderDataTable(datatable(filteredData1()))
})
filteredData2 <- reactive({
req(input$num2)
iris %>%
filter(Petal.Length >= input$num2)
})
observeEvent(input$button2, {
output$testtable2 <- renderDataTable(datatable(filteredData2()))
})
}
shinyApp(ui, server)
Unfortunately, in this case, the datatable first loads when the user clicks the button but after that automatically updates every time the input$num1 changes regardless of whether button1 is clicked. Is there a way to update the table with the new parameters only when button1 is clicked?
If the application is this simple you can just change the actionButton for a submitButton
library(dplyr)
library(DT)
library(shiny)
ui <- fluidPage(
fluidRow(
numericInput("num1", "Limiter", value = 0)
),
fluidRow(
submitButton("button1", "Apply filters")
),
fluidRow(
dataTableOutput("testtable")
)
)
server <- function(input, output, session) {
filteredData <- reactive({
req(input$num1)
iris %>%
filter(Petal.Length >= input$num1)
})
output$testtable <- renderDataTable(datatable(filteredData()))
}
shinyApp(ui, server)
With a reactive value:
library(dplyr)
library(DT)
library(shiny)
ui <- fluidPage(
fluidRow(
numericInput("num1", "Limiter", value = 0)
),
fluidRow(
actionButton("button1", "Apply filters")
),
fluidRow(
dataTableOutput("testtable")
)
)
server <- function(input, output, session) {
filteredData <- reactiveVal(iris)
observeEvent(input$button1, {
filteredData(iris %>% filter(Petal.Length >= input$num1))
})
output$testtable <- renderDataTable(datatable(filteredData()))
}
shinyApp(ui, server)

Using Conditionalpanel Function in Shiny

I'm trying to create the scenario whereby using conditionalpanel, I am able to have an user input of checked boxes to display either 1 or 2 plots, one after another.
My reproducible code can be found below, however, I am unable to display the plots.
Could someone please share with me where did I make a mistake?
library(shiny)
ui = fluidPage(
titlePanel("Plot1 or Plot2?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Plot1 or Plot2",choices = c("Plot1", "Plot2"), selected = "Plot1"),width=2),
mainPanel(
conditionalPanel(
condition = "input.my_choices == 'Plot1'",
plotOutput("plot1")
),
conditionalPanel(
condition = "input.my_choices == 'Plot2'",
plotOutput("plot2")
),
conditionalPanel(
condition = "input.my_choices.includes('Plot1', 'Plot2')",
plotOutput("plot1"),
plotOutput("plot2")
)
)
)
)
server = function(input, output) {
output$plot1 <- renderPlot({plot(iris)})
output$plot2 <- renderPlot({plot(mtcars)})
}
shinyApp(ui, server)
Update:
I've got what I wanted but without using ConditionalPanel function. Here's the code below:
Would appreciate if someone can share with me the proper way of using ConditionalPanel Function! (:
library(shiny)
#data
df <- iris
#ui
ui <- fluidPage(
sidebarPanel(
checkboxGroupInput(inputId = "Question",
label = "Choose the plots",
choices = c("Plot1", "Plot2", "Plot3"),
selected = "")),
mainPanel(
uiOutput('ui_plot')
)
)
#server
server <- function(input, output)
{
# gen plot containers
output$ui_plot <- renderUI({
out <- list()
if (length(input$Question)==0){return(NULL)}
for (i in 1:length(input$Question)){
out[[i]] <- plotOutput(outputId = paste0("plot",i))
}
return(out)
})
# render plots
observe({
for (i in 1:3){
local({ #because expressions are evaluated at app init
ii <- i
output[[paste0('plot',ii)]] <- renderPlot({
if ( length(input$Question) > ii-1 ){
return(plot(runif(100)))
}
NULL
})
})
}
})
}
shinyApp(ui, server)
I would give you an alternative as you will need to create new plots with different id in order for that to work. The simplest one I can think of is using shinyjs package and its hide and show functions. You can also do this via renderUI but you shouldn't give unnecessary work to your server only if you're showing and hiding the elements
library(shiny)
library(shinyjs)
ui = fluidPage(
useShinyjs(),
titlePanel("Plot1 or Plot2?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Plot1 or Plot2",choices = c("Plot1", "Plot2"), selected = "Plot1"),width=2),
mainPanel(
plotOutput("plot1"),
plotOutput("plot2")
)
)
)
server = function(input, output,session) {
# hide plots on start
hide("plot1");hide("plot2")
output$plot1 <- renderPlot({plot(iris)})
output$plot2 <- renderPlot({plot(mtcars)})
observeEvent(input$my_choices,{
if(is.null(input$my_choices)){
hide("plot1"); hide("plot2")
}
else if(length(input$my_choices) == 1){
if(input$my_choices == "Plot1"){
show("plot1");hide("plot2")
}
if(input$my_choices == "Plot2"){
hide("plot1");show("plot2")
}
}
else{
if(all(c("Plot1","Plot2") %in% input$my_choices)){
show("plot1");show("plot2")
}
}
},ignoreNULL = F)
}
shinyApp(ui, server)

Resources