I want to use a rating Input in conjunction with the shinyjs::reset()function. Everthing works fine except the reset functionality. Any hints?
Here is my minimal example:
library(shiny)
devtools::install_github("stefanwilhelm/ShinyRatingInput")
library(ShinyRatingInput)
library(shinyjs)
ui <- shinyUI(bootstrapPage(
useShinyjs(),
ratingInput("movieRating", label="Rate this movie...", dataStop=5),
htmlOutput("movieRatingout"),
actionButton("resetbtn", "reset")
))
#the corresponding server.R
server <- shinyServer(function(input, output, session) {
output$movieRatingout <- renderText({
paste("The movie was rated ",input$movieRating)
})
observeEvent(input$resetbtn, {
reset("movieRating")
})
})
shinyApp(ui, server)
You can create reset action manualy
1) Add js to reset icons ( set width of foreground ==0)
jsCode <-"shinyjs.reset_1 = function(params){$('.rating-symbol-foreground').css('width', params);}"
2) add this js to app using extendShinyjs
3) add session$sendInputMessage to reset input ( set value == NULL)
Working example
jsCode <-"shinyjs.reset_1 = function(params){$('.rating-symbol-foreground').css('width', params);}"
ui <- shinyUI(bootstrapPage(
useShinyjs(),
extendShinyjs(text = jsCode),
ratingInput("movieRating", label="Rate this movie...", dataStop=5),
htmlOutput("movieRatingout"),
actionButton("resetbtn", "reset")
))
#the corresponding server.R
server <- shinyServer(function(input, output, session) {
output$movieRatingout <- renderText({
paste("The movie was rated ",input$movieRating)
})
observeEvent(input$resetbtn, {
session$sendInputMessage("movieRating", list(value = NULL))
js$reset_1(0)
})
})
Related
I would like to set up my Shiny app to dynamically enable/disable UI modules based on user input. I am accustomed to using ShinyJS to do this in a non-modular app by passing the ID of the UI element into the enable() or disable() functions. However, with the UI now being generated inside of a module, I no longer have access to the same ID.
Here is an example app which increments by 1 each time the "counter1" button is clicked. The "counterButton" function is contained in an external module called "counterModule.R", and I would like the "toggleButton" to toggle the state of the "counterButton" between enabled and disabled. The call to toggleState() currently does nothing I assume because the "counter1" ID is not found. What would be the best way of going about this?
app.R
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
mainPanel(actionButton(inputId = "toggleButton", label = "Toggle counter button"),
sidebarPanel(counterButton("counter1", "+1")))
)
server <- function(input, output, session) {
observeEvent(input$toggleButton, {
print("clicked toggle button")
shinyjs::toggleState("counter1")
})
counterServer("counter1")
}
shinyApp(ui, server)
R/counterModule.R
counterButton <- function(id, label = "Counter") {
ns <- NS(id)
tagList(
actionButton(ns("button"), label = label),
verbatimTextOutput(ns("out"))
)
}
counterServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
count <- reactiveVal(0)
observeEvent(input$button, {
count(count() + 1)
})
output$out <- renderText({
count()
})
count
}
)
}
You have 2 possibilities. The namespacing of the shiny modules works in the following format: namespace-elementid. This means that your button in the module has the id counter1-button which is globally unique (and within in the module, you can just use button).
Therefore, you can use the namespaced id in your main server function:
observeEvent(input$toggleButton, {
print("clicked toggle button")
shinyjs::toggleState("counter1-button")
})
However, this somehow breaks the separation of ui/logic defined in the module and in the main server function. Therefore, the second option is to define the toggle button in the main app, but have the toggle logic in the module:
library(shiny)
library(shinyjs)
##########################
# code of the module
counterButton <- function(id, label = "Counter") {
ns <- NS(id)
tagList(
actionButton(ns("button"), label = label),
verbatimTextOutput(ns("out"))
)
}
counterServer <- function(id, toggle_action) {
moduleServer(
id,
function(input, output, session) {
count <- reactiveVal(0)
observeEvent(input$button, {
count(count() + 1)
})
output$out <- renderText({
count()
})
observeEvent(toggle_action(), {
print("clicked toggle button")
shinyjs::toggleState("button")
})
count
}
)
}
##########################
# code of the main app
ui <- fluidPage(
shinyjs::useShinyjs(),
mainPanel(actionButton(inputId = "toggleButton", label = "Toggle counter button"),
sidebarPanel(counterButton("counter1", "+1")))
)
server <- function(input, output, session) {
counterServer("counter1", toggle_action = reactive({input$toggleButton}))
}
shinyApp(ui, server)
I want to generate a boxPlus around my DT-Output. Now when I start my APP, the frame of the box is already there. How do I manage that the box is only displayed when the tableoutput is finished? As input I use a text input.
In my UI I use for the Input:
textInput("name", "Insert Number:")
the final box I create with:
uiOutput("box")
On Serverside I do:
output$name <- renderText(input$name)
New_input <- reactive({
list(input$name)
})
and the box I create like this:
output$box <- renderUI({
boxPlus(
div(style = 'overflow-x: scroll;'), dataTableOutput("table")
)
})
I tried it with: Similar Problem but I can not resolve the problem. Without the box everything works fine.
Never use reactive expressions inside a renderText function.
You have to wrap tagList around your two elements to return a SINGLE element (a list in your case).
Here is a reproduceable example.
library(shiny)
library(shinydashboardPlus)
library(dplyr)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Hide box"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
textInput("name", "Insert Number to filter cyl:")
),
mainPanel(
uiOutput("box")
)
)
)
server <- function(input, output) {
resultdf <- reactive({
mtcars %>%
filter(cyl > input$name)
})
output$box <- renderUI({
output$table <- renderDataTable({
resultdf()
})
if(input$name == "") {
return(NULL)
} else {
return(
tagList(
boxPlus(
div(style = 'overflow-x: scroll;'), dataTableOutput("table")
)
)
)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am trying to render a few outputs in a shiny application that are contained within a shinyjs::hidden section upon the application running rather than once the section is visible.
EDIT: I had the app set up incorrectly in the original example so have changed it.
I want to be able to run the reactive statement before running the final observe to change the UI from the Alpha text to the Beta text and plot. Ideally this would mean in the console would see "Done plotting" before "Observe run".
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
div(id = "before-content", h3("Aux Text Alpha")),
shinyjs::hidden(
div(
id = "after-content",
h1("Aux Text Beta"),
plotOutput("text")
)
)
)
server <- function( session,input, output) {
in_plot <- reactive({
Sys.sleep(3)
print("Done plotting")
plot(iris)
})
output$text <- renderPlot({
in_plot()
})
observe({
print("Observe run")
hide("before-content")
show("after-content")
})
}
shinyApp(ui, server)
An alternative would be to have a layer over what is classed as the hidden section but am not too sure on how that is accomplished.
You can hide it in the reactive, like so:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
actionButton("button", "Click me"),
plotOutput("text")
)
server <- function( session,input, output) {
in_plot <- reactive({
hide("text")
Sys.sleep(3)
print("Done plotting")
plot(iris)
})
output$text <- renderPlot({
in_plot()
})
observeEvent(input$button, {
show("text")
})
}
shinyApp(ui, server)
I have a functional shiny app that uses the shinydashboard package.
A new feature requires user-specific behavior (e.g. use different data sets for different usernames). Therefore I intend to
Display a login form
Validate credentials and set a reactive value LoggedIn to true if successful
Display the actual dashboardPage as soon as LoggedIn is set to TRUE
My approach is based on this app, which decides which element to display in renderUI based on the reactive value.
The following simplified examples are supposed to change the displayed UI element after clicking an actionButton. The only difference between the source is that example 1 (working as intended) uses a fixedPage, whereas example 2 (not working - clicking the button does not switch to ui2) uses a dashboardPage.
Working example
library(shiny)
ui1 <- fixedPage(actionButton("btn_login", "Login"))
ui2 <- fixedPage(sliderInput("slider", "slider", 3, 2, 2))
ui <- uiOutput("ui")
server <- function(input, output, session) {
state <- reactiveValues(LoggedIn = FALSE)
output$ui <- renderUI({if (!state$LoggedIn) ui1 else ui2})
observeEvent(input$btn_login, {
state$LoggedIn = TRUE
})
}
shinyApp(ui, server)
Malfunctioning example
library(shiny)
library(shinydashboard)
ui1 <- fixedPage(actionButton("btn_login", "Login"))
ui2 <- dashboardPage(dashboardHeader(), dashboardSidebar(), dashboardBody())
ui <- uiOutput("ui")
server <- function(input, output, session) {
state <- reactiveValues(LoggedIn = FALSE)
output$ui <- renderUI({if (!state$LoggedIn) ui1 else ui2})
observeEvent(input$btn_login, {
state$LoggedIn = TRUE
})
}
shinyApp(ui, server)
Is this due to peculiarities of the shinydashboard package?
Has anybody had a similar problem (besides this user) and found a solution?
Thanks in advance for any help!
EDIT
#SeGa This rather useless app renders the dashboardPage after the reactiveTimer has triggered twice - Maybe there is a possibility to get it working without the timer?
library(shiny)
library(shinydashboard)
ui1 <- fixedPage(actionButton("btn_login", "Login"))
ui2 <- dashboardPage(dashboardHeader(), dashboardSidebar(), dashboardBody())
ui <- uiOutput("ui")
server <- function(input, output, session) {
state <- reactiveValues(LoggedIn = FALSE)
timer <- reactiveTimer(1000, session)
output$ui <- renderUI({if (!state$LoggedIn) ui1 else ui2})
observeEvent(timer(), {
state$LoggedIn = !state$LoggedIn
})
}
shinyApp(ui, server)
EDIT May 29
#Bertil Baron
Is it something like that you mean?
loginUI <- fixedPage(actionButton("btn_login", "Login"))
mainUI <- # See below
ui <- loginUI
server <- function(input, output, session) {
observeEvent(input$btn_login, {
removeUI(selector = "body")
insertUI(selector = "head", where = "afterEnd", mainUI)
})
}
shinyApp(ui, server)
Now this works if mainUI is one of basicPage, bootstrapPage, fillPage, fixedPage, fluidPage, navbarPage - a new body tag is inserted and visible in the DOM, but there is no effect for a bootstrapPage.
In case you meant to initially display the login form in the dashboardBody and replacing it with the actual content after a successful login - that is what I wanted to avoid.
It also works with invalidateLater(), but also only temporary.
library(shiny)
library(shinydashboard)
ui <- uiOutput("ui")
server <- function(input, output, session) {
state <- reactiveValues(LoggedIn = FALSE)
observeEvent(input$btn_login, {
state$LoggedIn = !state$LoggedIn
})
ui1 <- reactive({
fixedPage(actionButton("btn_login", "Login"))
})
ui2 <- reactive({
ui2 <- dashboardPage(dashboardHeader(), dashboardSidebar(), dashboardBody(
sliderInput("slider", "slider", min = 1, max = 10, value = 2)
))
invalidateLater(100, session)
ui2
})
output$ui <- renderUI({if (!state$LoggedIn) ui1() else ui2()})
}
shinyApp(ui, server)
Not sure this is the kind of solution you are after, but here's my attempt using shinyjs and some CSS. It seems hard to switch from a fixedPage to a dashboardPage, so if you really want to use shinydashboard, I would stick with shinydashboard and disable the dashboard look on the login page.
library(shiny)
library(shinyjs)
library(shinydashboard)
ui1 <- div(
id = "login-page",
actionButton("btn_login", "Login")
)
ui2 <- hidden(
div(
id = "main-page",
sliderInput("slider", "slider", 3, 2, 2)
)
)
ui <- dashboardPage(dashboardHeader(),
dashboardSidebar(collapsed = TRUE),
dashboardBody(useShinyjs(),
tags$head(
tags$style(
HTML('.main-header {
display: none;
}
.header-visible {
display: inherit;
}')
)
),
fluidPage(ui1, ui2)
)
)
server <- function(input, output, session) {
state <- reactiveValues(LoggedIn = FALSE)
observeEvent(input$btn_login, {
state$LoggedIn = TRUE
shinyjs::addClass(selector = "header", class = "header-visible")
shinyjs::removeClass(selector = "body", class = "sidebar-collapse")
shinyjs::hide(id = "login-page")
shinyjs::show(id = "main-page")
})
}
shinyApp(ui, server)
If you want to be able to come back to the login page, you can always add a login button that shows the login page, and hides the appropriate elements (sidebar/header/current page).
I'm developing an app in which I use modules to display different tab's ui content. However it seems like the module does not communicate with the main (or parent) app. It displays the proper ui but is not able to execute the observeEvent function when an actionButton is clicked, it should update the current tab and display the second one.
In my code I have created a namespace function and wrapped the actionButton's id in ns(), however it still does not work. Does anyone knows what's wrong?
library(shiny)
moduleUI <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session){
observeEvent(input$action1, {
updateTabItems(session, "tabsPanel", "two")
})
}
ui <- fluidPage(
navlistPanel(id = "tabsPanel",
tabPanel("one",moduleUI("first")),
tabPanel("two",moduleUI("second"))
))
server <- function(input, output, session){
callModule(module,"first")
callModule(module,"second")
}
shinyApp(ui = ui, server = server)
The observeEvent works, but since modules only see and know the variables given to them as input parameters, it does not know the tabsetPanel specified and thus cannot update it. This problem can be solved using a reactive Value, which is passed as parameter and which is changed inside the module. Once it's changed, it is known to the main app and can update the tabsetPanel:
library(shiny)
library(shinydashboard)
moduleUI <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session, tabsPanel, openTab){
observeEvent(input$action1, {
if(tabsPanel() == "one"){ # input$tabsPanel == "one"
openTab("two")
}else{ # input$tabsPanel == "two"
openTab("one")
}
})
return(openTab)
}
ui <- fluidPage(
h2("Currently open Tab:"),
verbatimTextOutput("opentab"),
navlistPanel(id = "tabsPanel",
tabPanel("one", moduleUI("first")),
tabPanel("two", moduleUI("second"))
))
server <- function(input, output, session){
openTab <- reactiveVal()
observe({ openTab(input$tabsPanel) }) # always write the currently open tab into openTab()
# print the currently open tab
output$opentab <- renderPrint({
openTab()
})
openTab <- callModule(module,"first", reactive({ input$tabsPanel }), openTab)
openTab <- callModule(module,"second", reactive({ input$tabsPanel }), openTab)
observeEvent(openTab(), {
updateTabItems(session, "tabsPanel", openTab())
})
}
shinyApp(ui = ui, server = server)