Related
I want to build an app with the checkbox asking whether to show additional text comments under the figures.
I would like to display set of plots with or without an explanation - this shall be left to the user, whether they need more info or not.
Here are some dummy comments:
#info for box1:
"This is the red histogram"
#info for box2:
"This is the blue histogram"
Here is a dummy app:
library(shiny)
library(shinydashboard)
data <- rnorm(10000, mean=8, sd=1.3)
variable <- "This is the blue histogram"
shinyApp(
ui = dashboardPage(
skin = "black",
dashboardHeader(
title = "Example app",
titleWidth = 300
),
dashboardSidebar(
checkboxInput("show_comment",
label = "Show comment?",
value = FALSE)
),
dashboardBody(
box(title = "First histogram",
status= "warning",
plotOutput("plot1", height=300)
),
box(title = "Second histogram",
status= "warning",
plotOutput("plot2", height=300),
hidden(
div(id='text_div',
verbatimTextOutput("text")))
)
)
),
server = function(input, output) {
output$plot1 <- renderPlot({
hist(data, breaks=40, col="red", xlim=c(2,14), ylim=c(0,800))
})
output$plot2 <- renderPlot({
hist(data, breaks=20, col="blue", xlim=c(2,34), ylim=c(0,1000))
})
observeEvent(input$show_comment, {
toggle('text_div')
output$text <- renderText({ paste0(variable)})
})
}
)
The above code does not work properly - it displays comment no matter if the checkbox is clicked or not. I'd like to make it work, therefore seek for advice here.
I was trying to do it on my own using following hints, to no avail:
How to use shiny actionButton to show & hide text output?
This syntax is too complex for me as I am a beginner with shiny, so I was not able to troubleshoot my problem with hints from this thread:
Show and hide text in modularized shiny app based on actionButton() and shinyJS()
I also tried ths:
Hide/show outputs Shiny R
And here is the attempt of using above hint:
library(shiny)
library(shinydashboard)
data <- rnorm(10000, mean=8, sd=1.3)
variable <- "This is the blue histogram"
shinyApp(
ui = dashboardPage(
skin = "black",
dashboardHeader(
title = "Example app",
titleWidth = 300
),
dashboardSidebar(
checkboxInput("show_comment",
label = "Show comment?",
value = FALSE)
),
dashboardBody(
box(title = "First histogram",
status= "warning",
plotOutput("plot1", height=300)
),
box(title = "Second histogram",
status= "warning",
plotOutput("plot2", height=300),
renderText("text", span(variable))
)
)
),
server = function(input, output) {
output$plot1 <- renderPlot({
hist(data, breaks=40, col="red", xlim=c(2,14), ylim=c(0,800))
})
output$plot2 <- renderPlot({
hist(data, breaks=20, col="blue", xlim=c(2,34), ylim=c(0,1000))
})
observeEvent(input$show_comment, {
# every time the button is pressed, alternate between hiding and showing the plot
toggle("text")
})
}
)
I want to put the comments inside the same box, along with the plot - this is why I am trying to enclose it with the box command. However, if it is impossible - I would be glad of any other solution.
First time I use shinyjs so there might be a better approach. But as I understand it from the docs you first have to add useShinyjs() in your UI code
in order for all other shinyjs functions to work.
Second, there is no need to wrap the div for your comment in hidden(). Third, instead of using observeEvent I followed the example in ?toggle and use an observe where I add the state of your checkbox as the condition to trigger the toggle.
library(shiny)
library(shinydashboard)
library(shinyjs)
data <- rnorm(10000, mean = 8, sd = 1.3)
variable <- "This is the blue histogram"
shinyApp(
ui = dashboardPage(
skin = "black",
dashboardHeader(
title = "Example app",
titleWidth = 300
),
dashboardSidebar(
checkboxInput("show_comment",
label = "Show comment?",
value = FALSE
)
),
dashboardBody(
box(
title = "First histogram",
status = "warning",
plotOutput("plot1", height = 300)
),
box(
title = "Second histogram",
status = "warning",
plotOutput("plot2", height = 300),
div(id = "text_div",
verbatimTextOutput("text")
)
)
),
useShinyjs()
),
server = function(input, output) {
output$plot1 <- renderPlot({
hist(data, breaks = 40, col = "red", xlim = c(2, 14), ylim = c(0, 800))
})
output$plot2 <- renderPlot({
hist(data, breaks = 20, col = "blue", xlim = c(2, 34), ylim = c(0, 1000))
})
observe({
toggle(id = "text_div", condition = input$show_comment)
output$text <- renderText({
paste0(variable)
})
})
}
)
#>
#> Listening on http://127.0.0.1:7437
I want to give the user option to select which plots/tables he/she wants to see at the end of an analysis.
All the plots are produced from one dataset and include time series plots, boxplots, histograms etc.
The questions I stumbled upon are
Do I use one or multiple plotOutput("Plot",....) element? So far I have been arranging plots in one figure so one plotOutput was sufficient
Do I use the predefined height, as in plotOutput("Plot",height = "1800px")?
If the number of figures varies this creates empty space, I would like to avoid it.
How to add Tables with results?
Any comments would be very appreciated, Mac
You can wrap you plots in conditionalPanel's to deselect them.
For this you will need 1. multiple plotOutput's.
2. When everything is wrapped in a fluidRow there won't be any empty space.
3. See the following example and: http://shiny.rstudio.com/reference/shiny/0.14/tableOutput.html
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(title = "Plot selection"),
dashboardSidebar(
materialSwitch(inputId="switch1", label = "Show plot 1", value = TRUE, status = "primary"),
materialSwitch(inputId="switch2", label = "Show plot 2", value = TRUE, status = "primary"),
materialSwitch(inputId="switch3", label = "Show plot 3", value = TRUE, status = "primary"),
materialSwitch(inputId="switch4", label = "Show plot 4", value = TRUE, status = "primary")
),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
conditionalPanel(condition = "input.switch1", box(plotOutput("plot1", height = 250))),
conditionalPanel(condition = "input.switch2", box(plotOutput("plot2", height = 250))),
conditionalPanel(condition = "input.switch3", box(plotOutput("plot3", height = 250))),
conditionalPanel(condition = "input.switch4", box(plotOutput("plot4", height = 250))),
column(12,
dataTableOutput('table')
)
)
)
)
server <- function(input, output) {
df <- data.frame(col1 = rnorm(500), col2 = rnorm(500), col3 = rnorm(500), col4 = rnorm(500))
output$plot1 <- renderPlot({
plot(df$col1, col="red", main="Plot 1")
})
output$plot2 <- renderPlot({
plot(df$col2, col="green", main="Plot 2")
})
output$plot3 <- renderPlot({
plot(df$col3, col="blue", main="Plot 3")
})
output$plot4 <- renderPlot({
plot(df$col4, col="black", main="Plot 4")
})
output$table <- renderDataTable(df)
}
shinyApp(ui, server)
Edit ----------------------------------------
Here is a pure shiny version:
library(shiny)
ui <- fluidPage(
titlePanel("Plot selection"),
sidebarLayout(
sidebarPanel(width = 2,
checkboxInput(inputId="switch1", label = "Show plot 1", value = TRUE),
checkboxInput(inputId="switch2", label = "Show plot 2", value = TRUE),
checkboxInput(inputId="switch3", label = "Show plot 3", value = TRUE),
checkboxInput(inputId="switch4", label = "Show plot 4", value = TRUE)
),
mainPanel(
fluidRow(
conditionalPanel(condition = "input.switch1", plotOutput("plot1", height = 250)),
conditionalPanel(condition = "input.switch2", plotOutput("plot2", height = 250)),
conditionalPanel(condition = "input.switch3", plotOutput("plot3", height = 250)),
conditionalPanel(condition = "input.switch4", plotOutput("plot4", height = 250)),
column(12,
dataTableOutput('table')
)
)
)
)
)
server <- function(input, output) {
df <- data.frame(col1 = rnorm(500), col2 = rnorm(500), col3 = rnorm(500), col4 = rnorm(500))
output$plot1 <- renderPlot({
plot(df$col1, col="red", main="Plot 1")
})
output$plot2 <- renderPlot({
plot(df$col2, col="green", main="Plot 2")
})
output$plot3 <- renderPlot({
plot(df$col3, col="blue", main="Plot 3")
})
output$plot4 <- renderPlot({
plot(df$col4, col="black", main="Plot 4")
})
output$table <- renderDataTable(df)
}
# shinyApp(ui, server)
shinyApp(ui = ui, server = server)
For further information see:
https://rstudio.github.io/shinydashboard/get_started.html
https://dreamrs.github.io/shinyWidgets/reference/materialSwitch.html
I have developed an application, where I am generating plots. I am able to render the plots and download it without any problem.
I would like to get the details of the points in the graph, when i move my cursor to the points. With search, I am not sure, if I can obtain this in Shiny.
Any help would be great.
Below is the code, i have used.
UI Code:
tabItem(tabName = "models2",
fluidPage(
fluidRow(
infoBoxOutput("overview")
),
fluidRow(
actionButton("result1","Generate Result"),
downloadButton('downloadPlot','Download Plot'),
plotOutput("plot3")
)
))
SERVER CODE
server <- function(input,output){
output$claim_overview <- renderValueBox({
valueBox(
paste("91")," Overview",icon=icon("hourglass"),
color="green"
)
})
data<- reactiveValues()
observeEvent(input$result1,{
data$plot <- ggplot(data=timedata, aes(x=dat1, y=yes, group=3))+
geom_point(shape=1)+
coord_cartesian(xlim=c(dat1_xlowlim,dat1_xhighlim))+
labs(title="Prediction Probability",x="Reg.Date",y="True probability")
})
output$plot3 <- renderPlot({ data$plot })
output$downloadPlot <- downloadHandler(
filename = function()
{paste("input$plot3",'.png',sep='')
},
content = function(file){
ggsave(file,plot = data$plot)
}
)
}
You can use either brush option or hover option to get any info from the plot.
Mouse hover example:
df<- table(rpois(100, 5))
ui <- fluidPage(
mainPanel(
plotOutput(outputId = "scatterplot", hover = "plot_hover"),
verbatimTextOutput(outputId = "dftable"),
br()
)
)
server <- function(input, output) {
output$scatterplot <- renderPlot({
plot(df, type = "h", col = "red", lwd = 10)
})
output$dftable <- renderPrint({
paste(input$plot_hover)
})
}
shinyApp(ui = ui, server = server)
i just new in Shiny and i have a problem in shiny. i have a plot but the plot not display in shiny. and no message error.this is the code...
UI
library(shiny)
ui = fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
uiOutput("scatter")
))
)
server
library(shiny)
server = function(input, output) {
output$scatter <- renderUI({
datax <- matrix(c(1,2,3,4,5,6),6,1)
datay <- matrix(c(1,7,6,4,5,3),6,1)
titleplot<-"title"
summary <- "testing text"
pl <- plot(datax, datay, main = titleplot, xlab = "input$axis1", ylab = "input$axis2", pch=18, col="blue")
list(
pl,
summary
)
})
}
Actually you also can use uiOutput, and it is very useful sometimes, because you can create a user interface from the server side. This is the solution:
library(shiny)
ui = fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
uiOutput("scatter")
))
)
server = function(input, output) {
output$scatter <- renderUI({
datax <- matrix(c(1,2,3,4,5,6),6,1)
datay <- matrix(c(1,7,6,4,5,3),6,1)
titleplot<-"title"
summary <- "testing text"
output$plot_test <- renderPlot({
pl <- plot(datax, datay, main = titleplot, xlab = "input$axis1", ylab = "input$axis2", pch=18, col="blue")
})
plotOutput("plot_test")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Change your renderUI function in server to renderPlot while uiOutput to plotOutput in ui correspondingly.
library(shiny)
ui = fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
plotOutput("scatter")
))
)
server = function(input, output) {
output$scatter <- renderPlot({
datax <- matrix(c(1,2,3,4,5,6),6,1)
datay <- matrix(c(1,7,6,4,5,3),6,1)
titleplot<-"title"
summary <- "testing text"
pl <- plot(datax, datay, main = titleplot, xlab = "input$axis1", ylab = "input$axis2", pch=18, col="blue")
list(
pl,
summary
)
})
}
shinyApp(ui, server)
You need to assign seperate output slots for the plot and the text. That is because shiny uses different (css) classes for each of tose render functions. The following code should do what you want.
library(shiny)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(),
mainPanel(
plotOutput("scatter"),
textOutput("testingText")
)
)
)
server <- function(input, output) {
output$scatter <- renderPlot({
datax <- matrix(c(1, 2, 3, 4, 5, 6), 6, 1)
datay <- matrix(c(1, 7, 6, 4, 5, 3), 6, 1)
titleplot <- "title"
plot(datax, datay, main = titleplot, xlab = "input$axis1",
ylab = "input$axis2", pch = 18, col = "blue")
})
output$testingText <- renderText({
"testing text"
})
}
shinyApp(ui, server)
Additional note: The line
pl <- plot( ... )
does not make sense. In R, plots can not be saved as objects. ggplots are an exception, but you would still have to use renderPlot to display a ggplot object in shiny.
I am facing an issue with shiny dashboard. I am trying to create a simple dashboard with two tabItems on the left. Each tabItem have their specific set of controls and a plot. But I am probably missing something on the server side to link the input to the tab because the controls of the second tab is behaving strangely. Any help would be much appreciated. Here is my code
library(shiny)
library(shinydashboard)
library(data.table)
library(ggplot2)
data = data.table(group = rep(c(1, 3, 6), each = 10), x = rep(1:10, times = 3), value = rnorm(30))
sidebar <- dashboardSidebar(
sidebarMenu(id = 'sidebarMenu',
menuItem("tab 1", tabName = "tab1", icon = icon("dashboard")),
menuItem("tab 2", icon = icon("th"), tabName = "tab2")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "tab1",
fluidRow(
box(title = "Controls",
checkboxGroupInput('group', 'group:', c(1, 3, 6), selected = 6, inline = TRUE), width = 4),
box(plotOutput("plot1"), width = 8)
)
),
tabItem(tabName = "tab2",
fluidRow(
box(title = "Controls",
checkboxGroupInput('group', 'group:', c(1, 3, 6), selected = 6, inline = TRUE), width = 4),
box(plotOutput("plot2"), width = 8)
)
)
)
)
# Put them together into a dashboardPage
ui <- dashboardPage(
dashboardHeader(title = "test tabbed inputs"),
sidebar,
body,
skin = 'green'
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plotData <- data[group %in% input$group]
p <- ggplot(plotData, aes(x = x, y = value, colour = factor(group))) + geom_line() + geom_point()
print(p)
})
output$plot2 <- renderPlot({
plotData <- data[group %in% input$group]
p <- ggplot(plotData, aes(x = x, y = value, colour = factor(group))) + geom_line() + geom_point()
print(p)
})
}
shinyApp(ui, server)
When I change input in the first tab it also changes in the second and then when I try to change it back often time nothing happens or it just behaves weirdly. I think I need to specify tie the input to the tabItems somehow but could not find a good example of doing that. Any help would be much appreciated.
Thanks,
Ashin
To deal with a dynamic number of tabs or other widgets, create them in server.R with renderUI. Use a list to store the tabs and the do.call function to apply the tabItems function. The same for the sidebar.
I think my code below generates your expectation.
library(shiny)
library(shinydashboard)
library(data.table)
library(ggplot2)
data = data.table(group = rep(c(1, 3, 6), each = 10), x = rep(1:10, times = 3), value = rnorm(30))
sidebar <- dashboardSidebar(
uiOutput("Sidebar")
)
body <- dashboardBody(
uiOutput("TABUI")
)
# Put them together into a dashboardPage
ui <- dashboardPage(
dashboardHeader(title = "test tabbed inputs"),
sidebar,
body,
skin = 'green'
)
server <- function(input, output) {
ntabs <- 3
tabnames <- paste0("tab", 1:ntabs) # "tab1", "tab2", ...
checkboxnames <- paste0(tabnames, 'group') # "tab1group", "tab2group", ...
plotnames <- paste0("plot", 1:ntabs) # "plot1", "plot2", ...
output$Sidebar <- renderUI({
Menus <- vector("list", ntabs)
for(i in 1:ntabs){
Menus[[i]] <- menuItem(tabnames[i], tabName = tabnames[i], icon = icon("dashboard"), selected = i==1)
}
do.call(function(...) sidebarMenu(id = 'sidebarMenu', ...), Menus)
})
output$TABUI <- renderUI({
Tabs <- vector("list", ntabs)
for(i in 1:ntabs){
Tabs[[i]] <- tabItem(tabName = tabnames[i],
fluidRow(
box(title = "Controls",
checkboxGroupInput(checkboxnames[i], 'group:', c(1, 3, 6), selected = 6, inline = TRUE),
width = 4),
box(plotOutput(paste0("plot",i)), width = 8)
)
)
}
do.call(tabItems, Tabs)
})
RV <- reactiveValues()
observe({
selection <- input[[paste0(input$sidebarMenu, 'group')]]
RV$plotData <- data[group %in% selection]
})
for(i in 1:ntabs){
output[[plotnames[i]]] <- renderPlot({
plotData <- RV$plotData
p <- ggplot(plotData, aes(x = x, y = value, colour = factor(group))) +
geom_line() + geom_point()
print(p)
})
}
}
shinyApp(ui, server)
Note that I put the "plot data" in a reactive list. Otherwise, if I did that:
output[[plotnames[i]]] <- renderPlot({
selection <- input[[paste0(input$sidebarMenu, 'group')]]
plotData <- data[group %in% selection]
...
the plot would be reactive each time you go back to a tab (try to see what I mean).