I'm having an issue with my Shiny App. My app has a valueBox that worked fine before I introduced a gauge from the flexdashboard package.
With the gauge my valueBox not longer renders in the UI.
Reading other posts, I think this is an issue with the flexdashboard package.
Any work arounds would be much appreciated.
Some reproducible code below:
library(shiny)
library(shinydashboard)
#library(flexdashboard)
ui <-dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(
valueBoxOutput("vbox1"),
column(6,box(plotOutput("plt1"),width=12,title="Gauge Graph",background ="green") ),
column(6,box(plotOutput("plt2"),width=12,title="Graph2",background="yellow") )
),
fluidRow( actionButton("plot","plot") )
)
)
server <- shinyServer(function(input, output, session) {
observeEvent(input$plot,{
output$plt1 <- renderPlot({
flexdashboard::gauge(56, min = 0, max = 100, symbol = '%', label = paste("Test Label"),gaugeSectors(
success = c(100, 6), warning = c(5,1), danger = c(0, 1), colors = c("#CC6699")
))
})
output$plt2 <- renderPlot({plot(runif(100),runif(100))})
})
output$vbox1 <- renderValueBox({
valueBox(
"Gender",
input$count,
icon = icon("users")
)
})
})
shinyApp(ui = ui, server = server)
You could use flexdashboard namespace instead of sourcing the library.
You could do something like this:
library(shiny)
library(shinydashboard)
# library(flexdashboard)
ui <-dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(
valueBoxOutput("vbox1"),
column(6,box(flexdashboard::gaugeOutput("plt1"),width=12,title="Gauge Graph",background ="green") ),
column(6,box(plotOutput("plt2"),width=12,title="Graph2",background="yellow") )
),
fluidRow( actionButton("plot","plot") )
)
)
server <- shinyServer(function(input, output, session) {
observeEvent(input$plot,{
output$plt1 <- flexdashboard::renderGauge({
flexdashboard::gauge(56, min = 0, max = 100, symbol = '%', label = paste("Test Label"),
flexdashboard::gaugeSectors(success = c(100, 6), warning = c(5,1), danger = c(0, 1), colors = c("#CC6699")
))
})
output$plt2 <- renderPlot({plot(runif(100),runif(100))})
})
output$vbox1 <- renderValueBox({
valueBox(
"Gender",
input$count,
icon = icon("users")
)
})
})
shinyApp(ui = ui, server = server)
Using this code the app looks like this:
Hope it helps!
Related
I am trying to use shinyCAPTCHA package with shinydashboard, but it is not working correctly. What is the correct way to use it?
library(shiny)
library(shinydashboard)
library(shinyCAPTCHA)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(recaptchaUI("test", sitekey = "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI"),
uiOutput(outputId = "captcha"))
)
server <- function(input, output) {
result <- callModule(recaptcha, "test", secret = "6LeIxAcTAAAAAGG-vFI1TnRWxMZNFuojJ4WifJWe")
output$captcha <- renderUI({
req(result()$success)
output$plot1 <- renderPlot({
set.seed(122);histdata <- rnorm(500)
hist(histdata[seq_len(input$slider)], main = "Histrogram", xlab = "x") })
fluidRow(
box(plotOutput("plot1", height = 250)),
box(title = "Controls",sliderInput("slider", "Number of observations:", 1, 100, 50)))
})
}
shinyApp(ui, server)
This is less bad I think
library(shiny)
library(shinydashboard)
library(shinyCAPTCHA)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(recaptchaUI("test", sitekey = "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI"),
uiOutput(outputId = "captcha"))
)
server <- function(input, output) {
result <- callModule(recaptcha, "test", secret = "6LeIxAcTAAAAAGG-vFI1TnRWxMZNFuojJ4WifJWe")
output$captcha <- renderUI({
req(result()$success)
output$plot1 <- renderPlot({
set.seed(122);histdata <- rnorm(500)
req(reactive(input$slider)())
hist(histdata[seq_len(reactive(input$slider)())], main = "Histrogram", xlab = "x") })
fluidRow(
box(plotOutput("plot1", height = 250)),
box(title = "Controls",sliderInput("slider", "Number of observations:", 1, 100, 50)))
})
}
shinyApp(ui, server)
Edit: Solved.
I am not sure what the problem was, but I guess it is about Rstudio.
When I uploaded the app to https://shinyapps.io/ , it works!
I am trying to render a plotly object with a shinyapp,
I read many queries online, most of them was about using "renderPlotly" instead of "renderPlot", but somehow my plot is not showing.
When I try with ggplot, it works great.
What am I doing wrong?
Thanks for any help, code attached:
library("shiny")
library("plotly")
library("shinydashboard")
ui <- dashboardPage(dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(plotlyOutput("plot1",height = 250)),
box(
title = "Controls",
sliderInput("slider", "Slider Value:", 1, 10, 5)
)
)
)
)
server <- function(input, output) {
output$plot1 <- renderPlotly({
clusters = my_classifier(k=input$slider, data=df)
results_df = cbind(df,as.factor(clusters))
colnames(results_df) = c("x","y","z","color")
plot_ly(data=results_df, x=~x, y=~y, z=~z,
type="scatter3d", mode="markers", color=~color)
})
}
# Run the application
shinyApp(ui = ui, server = server)
The example is not complete and has several issues. It works technically if we outcomment the incomplete data analysis part and replace it with random test data:
library("shiny")
library("plotly")
library("shinydashboard")
ui <- dashboardPage(dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(plotlyOutput("plot1",height = 250)),
box(
title = "Controls",
sliderInput("slider", "Slider Value:", 1, 10, 5)
)
)
)
)
server <- function(input, output) {
output$plot1 <- renderPlotly({
#clusters = my_classifier(k=input$slider, data=df)
#results_df = cbind(df,as.factor(clusters))
#colnames(results_df) = c("x","y","z","color")
## random test data set
results_df <- data.frame(x=runif(10), y=runif(10), z=rnorm(10), color=1:10)
plot_ly(data=results_df, x=~x, y=~y, z=~z,
type="scatter3d", mode="markers", color=~color)
})
}
# Run the application
shinyApp(ui = ui, server = server)
So my suggestion is to fix the data analysis part outside of shiny first, and when everything works, put the pieces together.
I am trying to build a r shiny app where the user will get to know about each function in just a click. For this I have coded below in R . But print(??input$A) is not working. Could anyone help please
library(shinydashboard)
library(readxl)
out <- data.frame(baseFns = ls('package:base'))
ui <- dashboardPage(
dashboardHeader(title = "Loading data"),
dashboardSidebar(sidebarMenu(
menuItem("Analysis", tabName = "Analysis", icon = icon("chart-bar"))
)),
dashboardBody(
tabItems(tabItem(tabName = "Analysis",
fluidRow(box(selectInput("A","A",choices = c(levels(factor(out$baseFns))),width = "150px"),width = 2),
fluidRow(box(htmlOutput("Text"),width = 9)))
)
))
)
server <- function(input,output){
output$Text <- renderText({
print(??input$A)
})
}
shinyApp(ui, server)
Here is a way:
library(shiny)
library(shinydashboard)
library(gbRd) # for Rd_fun
library(tools) # for Rd2HTML
out <- data.frame(baseFns = ls('package:base'))
ui <- dashboardPage(
dashboardHeader(title = "Loading data"),
dashboardSidebar(sidebarMenu(
menuItem("Analysis", tabName = "Analysis", icon = icon("chart-bar"))
)),
dashboardBody(
tabItems(
tabItem(
tabName = "Analysis",
fluidRow(
box(selectInput("A", "Topic", choices = levels(factor(out$baseFns)),
width = "150px"),
width = 2),
fluidRow(box(htmlOutput("helpfun"), width = 9))
)
)
))
)
server <- function(input, output, session){
output$helpfun <- renderUI({
Rd <- Rd_fun(help(input$A))
outfile <- tempfile(fileext = ".html")
Rd2HTML(Rd, outfile, package = "",
stages = c("install", "render"))
includeHTML(outfile)
})
}
shinyApp(ui, server)
I am trying to build a shiny app where the user can decide how many tabs he wants to be shown. Here's what I have so far:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(glue)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sliderInput(inputId = "slider", label = NULL, min = 1, max = 5, value = 3, step = 1)
),
dashboardBody(
fluidRow(
box(width = 12,
p(
mainPanel(width = 12,
column(6,
uiOutput("reference")
),
column(6,
uiOutput("comparison")
)
)
)
)
)
)
)
server <- function(input, output) {
output$reference <- renderUI({
tabsetPanel(
tabPanel(
"Reference",
h3("Reference Content"))
)
})
output$comparison <- renderUI({
req(input$slider)
tabsetPanel(
lapply(1:input$slider, function(i) {
tabPanel(title = glue("Tab {i}"),
value = h3(glue("Content {i}"))
)
})
)
})
}
shinyApp(ui = ui, server = server)
This does not produce the desired results, as the comparison tabs are not shown properly.
I have already checked out these 2 threads:
R Shiny - add tabPanel to tabsetPanel dynamically (with the use of renderUI)
R Shiny dynamic tab number and input generation
but they don't seem to solve my problem. Yes, they create tabs dynamically with a slider, but they don't allow to fill these with content as far as I can tell.
What works for me is a combination for lapply and do.call
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(glue)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sliderInput(inputId = "slider", label = NULL, min = 1, max = 5, value = 3, step = 1)
),
dashboardBody(
fluidRow(
box(width = 12,
p(
mainPanel(width = 12,
column(6,
uiOutput("reference")
),
column(6,
uiOutput("comparison")
)
)
)
)
)
)
)
server <- function(input, output) {
output$reference <- renderUI({
tabsetPanel(
tabPanel(
"Reference",
h3("Reference Content"))
)
})
output$comparison <- renderUI({
req(input$slider)
myTabs = lapply(1:input$slider, function(i) {
tabPanel(title = glue("Tab {i}"),
h3(glue("Content {i}"))
)
})
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui = ui, server = server)
I'm using shinydashboard package to create a shiny app.
In UI function I have a selectInput, which I would like to use those input later on in the box title but I don't know how could I access them I have tried input$xx, input.xx and 'input.xx' but it does not work :
dashboardSidebar(
selectInput("wind","Select Wind speed",choices = c(6,8,10,12),selected = 10),
selectInput("time","Select Time",choices = c(2,3,4),selected = 3),
downloadButton('report')
),
dashboardBody(
fluidRow(
box(width = 12,title = paste("time :", "'input$time'" ,"and wind speed :", "'input$wind'" ,"m/s are recorded."),
column(12,withSpinner(tableOutput("tab6"),type=5))
)
)
)
I have found the sloution :
Using RenderUI function :
in UI :
dashboardBody(
uiOutput("txt")
)
And in server :
output$txt <- renderUI({
fluidRow(
box(width = 12,title = paste("time :", input$time ,"and wind speed :", input$wind ,"m/s are recorded."),
column(12,withSpinner(tableOutput("tab6"),type=5))
),
box(width = 12,
column(12,withSpinner(tableOutput("tab3"),type=5))
)
)
})
This is how I would approach your issue.
Firstly you need to use the "updateTextInput" function of shiny. More details here:
https://shiny.rstudio.com/reference/shiny/1.0.2/updateTextInput.html
Here is how your code should look like:
ui <- dashboardPage(
dashboardHeader(title = "Control Panel"),
dashboardSidebar(
selectInput("wind","Select Wind speed",choices = c(6,8,10,12),selected = 10),
selectInput("time","Select Time",choices = c(2,3,4),selected = 3),
downloadButton('report')
),
dashboardBody(
fluidRow(
column(12,textInput("inText", "Text1"))
)
)
)
)
# 2. Server ---------------------------------------------------------------
server <- function(input, output, session){
observe({
x <- input$time
y <- input$wind
updateTextInput(session, "inText", value = paste("time :", x ,"and wind speed :", y ,"m/s are recorded."))
})
}
# 3. App ------------------------------------------------------------------
shinyApp(ui, server)