Shiny sliderInput keeps displaying decimals - r

I'm trying to create a slider. None of the base values I'm working with have decimals in them, so I have no idea why this continues to happen. I also have set the round parameter within the function as round = TRUE.
library(shiny)
test_df <- 19:45
ui <- fluidPage(
sliderInput("range1", label = h3("Select Range"), min(test_df),
max(test_df), value = c(min(test_df), max(test_df)), round = TRUE)
)
server <- function(input, output, session){
}
shinyApp(ui, server)
But as you can see, when you run it, it keeps showing numbers with decimals in the slider range.
I'm clearly missing something but have no idea as to what it is.

It looks like inputSlider made 10 ticks on your slider, regardless of whether or not that makes sense. 45-19=26, 26/10=2.6, and we are seeing steps of 2.6 on the slider. We can add a step argument to fix the slider so it moves in increments of 1 or whatever you choose.
library(shiny)
test_df <- 19:45
ui <- fluidPage(
sliderInput("range1", label = h3("Select Range"), min(test_df),
max(test_df), value = c(min(test_df), max(test_df)), round = TRUE,
step = 1)
)
server <- function(input, output, session){
}
shinyApp(ui, server)

Related

Multiple conditionalpanels [duplicate]

How to hide a conditional panel in Shiny? Please, see the following example:
library(shiny)
ui <- fluidPage(
actionButton("eval","Evaluate"),
numericInput("num_input", "If number is changed, cp must hide", value = 0),
conditionalPanel(
condition = "input.eval",
"text"))
server <- function(input, output, session) {
observeEvent(input$num_input, {
input$eval <- 0
})}
shinyApp(ui, server)
What I want to achieve is: Once the user clicks the evaluate-button the conditional panel should appear, but once the number in num_input is changed the panel should disappear. My idea was to null the evaluate-button, but this does not work (the app opens with gray background and seems frozen).
I also tried it with shinyjs like so:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
actionButton("eval","Evaluate"),
numericInput("num_input", "If number is changed, cp must hide", value = 0),
conditionalPanel(
id = "cond_panel",
condition = "input.eval",
"text"))
server <- function(input, output, session) {
observeEvent(input$num_input, {
reset("cond_panel")})}
shinyApp(ui, server)
But this does not work either: the app opens regularly and the conditional panel is shown once the evaluate-button is clicked, but nothing happens once the number is changed.
You can create an output value and use it just for the conditional panel. The article on dynamic UI explains how to do this:
http://shiny.rstudio.com/articles/dynamic-ui.html
The condition can also use output values; they work in the same way (output.foo gives you the value of the output foo). If you have a situation where you wish you could use an R expression as your condition argument, you can create a reactive expression in the server function and assign it to a new output, then refer to that output in your condition expression.
If you do this, make sure to also set outputOptions(output, [newOutputName], suspendWhenHidden = FALSE). (This is necessary because Shiny normally doesn’t send values to the browser for outputs that are hidden or not present in the UI. In this case, however, the browser does need to know the most up-to-date output value in order to correctly evaluate the condition of the contitionalPanel function - suspendWhenHidden = FALSE ensures this will happen.)
library(shiny)
ui <- fluidPage(
actionButton("eval","Evaluate"),
numericInput("num_input", "If number is changed, cp must hide", value = 0),
conditionalPanel("input.eval && !output.hide_panel", "text")
)
server <- function(input, output, session) {
output$hide_panel <- eventReactive(input$num_input, TRUE, ignoreInit = TRUE)
outputOptions(output, "hide_panel", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)
Another way would be to renderUI the conditional panel, and show it until input$num_input changes.
I have never played much with conditionalPanel, so not sure if it has default settings to hide/show. Following might work to give you the desired output.
library(shiny)
library(shinyjs)
if(interactive()){
shinyApp(
ui <- fluidPage(
shinyjs::useShinyjs(),
actionButton("eval","Evaluate"),
numericInput("num_input", "If number is changed, cp must hide", value = 0),
shinyjs::hidden(
div(
id = "cp1",
conditionalPanel(condition = "input.eval",
textOutput("text1")))
)
),
server = function(input, output, session){
output$text1 <- renderText({
input$num_input
})
observeEvent(input$eval,{
shinyjs::show("cp1")
})
observeEvent(input$num_input,{
shinyjs::hide("cp1")
})
}
)
}
I am hiding the conditionalPanel initially using shinyjs, displaying numeric input entered using renderText, and having two observeEvent to hide\show the panel accordingly.

how to use conditionalpanel() in shiny r

I am trying to create a shiny app where it allows you to select an input of what operation calculate. if the user chooses "Addition" it will show the two numeric input boxes (so they can input two numbers), if the user chooses "square" it will show only one numeric input box to square.
With this, I use conditionalPanel and if the condition is satisfied, it fetches through uiOutput() the numericInputs that I want. and same thing for square.
Now when I run this app, the conditional panels do not appear. Where did I go wrong? Thanks for checking out my question.
ui <- fluidPage( theme = shinytheme("slate"),
titlePanel("Basic Calculator"),
sidebarPanel(
selectInput("ops","Select what Operation use",choices = c("ADDITION","SQUARE")),
helpText("Please input the appropriate number depending on the operations"),
conditionalPanel("input.ops=='ADDITION'", uiOutput("var2")),
conditionalPanel("input.ops=='SQUARE'", uiOutput("var1"))
),#sidebar panel
)#fluidpage
server <- function(input, output) {
output$basicmath <- renderText( ifelse(input$ops=="ADDITION",input$a+input$b,
ifelse(input$ops=="SUBTRACTION",input$a-input$b,
ifelse(input$ops=="SQUARE",input$a*input$a,
ifelse(input$ops=="SQUARE ROOT",sqrt(input$a),
ifelse(input$ops=="MULTIPLICATION",input$a*input$b,"not a valid operation"))))),
output$var2 <- renderUI({
helpText("this will show to input two numerics to be added")
}) ,
output$var1 <- renderUI({
helpText("this will show to input one numeric to square")
})
)}
shinyApp(ui = ui, server = server)
The key issue you were having is that you put the uiOutputs inside the calculation output that you anticipated. It is better to separate them, since the calculation output won't run until it has the necessary prerequisite values (your input values). In addition, because you hadn't specified an output location for basicmath, the app didn't know where to put anything inside that call to renderText(). Below is working code that gets the right UI elements to appear.
One other thing you were missing in your renderUI was the use of tagList(). This helps ensure that all of your elements are packaged together, not just the last one.
Note that the math part does not work, but it looks like that was just a placeholder. When you do start to use it, be sure to use unique ids for each input. You have several instances of input$a and input$b, which probably isn't a workable approach.
library(shiny)
library(shinythemes)
ui <- fluidPage( theme = shinytheme("slate"),
titlePanel("Basic Calculator"),
sidebarPanel(
selectInput("ops","Select what Operation use",choices = c("ADDITION","SQUARE")),
helpText("Please input the appropriate number depending on the operations"),
conditionalPanel("input.ops=='ADDITION'", uiOutput("var2")),
conditionalPanel("input.ops=='SQUARE'", uiOutput("var1"))
),
mainPanel(
textOutput("basicmath")
)
)#fluidpage
server <- function(input, output) {
output$var2 <- renderUI({
tagList(
helpText("this will show to input two numerics to be added"),
splitLayout(
numericInput("var2a", label = "Input one number", value = NULL),
numericInput("var2b", label = "Input another number", value = NULL)
)
)
})
output$var1 <- renderUI({
tagList(
helpText("this will show to input one numeric to square"),
numericInput("var1a", label = "Input a number", value = NULL)
)
})
output$basicmath <- renderText( {ifelse(input$ops=="ADDITION",input$a+input$b,
ifelse(input$ops=="SUBTRACTION",input$a-input$b,
ifelse(input$ops=="SQUARE",input$a*input$a,
ifelse(input$ops=="SQUARE ROOT",sqrt(input$a),
ifelse(input$ops=="MULTIPLICATION",input$a*input$b,"not a valid operation")))))
})
}
shinyApp(ui = ui, server = server)

Reactive sliderInput ends in same slider

I'd like to create a range slider where when selecting one end of the slider updates the other end of the same slider. I know the trick is in observing a change at one end and using it to update the other end. However, I am getting a behaviour where the sliders are flipping back and forth, and I can't figure out why it's not settling.
For the sake of this example, I'd like the sliders to be centred within a 0-100 scale, so that when input$slider[1] is set to 10 then input$slider[2] moves to 90, and when input$slider[2] is moved to 80, input$slider[1] is moved to 20. Example (buggy) code below:
library(shiny)
ui <- fluidPage(
uiOutput("slidertest"),
verbatimTextOutput("values")
)
server <- function(input, output, session) {
sliderends <- reactiveValues(end=c(NULL,NULL))
observe({
sliderends$end[1] <- 100-input$slider[2]
})
observe({
sliderends$end[2] <- 100-input$slider[1]
})
output$slidertest <- renderUI({
sliderInput("slider","Update Ends?", min = 0, max=100, value=c(sliderends$end[1],sliderends$end[2]))
})
output$values <- renderText({paste(input$slider[1], input$slider[2], sliderends$end[1], sliderends$end[2], sep=";")})
}
shinyApp(ui, server)
An explanation of what I'm doing wrong and working suggestions would be greatly appreciated.
Thanks!
It seems your slider input get into an infinite loop.
input$slider[1] change → input$slider[2] change → input$slider[1] change ......
You can use reactiveValues to check whether the start value of sliderinput changed or the end value of sliderinput changed, then use updateSliderInput to update the value of your sliderinput.
See the following code :
library(shiny)
ui <- fluidPage(
# uiOutput("slidertest"),
sliderInput("slider","Update Ends?", min = 0, max=100,value=c(0,100) ),
verbatimTextOutput("values")
)
server <- function(input, output, session) {
sliderends <- reactiveValues(start=0,end=100)
observeEvent(input$slider,{
if(input$slider[1]!=sliderends$start){
#start value change
sliderends$start<-input$slider[1]
updateSliderInput( session,"slider","Update Ends?", min = 0, max=100,value=c( input$slider[1] , 100-input$slider[1] ) )
}else if(input$slider[2]!=sliderends$end){
#end value chagne
sliderends$end<-input$slider[2]
updateSliderInput( session,"slider","Update Ends?", min = 0, max=100,value=c( 100-input$slider[2] , input$slider[2] ) )
}
})
output$values <- renderText({paste(input$slider[1], input$slider[2], sliderends$start, sliderends$end, sep=";")})
}
shinyApp(ui, server)

My gvisBubbleChart Plot in Shiny R stops displaying when I attempt to introduce a dynamic selectInput field

I have encountered this problem while developing an app, and reproduced it here in a simplified script using Fruits df.
Basically, i have selectInput box to select a Year, which is a column in Fruits. I create unique list of Years, and feed it into selectInput box.
Then, ideally, i wanted my plot to display only the records for the year I selected. However, as you'll see in my code - the second you uncomment a block of 3 lines to accomplish that, - the plot stops displaying even though there doesn't seem to be any errors. Anybody knows why is this? Thanks in advance!!!
Related question - while debugging this i saw that the input$explore_year is at first "Null". I'm trying to handle this in the code but not sure why the selected="2010" doesn't take care of it automatically.
library(shiny)
library(googleVis)
library(DT)
listOfFruits <- sort(unique(Fruits$Year), decreasing = FALSE)
ui <- fluidPage(title = "Fruits Bug Recreated",
fluidRow(
column(3,
wellPanel(
uiOutput("choose_year"),
br()
)),
column(9,
tags$hr(),
htmlOutput("view")
)),
fluidRow(DT::dataTableOutput("tableExplore"))
)
server <- function(input, output) {
output$view <- renderGvis({
#Uncomment these 3 lines to see how the plot stops displaying.
# local_exloreYear <- input$explore_year
# if (is.null(local_exloreYear)) {local_exloreYear <- "2010"}
# FruitsSubset <- subset(Fruits, Year == local_exloreYear)
#------------I wanted to use the commented line below instead of the
#that follows
#gvisBubbleChart(FruitsSubset, idvar="Fruit",
#-------------
gvisBubbleChart(Fruits, idvar="Fruit",
xvar="Sales", yvar="Expenses",
colorvar="Year", sizevar="Profit",
options=list(
hAxis='{minValue:70, maxValue:125, title:"Sales"}',sortBubblesBySize=TRUE,
vAxis='{title: "Expenses",minValue:60, maxValue:95}'
))
})
# Drop-down selection box for dynamic choice of minutes in the plans to compare
output$choose_year <- renderUI({
selectInput("explore_year", "Select Year", as.list(listOfFruits),selected ="2010")
})
output$tableExplore <- DT::renderDataTable(DT::datatable({
FruitsSubset <- subset(Fruits, Fruits$Year == input$explore_year)
myTable <-FruitsSubset[,c(1,2,3,4,5,6)]
data <- myTable
data
},options = list(searching = FALSE,paging = FALSE)
))
}
shinyApp(ui = ui, server = server)
Like i wrote in the comments you can solve it by make the rendering conditional on the input being non-NULL.
output$view <- renderGvis({
if(!is.null(input$explore_year)){
...
}
})
Nevertheless, I don´t think it is really intended that you have to do that, as in other render functions it is not required e.g. in the DT::renderDataTable(), where you also use the same input (being NULL initially).
Therefore, I would suggest reporting it as a bug.

implement a simple counter to count reactive firing in Shiny

I would like to keep track of how many times the user has refreshed my Shiny vis.
I figured I would just set a counter up outside of the reactive area
number <- 0
and have it update by adding one every time the code in reactive block fires.
But it doesn't work.
Ideas:
make the counter a global var?
silly idea, doesn't work
put the number <- 0 inside the reactive area?
of
course that's not the solution
I'm not sure which direction to go here. Anyone have any ideas?
require(shiny)
number <- 0
runApp(list(ui = pageWithSidebar(
headerPanel("This is a test"),
sidebarPanel(
helpText("This is a test"),
sliderInput("range",
label = "Pick a number:",
min = 0, max = 100, value = 0)
),
mainPanel(textOutput("text1"),
htmlOutput("text")
)
),
server = function(input, output) {
number <- number + 1
output$text <- renderUI({
str <- paste("You have chosen:",
input$range)
HTML(paste(str, sep = '<br/>'))
View(number)
})
}
)
)
Shiny has reactiveValues that are like an environment - they get passed by reference so you can assign to them with the regular assignment operator from within reactive expressions. For example,
library(shiny)
ui <- pageWithSidebar(
headerPanel("This is a test"),
sidebarPanel(sliderInput("range", "Pick", 0, 100, 10)),
mainPanel(htmlOutput("text"))
)
server <- function(session, input, output) {
vals <- reactiveValues(count = -1)
observeEvent(input$range, vals$count <- vals$count + 1)
output$text <- renderUI({
HTML(paste(sprintf("You have chosen: %s</br>", vals$count)))
})
}
shinyApp(ui, server)
Sidenote: you could also do it as a global variable like mentioned using <<-, but I would say it is a bad idea because of how <<- searches backwards through environments, and I think that it could have surprising results.

Resources