I want the app to load a single time with default values, but become reactive only when the user types the correct password. To keep things simple let's work from the Rstudio template (minutely edited):
ui.R:
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
passwordInput("pw", "Password:"),
sliderInput("nbins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput("histo")
)
)))
server.R:
PASSWORD <- "test"
library(shiny)
shinyServer(function(input, output) {
output$histo <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$nbins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
})
There are two reactive inputs pw and nbins. My question is: How could the code be extended to make nbins (behavior) switch between reactive and non-reactive depending on the input pw being equal to PASSWORD?
Building on Valter's answer, you can use shinyjs to enable/disable interactivity with the input widget.
ui.R
library(shiny)
library(shinyjs) # install shinyjs
shinyUI(fluidPage(
useShinyjs(), # activate
sidebarLayout(
sidebarPanel(
passwordInput("pw", "Password:"),
sliderInput("nbins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput("histo")
)
)))
server.R
library(shiny)
library(shinyjs)
shinyServer(function(input, output) {
observe({
if(input$pw != "PASSWORD") shinyjs::hide("nbins") else shinyjs::show("nbins")
})
output$histo <- renderPlot({
x <- faithful[, 2]
# will 'reset' bins to original value if incorrect pw
if(input$pw != "PASSWORD") {
bins <- seq(min(x), max(x), length.out = 30 + 1)
} else {
bins <- seq(min(x), max(x), length.out = input$nbins + 1)
}
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
})
What about this solution:
PASSWORD <- "test"
library(shiny)
shinyServer(function(input, output) {
bins <- eventReactive(input$nbins, {
if (input$pw == PASSWORD) {
bins <- seq(min(faithful[, 2]), max(faithful[, 2]), length.out = input$nbins + 1)
} else {
bins <- seq(min(faithful[, 2]), max(faithful[, 2]), length.out = 30 + 1)
}
})
output$histo <- renderPlot({
x <- faithful[, 2]
hist(x, breaks = bins(), col = 'darkgray', border = 'white')
})
})
Related
I am using bsModal() window from the ShinyBS package in one of my Shiny Apps. Whenever the user opens the modal window for the second time, the contents of the window from the first opening remain on the screen until the new content loads. Which is not ideal. Is there a way to delete the contents of the bsModal() window once it is closed? I do not want the older content to appear in the window once it is reopened. Subsequently, maybe there is a way to clean up the bsModal() window before opening?
I wasn't able to find any solution for this
Here is some example (not my) code of an app that can be also accessed through:
library(shinyBS)
bsExample("Modals")
ui.R
library(shiny)
library(shinyBS)
fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("tabBut", "View Table")
),
mainPanel(
plotOutput("distPlot"),
bsModal("modalExample", "Data Table", "tabBut", size = "large",
dataTableOutput("distTable"))
)
)
)
server.R
library(shiny)
library(shinyBS)
shinyServer(
function(input, output, session) {
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$distTable <- renderDataTable({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
tab <- hist(x, breaks = bins, plot = FALSE)
tab$breaks <- sapply(seq(length(tab$breaks) - 1), function(i) {
paste0(signif(tab$breaks[i], 3), "-", signif(tab$breaks[i+1], 3))
})
tab <- as.data.frame(do.call(cbind, tab))
colnames(tab) <- c("Bins", "Counts", "Density")
return(tab[, 1:3])
}, options = list(pageLength=10))
}
)
I am developing a shiny app and want to improve the accuracy of the slider (the slider ranges from 0 to 1000 and it's very difficult to accurately adjust the slider with a step of 1). I can't find an answer to this anywhere.
This is the code for one of my sliders:
sliderInput("mean2", "", min=0, max=1000, value=500, step=1)
Try arranging your code like such:
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
actionButton("minus", "Minus"),
actionButton("plus", "Plus"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("mean2",
"Number of bins:",
min = 0,
max = 1000,
value = 500,
step= 1)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
v <- reactiveValues(data = 500)
observeEvent(input$minus, {
v$data <- input$mean2 - 1
updateSliderInput(session,"mean2", value = input$mean2 - 1)
})
observeEvent(input$plus, {
v$data <- input$mean2 + 1
updateSliderInput(session,"mean2", value = input$mean2 + 1)
})
observeEvent(input$mean2, {
v$data <- input$mean2
})
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = v$data + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui, server)
I'm trying to create a timed counter within a Shiny app. When it increments each second, it should refresh a plot with some new characteristic that depends on the counter. Here's an example based on the 'Old Faithful' app. It doesn't work, but it gets at the idea. I tried to have reactiveTimer() refresh the plot, and a counter recorded with reactiveValues().
server.R
library(shiny)
shinyServer(function(input, output) {
refreshPlot <- reactiveTimer(intervalMs = 1000)
vals <- reactiveValues(counter = 0)
output$distPlot <- renderPlot({
refreshPlot()
vals$counter <- isolate(vals$counter) + 1
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
n_bins <- input$bins + vals$counter
bins <- seq(min(x), max(x), length.out = n_bins)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
})
ui.R
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
invalidateLater is what I'm looking for. Thanks, Dieter. Below is the server.R that works.
library(shiny)
shinyServer(function(input, output, session) {
vals <- reactiveValues(counter = 0)
output$distPlot <- renderPlot({
invalidateLater(millis = 1000, session)
vals$counter <- isolate(vals$counter) + 1
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
n_bins <- input$bins + vals$counter
bins <- seq(min(x), max(x), length.out = n_bins)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
})
I use the library shinythemes pretty extensively in apps that I build. I was trying to leverage a bsModal from the shinyBS package and noticed that the 'fade in' div never went away leaving me with an unusable web app since nothing was clickable.
The examples from shinyBS::bsModal all work fine (they are sans-shinythemes). How can I continue to use themes while also using modals?
Example App:
library(shiny)
library(shinyBS)
library(shinythemes)
app = shinyApp(
ui =
navbarPage(title=NULL,
id="navbar",
theme = shinytheme("journal"),
tabPanel("test",
column(1),
column(3,
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("tabBut", "View Table")
),
column(7,
plotOutput("distPlot"),
bsModal("modalExample", "Data Table", "tabBut", size = "large",
dataTableOutput("distTable"))
)
)
),
server =
function(input, output, session) {
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$distTable <- renderDataTable({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
tab <- hist(x, breaks = bins, plot = FALSE)
tab$breaks <- sapply(seq(length(tab$breaks) - 1), function(i) {
paste0(signif(tab$breaks[i], 3), "-", signif(tab$breaks[i+1], 3))
})
tab <- as.data.frame(do.call(cbind, tab))
colnames(tab) <- c("Bins", "Counts", "Density")
return(tab[, 1:3])
}, options = list(pageLength=10))
}
)
runApp(app)
I don't know what causes the conflict, but the solution is to specify the link to the theme directly. Replace theme = shinytheme("journal") with theme = "http://bootswatch.com/journal/bootstrap.css" adjusting the name for the theme you're using.
I am building my first app in shiny. The problem to solve is like this.
I've ui
shinyUI(fluidPage(
# Application title
titlePanel("My"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel("Variables",
sliderInput("bins",
"Number of circles:",
min = 1,
max = 50,
value = 30),
sliderInput("bins",
"Number of triangels:",
min = 1,
max = 50,
value = 1)
),
# Show a plot of the generated distribution
mainPanel(tabsetPanel(
tabPanel("Data", plotOutput("distPlot")),
tabPanel("Data1", textOutput("text1")),
tabPanel("Data2", plotOutput("distPlot1")))
)
)
))
and server
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$distPlot1 <- renderPlot({
x <- faithful[, 2]
plot(density(x))
})
output$text1 <- renderText({
"Hello mother"
})
})
The question concern ui part. I'd like to fave 2 panels in the sidebarPanel - triangles and circles, similar to that what is in the mainPanel i.e. Data, Data1, Data2.
Thanks for the comments!