I am using shiny modules with some charts and everything works fine (amazing functionality!), ... but I can not make them work with valueBox (from shinydashboard). Nothing is rendered...
Here is a minimal example:
library(shinydashboard)
# MODULE UI
bsc_tile_UI <- function(id) {
ns <- NS(id)
valueBoxOutput("tile1", width=12)
}
# MODULE Server
bsc_tile_OUT <- function(input, output, session, number, metric) {
output$tile1 <- renderValueBox({
valueBox(number, paste(metric), icon = icon("arrow-up"),color = "blue",
width=12)
})
}
ui<-dashboardPage(
dashboardHeader(title = "Dashboard"),
sidebar <- dashboardSidebar(disable = TRUE),
dashboardBody(
fluidPage(
bsc_tile_UI("tile_1"),
bsc_tile_UI("tile_2")
)
)
)
# App server
server <- function(input, output,session){
callModule(bsc_tile_OUT, "tile_1", '300', 'metric 1')
callModule(bsc_tile_OUT, "tile_2", '500', 'metric 2')
}
shinyApp(ui, server)
In the given example parameteres "number" and "metric" are explicitly provided, but my intention is they will be defined as variables of a dataframe.
Any help will be welcome!!!
(sorry my english)
You need to use ns() in all your defined Module inputs. The module server is taking the members of the output vector and will internally attach the module ID to them ("tile_1" and "tile_2" in your case) - this is what you need to do manually in UI by using ns(). So if you just change your module UI output definition to the following, your code will work:
valueBoxOutput(ns("tile1"), width=12)
Related
I have a Shiny app that I am trying to "modularize". I have an issue that my subtab tabPanel tab_Summary is not recognized when I separate it in another R file.
If I place the creation of the tab_Summary inside the ui.R it works, but if I want to be able to have this subtab in another file like showed in the following scripts, then I get error that object 'tab_Summary' not found :
The 0_tab_Summary_ui.R placed in the folder 'C:/Users/ROG/Downloads/example_shiny/Shiny_Modules':
tab_Summary <- tabPanel('Summary',
fluidRow(
column(width = 3,
htmlOutput("Summary_Number_ui")
)
)
)
The ui.R script:
setwd(paste0(main_working_dir, "Shiny_Modules"))
source("0_tab_Summary_ui.R")
ui <- navbarPage(
title=div("SHINY DASHBOARD"),
tab_Summary
)
The server.R script:
server <- function(input, output, session) {
output$Summary_Number_ui <- renderUI({
HTML(paste0("<div id='mydiv'><font size='5'><font color=\"#0d0a36\"> Total Number of Accounts: <b>", 726431 , "</b></div>"))
})
}
The app.R script:
library(shiny)
local_working_dir <- "C:/Users/ROG/Downloads/example_shiny/"
main_working_dir <- local_working_dir
setwd(main_working_dir)
shinyApp(ui, server)
And below the ui.R script that does not show any error but is not modularized:
setwd(paste0(main_working_dir, "Shiny_Modules"))
source("0_tab_Summary_ui.R")
ui <- navbarPage(
title=div("SHINY DASHBOARD"),
# tab_Summary
tab_Summary <- tabPanel('Summary',
fluidRow(
column(width = 3,
htmlOutput("Summary_Number_ui")
)
)
)
)
Try to learn how to use modules in Shiny, roughly global.R "includes" all your modules and those files have a module specific UI and a Server part that belong together. In the ui.R you define your layout and call the specific module UI part, same for the server.R. This way you keep all code for one module together, which makes it nicely scalable. Also note that whatever settings you may want to use and define, global.R is excecuted once upon the start of your app, while all code within your server.R server function is run upon every browser refresh.
global.R
# Global.R is loaded once at App start (not at browser refresh!)
# load all libraries
library("shiny")
# source all your modules here
source("modules/MyTabModule.R")
ui.R
ui <- navbarPage(
title=div("SHINY DASHBOARD"),
MyTabModuleUI("Summary_Number_ui")
)
server.R
server <- function(input, output, session) {
MyTabModuleServer("Summary_Number_ui")
}
modules/MyTabModule.R
MyTabModuleUI <- function(id) {
ns <- NS(id)
tabPanel('Summary',
fluidRow(
column(
width = 3,
htmlOutput(ns("Summary_Number_ui"))
)
)
)
}
MyTabModuleServer <- function(id) {
moduleServer(id, function(input, output, session) {
output$Summary_Number_ui <- renderUI({
HTML(paste0("<div id='mydiv'><font size='5'><font color=\"#0d0a36\"> Total Number of Accounts: <b>", 726431 , "</b></div>"))
})
})
}
super new to shiny, have a problem that seems like it should be basic reactive programming but I haven't been able to find a solution that's worked so far.
Essentially, I want to take the user's selected input from the UI and paste it into a simple object in the server that will react/update when a new input is chosen.
The object will be concatenated into a full API call, and I wish to rerun the API call in the server with the reactive object updated each time a new input is chosen for it (note: the API cannot be run without an access code which is part of a corporate account, so apologies for my hesitance to put my full code but I just need help with this one functionality.)
In code below:
with Dollar General as the default selection in the selectInput, I would like the object, query, to be the character string "dollar%20general", and reactively change to "walmart" should Walmart be selected
Thanks!
ui <- fluidPage
sidebarLayout(
sidebarPanel(
selectInput("company", "Choose company:",
c("Dollar General" = "dollar%20general",
"Dollar Tree" = "dollar%20tree",
"Walmart" = "walmart"))
...
server <- function(input,output) {
...
query <- paste(input$company)
...
you can use reactiveValues() and observe. This should work:
library(shiny)
# Define UI for application
ui <- fluidPage(
# your input
sidebarLayout(
sidebarPanel(
selectInput("company", "Choose company:",
c("Dollar General" = "dollar%20general",
"Dollar Tree" = "dollar%20tree",
"Walmart" = "walmart"))
),
# Determine Output
mainPanel(
textOutput("showInput") # you need to render this in your server file
)
)
)
server <- function(input, output) {
# Show what was selected
query <- reactiveValues()
observe(
query$test <- paste(input$company, "and test", sep = " ")
)
output$showInput <- renderText({ #based on what you defined in the ui
query$test
})
}
# Run the application
shinyApp(ui = ui, server = server)
Create two files named ui.R and server.R store the UI logic in ui.R and backend/object logic in server.R. Below is the implementation.
UI file
# UI of app
ui <- fluidPage(
# input
sidebarLayout(
sidebarPanel(
selectInput("company", "Choose company:",
c("Dollar General" = "dollar%20general",
"Dollar Tree" = "dollar%20tree",
"Walmart" = "walmart"))
),
# Output
mainPanel(
textOutput("Input")
)
)
)
Server/Backend File
server <- function(input, output) {
# Show what was selected
output$Input <- renderText({ #based on what you defined in the ui
input$company
})
}
Now store these in a directory and then call runApp function.
~/newdir
|-- ui.R
|-- server.R
runApp("newdir")
I have a Shiny application where I would like to add a UI element using an action button and then have that inserted ui be dynamic.
Here is my current ui file:
library(shiny)
shinyUI(fluidPage(
div(id="placeholder"),
actionButton("addLine", "Add Line")
))
and server file:
library(shiny)
shinyServer(function(input, output) {
observeEvent(input$addLine, {
num <- input$addLine
id <- paste0("ind", num)
insertUI(
selector="#placeholder",
where="beforeBegin",
ui={
fluidRow(column(3, selectInput(paste0("selected", id), label=NULL, choices=c("choice1", "choice2"))))
})
})
})
If choice1 is selected within the specific ui element, I would like to add a textInput to the row. If choice2 is selected within the ui element, I would like to add a numericInput.
While I generally understand how to create reactive values that change in response to user input, I don't know what to do here because I do not know how to observe an element that has not been created yet and that I do not know the name of. Any help would be very appreciated!
Code
This can be easily solved with modules:
library(shiny)
row_ui <- function(id) {
ns <- NS(id)
fluidRow(
column(3,
selectInput(ns("type_chooser"),
label = "Choose Type:",
choices = c("text", "numeric"))
),
column(9,
uiOutput(ns("ui_placeholder"))
)
)
}
row_server <- function(input, output, session) {
return_value <- reactive({input$inner_element})
ns <- session$ns
output$ui_placeholder <- renderUI({
type <- req(input$type_chooser)
if(type == "text") {
textInput(ns("inner_element"), "Text:")
} else if (type == "numeric") {
numericInput(ns("inner_element"), "Value:", 0)
}
})
## if we later want to do some more sophisticated logic
## we can add reactives to this list
list(return_value = return_value)
}
ui <- fluidPage(
div(id="placeholder"),
actionButton("addLine", "Add Line"),
verbatimTextOutput("out")
)
server <- function(input, output, session) {
handler <- reactiveVal(list())
observeEvent(input$addLine, {
new_id <- paste("row", input$addLine, sep = "_")
insertUI(
selector = "#placeholder",
where = "beforeBegin",
ui = row_ui(new_id)
)
handler_list <- isolate(handler())
new_handler <- callModule(row_server, new_id)
handler_list <- c(handler_list, new_handler)
names(handler_list)[length(handler_list)] <- new_id
handler(handler_list)
})
output$out <- renderPrint({
lapply(handler(), function(handle) {
handle()
})
})
}
shinyApp(ui, server)
Explanation
A module is, well, a modular piece of code, which you can reuse as often as you want without bothering about unique names, because the module takes care of that with the help of namespaces.
A module consists of 2 parts:
A UI function
A server function
They are pretty much like the normal UI and server functions, with some things to keep in mind:
namespacing: within the server you can access elements from the UI as you would do normally, i.e. for instance input$type_chooser. However, at the UI part, you have to namespace your elements, by using NS, which returns a function which you can conveniently use in the rest of the code. For this the UI function takes an argument id which can be seen as the (unique) namespace for any instance of this module. The element ids must be unique within the module and thanks to the namespace, they will be also unique in the whole app, even if you use several instances of your module.
UI: as your UI is a function, which only has one return value, you must wrap your elements in a tagList if you want to return more than one element (not needed here).
server: you need the session argument, which is otherwise optional. If you want your module to communicate with the main application, you can pass in a (reactive) argument which you can use as usual in your module. Similarly, if you want your main application to use some values from the module you should return reactives as shown in the code. If you ened to creat UI elements from your server function you also need to namespace them and you cann acces the namespacing function via session$ns as shown.
usage: to use your module you insert the UI part in your main app by calling the function with an unique id. Then you have to call callModule to make the server logic work, where you pass in the same id. The return value of this call is the returnValue of your module server function and can be sued to work with values from within the module also in the main app.
This explains modules in a nutshell. A very good tutorial which explains modules in much more detail and completeness can be found here.
You could either use insertUI() or renderUI(). insertUI() is great if you want to add multiple uis of the same kind, but i think that doesnt apply to you.
I think you either want to add a numeric or a text input not both.
Therefore, i would suggest using renderUI():
output$insUI <- renderUI({
req(input$choice)
if(input$choice == "choice1") return(fluidRow(column(3,
textInput(inputId = "text", label=NULL, "sampleText"))))
if(input$choice == "choice2") return(fluidRow(column(3,
numericInput(inputId = "text", label=NULL, 10, 1, 20))))
})
If you prefer to use insertUI() you can use:
observeEvent(input$choice, {
if(input$choice == "choice1") insUI <- fluidRow(column(3, textInput(inputId
= "text", label=NULL)))
if(input$choice == "choice2") insUI <- fluidRow(column(3,
numericInput(inputId = "text", label=NULL, 10, 1, 20)))
insertUI(
selector="#placeholderInput",
where="beforeBegin",
ui={
insUI
})
})
and on ui side: div(id="placeholderInput").
Full code reads:
library(shiny)
ui <- shinyUI(fluidPage(
div(id="placeholderChoice"),
uiOutput("insUI"),
actionButton("addLine", "Add Line")
))
server <- shinyServer(function(input, output) {
observeEvent(input$addLine, {
insertUI(
selector="#placeholderChoice",
where="beforeBegin",
ui={
fluidRow(column(3, selectInput(inputId = "choice", label=NULL,
choices=c("choice1", "choice2"))))
})
})
output$insUI <- renderUI({
req(input$choice)
if(input$choice == "choice1") return(fluidRow(column(3,
textInput(inputId = "text", label=NULL, "sampleText"))))
if(input$choice == "choice2") return(fluidRow(column(3,
numericInput(inputId = "text", label=NULL, 10, 1, 20))))
})
})
shinyApp(ui, server)
I unfortunately cannot comment on answers yet, but I think someone finding this question like me might want to know this: #thotal's answer worked for me except one line: new_handler <- callModule(row_server, new_id) gave me an error: "Warning: Error in module: unused arguments (childScope$output, childScope)"
I looked around and found this stackoverflow question, which gave the solution of basically using new_handler <- row_server(new_id).
I'm trying to make a dynamically generated navbar based on the session user id.
I have a data table that maps the session user to a list of that user's clients. I want the app to produce a navbar where each tabPanel is for each client that user has. I'm not sure how I can easily do that since navbarPage() doesn't take a list argument.
Below is my example
library(shiny)
data <- data.frame(user=c("emily", "emily"), clients=c("client1", "client2"))
CreateCustomNavbarContent <- function(data) {
l <- lapply(data$clients, function(client) {
tabPanel(client,
h2(client))
})
renderUI({
l
})
}
shinyApp(
ui <- fluidPage(
uiOutput("custom_navbar")
),
server <- function(input, output) {
output$custom_navbar <- renderUI({
## commented below doesn't work
# navbarPage(
# CreateCustomNavbarContent(data)
# )
navbarPage("",
tabPanel("client1",
h2("client1")
),
tabPanel("client2",
h2("client2")
)
)
})
}
)
You could achieve what you want with do.call, so we can pass a list of arguments as separate arguments. Below is a working example, I gave emily a companion called John so you can validate that the code does what you want ;)
Hope this helps!
library(shiny)
data <- data.frame(user=c("Emily", "Emily","John","John"), clients=c("client1", "client2","client3","client4"))
ui = fluidPage(
selectInput('select_user','Select user:',unique(data$user)),
uiOutput('mytabsetpanel')
)
server = function(input, output, session){
output$mytabsetpanel = renderUI({
myTabs = lapply(data$clients[data$user==input$select_user], tabPanel)
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui,server)
Here is my code in R Shiny using modules.
I created a module named MyModule and want to generate two UI elements: selectInput and textInput. This code is just an example - in my real application second element require the result from the first element, so I want to generate them separately.
I don't understand why the second uiOutput doesn't generate the UI element it indended to:
library(shiny)
# Define UI
ui <- shinyUI(fluidPage(MyModuleUI("one")))
# Define server logic
server <- shinyServer(function(input, output, session) {callModule(MyModule, 'one')})
#Here is my UI Module
MyModuleUI <- function(id) {
ns <- NS(id)
fluidRow(
uiOutput(ns('ChooseNumber')),
uiOutput(ns('EnterText'))
)
}
#Here is my server Module
MyModule <- function(input, output, session) {
output$ChooseNumber <- renderUI({
# In my bigger program I need this UI to be generated with some database values,
# thats why it is in the Server part of the Module
ns <- session$ns
selectInput(ns("TheNumber"), label = 'Select a number', c(1,2,3))
})
# Same here
output$EnterText <- renderUI({
ns <- session$ns
textInput(ns('TheText'),label = 'Enter a text:',value = 'ABC')
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thank you!