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)
Related
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)
Tell me in R Shiny, there are two action buttons. I want to update the data according to the button I press. But for some reason it only responds to the second button and not to the first button. What is the solution?
if (interactive()) {
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("action_1", "Get 1"),
actionButton("action_2", "Get 2"),
),
mainPanel(
textOutput("result")
),
)
)
server <- function(input, output) {
data <- eventReactive(input$action_1, 1)
data <- eventReactive(input$action_2, 2)
output$result <- renderText(data())
}
shinyApp(ui, server)
}
The second line of this piece of code overwrites the first one:
data <- eventReactive(input$action_1, 1)
data <- eventReactive(input$action_2, 2)
You can do:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("action_1", "Get 1"),
actionButton("action_2", "Get 2"),
),
mainPanel(
textOutput("result")
),
)
)
server <- function(input, output) {
result <- reactiveVal()
observeEvent(input$action_1, { result(1) })
observeEvent(input$action_2, { result(2) })
output$result <- renderText(result())
}
shinyApp(ui, server)
}
If you have many buttons you can simply add a class to it and some simple JS to monitor the last click like so:
library(shiny)
monitorJS <- "$(document).on('click', '.monitor', function () {
Shiny.onInputChange('last_click',this.id);
});"
ui <- fluidPage(
tags$head(tags$script(monitorJS)),
sidebarLayout(
sidebarPanel(
uiOutput("buttons")
),
mainPanel(
textOutput("result")
),
)
)
server <- function(input, output, session) {
output$buttons <- renderUI({
a <- list()
for(i in 1:200){
id <- paste0("action_",i)
name <- paste0("Get ",i)
a[[i]] <- actionButton(id, name, class = "monitor")
}
tagList(a)
})
data <- eventReactive(input$last_click,{
# Your click ligic here
value <- gsub("action_","",input$last_click)
value
})
output$result <- renderText({
data()
})
}
shinyApp(ui, server)
I need some help I want to show my reactive tabPanel in a popup with the shinyBS package.
Everything seems to work well except the creation of popup.
I am inspired by :
1) R Shiny - add tabPanel to tabsetPanel dynamically (with the use of renderUI)
2)Show dataTableOutput in modal in shiny app
My code :
library(shiny)
library(DT) # need datatables package
library(shinyBS)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("decision", label = "Choose your specie",
choices = iris$Species,
selected = "mtcars", multiple = TRUE)
),
mainPanel(
uiOutput('mytabs')
)
)
))
server <- shinyServer(function(input, output, session) {
output$mytabs <- renderUI({
nTabs = length(input$decision)
# create tabPanel with datatable in it
myTabs = lapply(seq_len(nTabs), function(i) {
tabPanel(paste0("dataset_", input$decision[i]),
tableOutput(paste0("datatable_",i))
)
})
do.call(tabsetPanel, myTabs)
})
# create datatables in popup ?
bsModal(
id = "modalExample",
"yb",
observe(
lapply(seq_len(length(input$decision)), function(i) {
output[[paste0("datatable_",i)]] <- renderTable({
as.data.frame(iris[iris$Species == input$decision[i], ])
})
})
)
)
})
shinyApp(ui, server)
Thanks in advance for any help !
bsModal is an UI element, so you need to put it into you UI. Within this modal you want to show the tabPanels (rendered via uiOutput), so all you need to do is to place your bsModal into the UI, and within this bsModal you have your uiOutput. All what is left is to add an actionButton which shows the modal.
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("decision", label = "Choose your species",
choices = unique(iris$Species),
selected = unique(iris$Species), multiple = TRUE),
actionButton("show", "Show")
),
mainPanel(
bsModal("modalExample",
"myTitle",
"show",
uiOutput('mytabs')
)
)
)
))
server <- shinyServer(function(input, output, session) {
output$mytabs <- renderUI({
nTabs <- length(input$decision)
# create tabPanel with datatable in it
myTabs <- lapply(seq_len(nTabs), function(i) {
tabPanel(paste0("dataset_", input$decision[i]),
tableOutput(paste0("datatable_",i))
)
})
do.call(tabsetPanel, myTabs)
})
# create datatables in popup ?
observe(
lapply(seq_len(length(input$decision)), function(i) {
output[[paste0("datatable_",i)]] <- renderTable({
as.data.frame(iris[iris$Species == input$decision[i], ])
})
})
)
})
shinyApp(ui, server)
It's not clear to me what you want to do (maybe #thothal has the right answer). What about this app ?
library(shiny)
library(DT) # need datatables package
library(shinyBS)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("decision", label = "Choose your specie",
choices = iris$Species,
selected = "mtcars", multiple = TRUE),
actionButton("trigger_modal", "View modal")
),
mainPanel(
uiOutput("modal")
# uiOutput('mytabs')
)
)
))
server <- shinyServer(function(input, output, session) {
# output$mytabs <- renderUI({
# nTabs = length(input$decision)
# # create tabPanel with datatable in it
# myTabs = lapply(seq_len(nTabs), function(i) {
# tabPanel(paste0("dataset_", input$decision[i]),
# tableOutput(paste0("datatable_",i))
# )
# })
#
# do.call(tabsetPanel, myTabs)
# })
# create datatables in popup ?
observe(
lapply(seq_len(length(input$decision)), function(i) {
output[[paste0("datatable_",i)]] <- renderTable({
as.data.frame(iris[iris$Species == input$decision[i], ])
})
})
)
output$modal <- renderUI({
bsModal(
id = "modalExample",
"yb",
trigger = "trigger_modal",
do.call(tagList, lapply(seq_along(input$decision), function(i){
tableOutput(paste0("datatable_",i))
}))
)
})
})
shinyApp(ui, server)
I'm trying to append a value taken from an input (in the present case input$n) to a list (in the present case the variable "keyword_list"), when the user presses the an action button (in the present case the button input$goButton).
ui.R
library(shiny)
pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
#numericInput("n", "N:", min = 0, max = 100, value = 50),
textInput("n", "Caption", "Enter next keyword"),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel.")
),
mainPanel(
verbatimTextOutput("nText"),
dataTableOutput('mytable')
)
)
})
server.R
library(shiny)
# Define server logic required to summarize and view the selected
# dataset
function(input, output,session) {
#prepare data
keyword_list <- matrix()
makeReactiveBinding('keyword_list')
observe({
if (input$goButton == 0)
return()
isolate({
keyword_list <- append(keyword_list,input$n) })
})
ntext <- eventReactive(input$goButton, {
input$n
})
output$nText <- renderPrint({
#input$n
ntext()
})
output$mytable = renderDataTable({
as.data.frame(keyword_list)
})
}
How about this:
library(shiny)
ui <- pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
#numericInput("n", "N:", min = 0, max = 100, value = 50),
textInput("n", "Caption", "Enter next keyword"),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel.")
),
mainPanel(
verbatimTextOutput("nText"),
dataTableOutput('mytable')
)
)
})
library(shiny)
# Define server logic required to summarize and view the selected
# dataset
server <- function(input, output,session) {
global <- reactiveValues(keyword_list = "")
observe({
if (input$goButton == 0)
return()
isolate({
global$keyword_list <- append(global$keyword_list, input$n)
})
})
ntext <- eventReactive(input$goButton, {
input$n
})
output$nText <- renderPrint({
#input$n
ntext()
})
output$mytable = renderDataTable({
as.data.frame(global$keyword_list)
})
}
shinyApp(ui, server)
i would like to remove the initial value (selected=) from selectizeInput when the user click on the widget.
Here is a sample code:
library(shiny)
library(dplyr)
ui= fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(inputId= "cyl", label= "cyl",
choices= NULL,
selected= sort(unique(mtcars$cyl))[1],
multiple=T)
),
mainPanel(
tableOutput("tab")
)
)
)
server= function(input, output,session) {
updateSelectizeInput(session = session,inputId ="cyl",choices=sort(unique(mtcars$cyl)),selected=sort(unique(mtcars$cyl))[1], server = TRUE)
df_filtered= reactive({
mtcars %>%
{if (is.null(input$cyl)) . else filter(., cyl %in% input$cyl)}
})
output$tab= renderTable(df_filtered())
}
shinyApp(ui, server)
Just a bit of explanation on base of sample code:
The initial selected value in selectizeInput "cyl" is 4. When the user press on this widget, i would like that the value 4 is removed and the selected option is cleared. Any ideas?
*I have used the function updateSelectizeInput in server because in my shiny app choice selection is very big leading to too long loading time
You can use shinyjs::onclick to call updateSelectizeInput when the user clicks on the selectize field, eg:
library(shiny)
library(dplyr)
library(shinyjs)
ui= fluidPage(
useShinyjs(),
sidebarLayout(
sidebarPanel(
selectizeInput(inputId= "cyl", label= "cyl",
choices= NULL,
selected= sort(unique(mtcars$cyl))[1],
multiple=T)
),
mainPanel(
tableOutput("tab")
)
)
)
server= function(input, output,session) {
updateSelectizeInput(session = session,inputId ="cyl",choices=sort(unique(mtcars$cyl)),selected=sort(unique(mtcars$cyl))[1], server = TRUE)
df_filtered= reactive({
mtcars %>%
{if (is.null(input$cyl)) . else filter(., cyl %in% input$cyl)}
})
output$tab= renderTable(df_filtered())
onclick("cyl", {
updateSelectizeInput(session, "cyl", selected = "")
})
}
shinyApp(ui, server)