The given R shiny script has a selectInput and infobox below, I just want to display the selected value in the selectInput within the infobox in the ui. Please help me with a solution and if possible, kindly avoid any scripting in the sever as I have furthur dependency. If this can be done within the UI, would be great, thanks.
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(title = "Data", status = "primary", solidHeader = T, width = 12,
fluidPage(
fluidRow(
column(2,offset = 0, style='padding:1px;',
selectInput("select the
input","select1",unique(iris$Species)))
))),
infoBox("Median Throughput Time", iris$Species)))
server <- function(input, output) { }
shinyApp(ui, server)
Trick is to make sure you know where the value of the selectInput is being assigned, which is selected_data in my example, this can be referenced within the server code by using input$selected_data.
renderUI lets you build a dynamic element which can be rendered with uiOutput and the output id, in this case, info_box
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(title = "Data", status = "primary", solidHeader = T, width = 12,
fluidPage(
fluidRow(
column(2, offset = 0, style = 'padding:1px;',
selectInput(inputId = "selected_data",
label = "Select input",
choices = unique(iris$Species)))
)
)
),
uiOutput("info_box")
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$info_box <- renderUI({
infoBox("Median Throughput Time", input$selected_data)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
I'm trying to have a box inside my shiny app while using the shinythems library :
library(shiny)
library(DT)
library(shinythemes)
library(shinydashboard)
ui <- fluidPage(
theme = shinytheme("lumen"),
navbarPage("test theme",
tabPanel("tab1",
mainPanel(width = 12,
fluidRow(
box(width=6,title = "title",status = "navy", solidHeader = TRUE,
dataTableOutput(outputId = "tab"))))
))
)
)
Server <- function(input, output,session){
output$tab = renderDataTable(mtcars)
}
shinyApp(ui, server)
But it does not work as I expected !
I was hoping to get something like :
I tried the titlePanel as well but it did not work !
I don't believe you can mix-n-match Shiny fluidPage, shinythemes & elements from shinydashboard just like that. For box to properly work it needs shinydashboard CSS and to include this you'd normally use
dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody()
)
layout instead of fluidPage() / fixedPage() Shiny layouts.
Though.. there's shinyWidgets::useShinydashboard() :
library(DT)
library(shiny)
library(shinythemes)
library(shinydashboard)
library(shinyWidgets)
ui <- fluidPage(
theme = shinytheme("lumen"),
shinyWidgets::useShinydashboard(),
navbarPage("test theme",
tabPanel("tab1",
mainPanel(width = 12,
fluidRow(
box(width = 12,
title = "title", status = "warning", solidHeader = TRUE,
dataTableOutput(outputId = "tab")
)
)
)
)
)
)
server <- function(input, output, session) {
output$tab <- renderDataTable(mtcars)
}
shinyApp(ui, server)
DT might not be the best example here as it requires some setup for responsiveness (it doesn't respect box boundaries and box(width = 6, ...) just draws over half of the table).
I'm trying to see a text from the reactive part in a box() but I don't know why it doesn't show up.
en ui.R:
fluidRow(
box(title = "Status summary", solidHeader = TRUE, status = "primary", width = 4, textOutput("selected_var"))),
in server.R :
server = function(input, output) {
output$selected_var <- renderText({"You have selected this"})
}
I can see :
thank you in advance
It's hard to know exactly what's wrong without seeing a full reproducible example. But your basic syntax seems fine.
Here's a full example that shows the textOutput rendering correctly in box():
# app.R
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(
title = "Status summary",
solidHeader = TRUE,
status = "primary",
width = 4,
textOutput("selected_var")
)
)
)
server <- function(input, output, session) {
output$selected_var <- renderText("Your input is X")
}
shinyApp(ui, server)
New to R Shiny. When I am trying to implement a valueBox using a reactive function, where the reactive function changes through choices of column names, based off of user select, to then where I would like to produce the maximum from the selected column.
Had an array of errors from cannot find object "Ordered_Product_Sales" even though it was clearly there to cannot apply non function.
Here is my code
library(shinythemes)
library(shiny)
library(plotly)
library(lubridate)
library(shinydashboard)
library(shinyWidgets)
ui <- dashboardPage(skin = "black", #theme = shinytheme("cyborg"),
dashboardHeader("Metric Tracker"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "Dashboard", icon = icon("city"))))
dashboardBody(fluidRow(
tabItems(
tabItem(tabName = "Dashboard",
box(width = 4,title = "Inputs", solidHeader = TRUE, status = "warning", selectInput("value", "1st Value to Track:" , choices = c("Units_Ordered", "Buy_Box_Percentage", "Ordered_Product_Sales", "Session_Percentage","aov"), selected = "Ordered_Product_Sales", multiple = FALSE, selectize = TRUE)
valueBoxOutput("max"), valueBoxOutput("min", width = 3)
),
server <- function(input, output){
g <- reactive({
(input$value)
})
output$max <- renderValueBox({
#maxi <- max(metricx2[,get(g())])
valueBox(maxi, subtitle = "Max")
I just simply want to display the maximum value from the column that has been selected in selectInput. The reactive switches between the names of the columns/selectInput choices.
Metricx2 is the data I want to pull the maximum value from.
If you need additional code let me know as this is only a snippet and i could have left something informative out.
Thanks for the help, I'm trying.
You don't show enough code for me to see what the problem is. Here is a minimal working example:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(
selectInput('column', 'Column:', names(mtcars))
),
dashboardBody(
valueBoxOutput("vbox")
)
)
server <- function(input, output) {
output$vbox <- renderValueBox({
valueBox(
paste('Maximum of', input$column),
max(mtcars[[input$column]])
)
})
}
shinyApp(ui, server)
I want to display a table of data in a pop-up window by clicking on valueBox. The valueBox itself should work as an actionButton.
When I click on the valueBox it should render a table in pop-up window as in the picture below.
Can anyone help on this code?
My code:
library(shiny)
library(shinydashboard)
data <- iris
ui <- dashboardPage(
dashboardHeader(title = "Telemedicine HP"),
dashboardSidebar(),
dashboardBody(
fluidRow(
valueBox( 60, subtitle = tags$p("Attended", style = "font-size: 200%;"),
icon = icon("trademark"), color = "purple", width = 4,
href = NULL))))
server <- function(input,output){
}
shinyApp(ui, server)
Here is another solution without shinyjs
library(shiny)
library(shinydashboard)
library(shinyBS)
data <- iris
ui <- tagList(
dashboardPage(
dashboardHeader(title = "Telemedicine HP"),
dashboardSidebar(),
dashboardBody(
fluidRow(
div(id='clickdiv',
valueBox(60, subtitle = tags$p("Attended", style = "font-size: 200%;"), icon = icon("trademark"), color = "purple", width = 4, href = NULL)
)
),
bsModal("modalExample", "Data Table", "clickdiv", size = "large",dataTableOutput("table"))
)
)
)
server <- function(input, output, session){
output$table <- renderDataTable({
head(data)
})
}
shinyApp(ui, server)
You can create an onclick event with shinyjs. Therefore you need to add useShinyjs() in your ui, which you can do by wrapping your ui in a tagList.
The onclick function is triggered in your server when an element with a given ID is clicked. So you also need to give the valueBox an ID. I decided to wrap it in a div with an ID.
Next part is to create a popup whenever the onclick event is triggered. You can do this by using the showModal function from shinyBS.
Working example
library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinyBS)
data <- iris
ui <- tagList(
useShinyjs(),
dashboardPage(
dashboardHeader(title = "Telemedicine HP"),
dashboardSidebar(),
dashboardBody(
fluidRow(
div(id='clickdiv',
valueBox(60, subtitle = tags$p("Attended", style = "font-size: 200%;"), icon = icon("trademark"), color = "purple", width = 4, href = NULL)
)
)
)
)
)
server <- function(input, output, session){
onclick('clickdiv', showModal(modalDialog(
title = "Your title",
renderDataTable(data)
)))
}
shinyApp(ui, server)
I have initial loading of data from the DB in the server.R which takes a few seconds. Until this is done, the page displayed is distorted (wrong data in selection box, and weird placing of the boxes, see below).
I want to display a different page (or at least different content in my first-displayed tab) until the data is completely loaded.
I thought about doing some kind of conditionalPanel using a condition based on a dedicated global variable (initial_loading_done), but wherever I tried placing the conditionalPanel it didn't work.
This is the structure of my UI.R:
shinyUI(
dashboardPage(
dashboardHeader(title = "Title"),
dashboardSidebar(
sidebarMenu(
menuItem("Tab1", tabName = "Tab1",icon = icon("dashboard")),
menuItem("Tab2", tabName = "Tab2", icon = icon("bar-chart-o"))
)
),
dashboardBody(
includeCSS("custom_css.css"),
tabItems(
tabItem(tabName = "Tab1",
fluidRow(<content>),
mainPanel(
fluidRow(<content>)
)
),
tabItem(tabName = "Tab2",
fluidRow(<content>),
mainPanel(
dataTableOutput('my_data_table')
)
)
)
)
)
)
Here's a very simple example using shinyjs package
The idea is to create the loading "page" and the content "page" under different IDs, have the content page initially hidden, and use show() and hide() after the app is ready
library(shiny)
library(shinyjs)
load_data <- function() {
Sys.sleep(2)
hide("loading_page")
show("main_content")
}
ui <- fluidPage(
useShinyjs(),
div(
id = "loading_page",
h1("Loading...")
),
hidden(
div(
id = "main_content",
"Data loaded, content goes here"
)
)
)
server <- function(input, output, session) {
load_data()
}
shinyApp(ui = ui, server = server)
In server I like to use reactiveValues() to store a setupComplete condition. Then, when the data is loaded my setupComplete is set to TRUE.
In the ui we can then assess this setupComplete condition in a conditionalPanel, and only display the content (in my example the three box() widgets).
Here's a working example
## app.R ##
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
actionButton(inputId = "btn_data", label = "Download"),
conditionalPanel(condition = "output.setupComplete",
box( title = "box1" ),
box( title = "box2" ),
box( title = "boc3" )
),
conditionalPanel(condition = "!output.setupComplete",
box( title = "loading"))
)
)
server <- function(input, output) {
rv <- reactiveValues()
rv$setupComplete <- FALSE
## simulate data load
observe({
if(input$btn_data){
df <- data.frame(id = seq(1,200),
val = rnorm(200, 0, 1))
## Simulate the data load
Sys.sleep(5)
## set my condition to TRUE
rv$setupComplete <- TRUE
}
## the conditional panel reads this output
output$setupComplete <- reactive({
return(rv$setupComplete)
})
outputOptions(output, 'setupComplete', suspendWhenHidden=FALSE)
})
}
shinyApp(ui, server)
The code
hidden(
div(
id = "main_content",
"Data loaded, content goes here"
)
doesn't work with tabsetPanel. But if you move the id to the div level it works beautifully. Thanks to shinyjs author Dean Attali for this tip. https://stackoverflow.com/users/4432127/keshete
hidden(
div(id = "mainTabsetPanel",
tabsetPanel(
....