I don't understand why my actionButton is not triggered, when I click on it nothing happen. After having tried several things I don't know what to do...
My app:
ui :
navbarPage("page", id = "nav",
tabPanel("tab",
navbarPage(title = icon("caret-right"), id = "nav",
tabPanel("Geocodage adresse",
fluidRow(style = "padding:20px;",
textInput("geocod_Adress", "Adresse a geocoder:"),
actionButton("geocod_Geocod", "Calcul des coordonnees", icon("compass")),
verbatimTextOutput("coordonnees")
)
)
)
)
)
Server:
function(input, output, session) {
ntext < - eventReactive(input$geocod_Geocod, {
return(input$geocod_Adress)
})
output$nText < - renderText({
ntext()
})
}
Instead of coordonnees, it should be nText, and not ntext, since you want to refer to the renderText, and not to the eventReactive. Working example:
library(shiny)
ui <- fluidPage(
fluidRow(style = "padding:20px;",
textInput("geocod_Adress", "Adresse a geocoder:"),
actionButton("geocod_Geocod", "Calcul des coordonnees", icon("compass")),
verbatimTextOutput("nText")
)
)
server <-function(input, output, session) {
ntext <- eventReactive(input$geocod_Geocod, {
return(input$geocod_Adress)
})
output$nText <- renderText({
ntext()
})
}
shinyApp(ui,server)
Related
I am trying to pass a value assigned in an observeEvent to another observeEvent in shiny. In addition to the codes below, I also attempted to use my_dynamic_table(), but unfortunately I couldn't achieve my goal.
My aim is to have "Something 1" on the screen if my_dynamic_table is not empty.
library(shiny)
library(DT)
my_dynamic_table = data.frame(NA)
shinyApp(
ui = fluidPage(
actionButton("call","Call"),
actionButton("save","Save"),
verbatimTextOutput('text'),
DT::dataTableOutput('table_out')
),
server = function(input, output, session) {
observeEvent (input$call ,{
my_dynamic_table <- mtcars
output$table_out <- DT::renderDataTable(
my_dynamic_table
) # renderDataTable : table_out
})
observeEvent (input$save,{
output$text <- renderText({
if(nrow(my_dynamic_table)>1) {
"Something 1"
}else {
"Something 2"
}
}) #renderText
}) #observeEvent
} #server
) #shinyApp
One option to achieve that would be to use a reactiveVal or reactiveValues:
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
actionButton("call", "Call"),
actionButton("save", "Save"),
verbatimTextOutput("text"),
DT::dataTableOutput("table_out")
),
server = function(input, output, session) {
my_dynamic_table <- reactiveVal(data.frame())
observeEvent(input$call, {
my_dynamic_table(mtcars)
output$table_out <- DT::renderDataTable(
my_dynamic_table()
)
})
observeEvent(input$save, {
output$text <- renderText({
if (nrow(my_dynamic_table()) > 0) {
"Something 1"
} else {
"Something 2"
}
}) # renderText
}) # observeEvent
} # server
) # shinyApp
While I do think that using reactiveValues is a good solution to this problem, I'd say its never a good idea to use an output inside an observeEvent(). I would rearrange the code as below. In the observeEvent we observe the action buttons, and when clicked, update the reactiveValues. Those are again intermediates for your output.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
actionButton("call","Call"),
actionButton("save","Save"),
verbatimTextOutput('text'),
DT::dataTableOutput('table_out')
),
server = function(input, output, session) {
my <- reactiveValues(dynamic_table = data.frame(NA),
text = NA)
observeEvent(input$call, {
my$dynamic_table <- mtcars
})
observeEvent(input$save, {
if (nrow(my$dynamic_table) > 1) {
my$text <- "Something 1"
} else {
my$text <-"Something 2"
}
})
output$text <- renderText({
req(input$save)
my$text
})
output$table_out <- DT::renderDataTable({
req(input$call)
my$dynamic_table
})
} #server
) #shinyApp
I have a simple shiny app which I would like to show a warning if user input is bigger than a threshold.
library(shiny)
library(shinyalert)
ui <- fluidPage(
numericInput("obs", "Observations:", 1),
verbatimTextOutput("value")
)
server <- function(input, output) {
observeEvent(input$obs,{
if(!is.na(input$obs) && input$obs >10){
shinyalert("warning!", "input too big", type = "warning")
}
})
output$value <- renderText({ input$obs })
}
shinyApp(ui, server)
if user is not quick enough to provide input, let say for the input$obs = 110 we have 1 second delay between putting the second and third value the popups warning will appear !
How should I fix this ?
Use shinyCatch from spsComps to make your life easier
library(shiny)
library(spsComps)
ui <- fluidPage(
numericInput("obs", "Observations:", 1),
verbatimTextOutput("value")
)
server <- function(input, output) {
output$value <- renderText({
shinyCatch({
if(!is.na(input$obs) && input$obs >10) warning("input too big")
}, blocking_level = "warning", prefix = "")
input$obs
})
}
shinyApp(ui, server)
when blocking_level = "warning" is specified shinyCatch blocks following code in the renderText expression. So when your number is larger than 10, the new input$obs will not be rendered.
Here's what users see
Here's what developers see in the console
You can use showNotification() from shiny itself:
library(shiny)
ui <- fluidPage(
numericInput("obs", "Observations:", 1),
verbatimTextOutput("value")
)
server <- function(input, output) {
observeEvent(input$obs,{
if(!is.na(input$obs) && input$obs >10){
showNotification(
ui = tags$h4("Input Too Big!"),
type = "warning"
)
}
})
output$value <- renderText({ input$obs })
}
shinyApp(ui, server)
Or {shinytoastr}:
library(shiny)
library(shinytoastr)
ui <- fluidPage(
shinytoastr::useToastr(),
numericInput("obs", "Observations:", 1),
verbatimTextOutput("value")
)
server <- function(input, output) {
observeEvent(input$obs,{
if(!is.na(input$obs) && input$obs >10){
shinytoastr::toastr_warning(
message = "Decrease it.",
title = "Input too big!"
)
}
})
output$value <- renderText({ input$obs })
}
shinyApp(ui, server)
Or {spsComps} as #lz100 mentioned. The choice is yours.
I have the shiny app below and I would like to toggle between a plot (default) and its table using the same actionButton().
library(shiny)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("exc",
"Exchange")
),
mainPanel(
uiOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
showPlot <- reactiveVal(TRUE)
observeEvent(input$exc, {
showPlot(!showPlot())
})
output$car_plot <- renderUI({
if (showPlot()){
renderPlot({
plot(mtcars)
})
}
else{
renderDataTable(
datatable(
mtcars)
)
}
})
}
shinyApp(ui = ui, server = server)
I think what you have is close. I would create separate outputs for the plot and table as below (output$plot and output$table) and call them depending on state of your reactiveVal. Let me know if this is the behavior you had in mind.
server <- function(input, output) {
showPlot <- reactiveVal(TRUE)
observeEvent(input$exc, {
showPlot(!showPlot())
})
output$car_plot <- renderUI({
if (showPlot()){
plotOutput("plot")
}
else{
dataTableOutput("table")
}
})
output$plot <- renderPlot({
plot(mtcars)
})
output$table <- renderDataTable(datatable(mtcars))
}
I'd like to run the action button automatically when users open/land on 'tab1'. Therefore, instead of clicking the Refresh button to view the date, I'd like to have the date printed automatically. Is there a way to do this? My real code is more complicated that this simple example. However, it demonstrates what I'd like to do. Thank you!
library(shiny)
ui <- fluidPage(
shiny::tabPanel(value = 'tab1', title = 'Data page',
br(),
shiny::actionButton("btn", "Refresh!"),
br(),
shiny::verbatimTextOutput("out")
)
)
server <- function(input, output, session) {
curr_date <- shiny::eventReactive(input$btn, {
format(Sys.Date(), "%c")
})
output$out <- shiny::renderText({
print(curr_date())
})
}
shinyApp(ui, server)
You can make curr_date reactive to the tabset:
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel(value = 'tab1', title = 'Data page',
br(),
actionButton("btn", "Refresh!"),
br(),
verbatimTextOutput("out")
),
tabPanel(value = 'tab2', title = 'Other tab'),
id = "tabset"
)
)
server <- function(input, output, session) {
curr_date <- eventReactive(list(input$btn, input$tabset), {
req(input$tabset == 'tab1')
format(Sys.time(), "%c")
})
output$out <- renderText({
print(curr_date())
})
}
shinyApp(ui, server)
You should use reactiveValues() and observeEvent() for this. Inside server function:
server <- function(input, output, session) {
text_out <- reactiveValues(date = format(Sys.Date(), "%c"))
observeEvent(input$btn, {
text_out$date <- "something else"
})
output$out <- renderText({
print(text_out$date)
}
I'm trying to build a simple roller where one can click a button and populate a series of variables. I'm sure this is an easy solution, but I'm just having a hard time getting it to work.
This is what I've got. I have the interface set up just as I want it, but basically I want to get a new value for the strength row.
library(shiny)
ui = fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
textInput("char_name","Name"),
textInput("char_sex","Sex"),
actionButton("rollButton", "Roll!", width = "100%"),
hr(),
helpText("Please consult _ if you need assitance.")
),
mainPanel(
htmlOutput("name"),
htmlOutput("sex"),
htmlOutput("natl"),
htmlOutput("strength")
)
)
)
server = function(input, output) {
observe({
if(input$rollButton > 0) {
strength <- sum(sample(1:6,3,replace=TRUE))
}
})
output$name <- renderText({
input$rollButton
isolate(paste0('<b>Name</b>: ', input$char_name))
})
output$sex <- renderText({
input$rollButton
isolate(paste0('<b>Sex</b>: ', input$char_sex))
})
output$strength <- renderText({
input$rollButton
isolate(paste0('<b>Strength</b>: ', strength))
})
}
shinyApp(ui = ui, server = server)
You can't read the strength variable because it was set in another function. You can create a vector of shared reactive values
server = function(input, output) {
val <- reactiveValues(strength=NULL)
observe({
if(input$rollButton > 0) {
val$strength <- sum(sample(1:6,3,replace=TRUE))
}
})
output$name <- renderText({
input$rollButton
isolate(paste0('<b>Name</b>: ', input$char_name))
})
output$sex <- renderText({
input$rollButton
isolate(paste0('<b>Sex</b>: ', input$char_sex))
})
output$strength <- renderText({
input$rollButton
isolate(paste0('<b>Strength</b>: ', val$strength))
})
}
shinyApp(ui = ui, server = server)