I plot GPS data on a leaflet map using R,
the trip is visualised through an incrementing timeline provided by the sliderInput in animation mode.
sliderInput("animation", "Mesures GPS :",
min = ifelse( !exists("i.data"), 0, min(i.data$sequence)),
max = ifelse( !exists("i.data"), 1, max(i.data$sequence)),
value = 0,
step=20,
animate = animationOptions(interval = 1000, loop = FALSE),
width="100%"))
I can see the GPS points jumping over the map, and now I am looking for the way to have a "next" button ([<<], [>>]) to control more finely local steps. I have not seen any such option in the sliderInput documentation.
This could also be done by adding ad-hoc shiny actionButtons,
any suggestion?
Adapting the code from ?sliderInput:
library(shiny)
shinyApp(
ui = fluidPage(
fluidRow(
div(style = "display: inline-block;vertical-align:center;",
actionButton("left", label = "<<")),
div(style = "display: inline-block;vertical-align:center;",
sliderInput("obs", "Number of observations:",
min = 0, max = 1000, value = 500
)),
div(style = "display: inline-block;vertical-align:center;",
actionButton("right", label = ">>")),
),
plotOutput("distPlot")
),
# Server logic
server = function(input, output, session) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs))
})
observeEvent(input$left, {
updateSliderInput(session, "obs", value = input$obs - 10)
})
observeEvent(input$right, {
updateSliderInput(session, "obs", value = input$obs + 10)
})
}
)
This updates by +/- 10.
Related
I'm looking at having two sliders that should update together, based on some function. For example, one slider is the square root of the other. I want to be able to change either slider and for the other one to update reactively.
The following does work:
library(shiny)
server = function(input, output) {
f = reactive(function(x) x^2)
finv =reactive(function(x) sqrt(x))
output$x <- renderUI({
slider_s.value <- input$s
default.slider_x <- if (is.null(slider_s.value)) 1 else f()(slider_s.value)
sliderInput("x", "Select x:",
min = 0, max=100,
value = default.slider_x, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
output$s <- renderUI({
slider_x.value <- input$x
default.slider_s <- if (is.null(slider_x.value)) finv()(1) else finv()(slider_x.value)
sliderInput("s", "Select s:",
min = 0, max=10,
value = default.slider_s, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
}
ui = fluidPage(
titlePanel("One Way Reactive Slider"),
fluidRow(
column(3,
wellPanel(
h4("Slider Inputs"),
uiOutput('s'),
uiOutput('x')
))
)
)
shinyApp(ui = ui, server = server)
However, this doesn't.
library(shiny)
server = function(input, output) {
g = reactive(function(x) x^2 - input$slider)
ginv =reactive(function(x) sqrt(x+ input$slider))
output$slider <- renderUI({
sliderInput("slider", "Slider input:",
min = 1, max = 100, value = 2)
})
output$x <- renderUI({
slider_s.value <- input$s
default.slider_x <- if (is.null(slider_s.value)) 1 else g()(slider_s.value)
sliderInput("x", "Select x:",
min = 0, max=100,
value = default.slider_x, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
output$s <- renderUI({
slider_x.value <- input$x
default.slider_s <- if (is.null(slider_x.value)) ginv()(1) else ginv()(slider_x.value)
sliderInput("s", "Select s:",
min = 0, max=10,
value = default.slider_s, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
}
ui = fluidPage(
titlePanel("One Way Reactive Slider"),
fluidRow(
column(3,
wellPanel(
h4("Slider Inputs"),
uiOutput('slider'),
uiOutput('s'),
uiOutput('x')
))
)
)
shinyApp(ui = ui, server = server)
It messes up when the "Slider Input" is changed. Is there some way that I can get round this? I've seen other posts on here about constraining sliders but none seem to rely on other inputs like this.
Note that I want x = g(s) and s = ginv(x) which should be okay since g and ginv are inverses of each other!
Some changes are required in output$x <- RenderUI code block to fix the slider values flickering issue.
output$x <- renderUI({
slider_slider.value <- input$slider
default.slider_x <- if (is.null(slider_slider.value)) 1 else g()(slider_slider.value)
sliderInput("x", "Select x:",
min = 0, max=100,
value = default.slider_x, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
I'm a beginner in shiny app. so first I tried to build an app to calculate distance covered using time taken and speed. I got error as "argument of length zero". Then I entered req(input$num_time,input$select_time,input$slider_speed)this command after that error message is not displaying and also not getting output also. I'm not able to find where I gone wrong. Please help me in getting the output. I have shown the code I used below:
library(shiny)
#library(car)
ui <- fluidPage(
titlePanel("terrain model"),
sidebarLayout(
sidebarPanel(
helpText("To create a suitable model"),
br(),
numericInput("num_time",
label = h6("Enter time"),
value = 1),
selectInput("select_time",
label = h6(""),
choices = list("Hours"= 1,"Minutes" = 2),
selected = "1"),
sliderInput("Speed",
label = "Speed:",
min = 2, max = 4.5, value = 2),
br(),
actionButton("action",label="Refresh & Calculate")
),
mainPanel(
textOutput("text_distance")
)
)
)
server <- function(input, output) {
values <- reactiveValues()
#calculate distance travelled
observe({input$action_Calc
values$int <- isolate({ input$num_time * recode(input$select_time,"1='60';2='1'")*input$slider_speed
})
})
#Display values entered
output$text_distance <- renderText({
req(input$num_time,input$select_time,input$slider_speed)
if(input$action_Calc==0)""
else
paste("Distance:", round(values$int,0))
})
}
shinyApp(ui, server)
I don't find any use of "Refresh & Calculate" button since the calculation is performed as soon as any of the input changes.
You can try this code :
ui <- fluidPage(
titlePanel("terrain model"),
sidebarLayout(
sidebarPanel(
helpText("To create a suitable model"),
br(),
numericInput("num_time",
label = h6("Enter time"),
value = 1),
selectInput("select_time",
label = h6(""),
choices = list("Hours"= 1,"Minutes" = 2),
selected = "1"),
sliderInput("Speed",
label = "Speed:",
min = 2, max = 4.5, value = 2),
br(),
actionButton("action",label="Refresh & Calculate")
),
mainPanel(
textOutput("text_distance")
)
)
)
server <- function(input, output) {
#Display values entered
output$text_distance <- renderText({
val <- input$num_time/dplyr::recode(input$select_time,"1"=1,"2"=60)*input$Speed * 1000
paste("Distance:", round(val,0), 'meters')
})
}
shinyApp(ui, server)
I want to perform the Shapiro-Wilk-Test in my Shiny App. Over the two sliders and the numeric input I get the values for rnorm. And because I can change my inputs to rnorm, I made it reactive.
But when running the app it doesn't work - I tried a lot, but it wasn't successful.
How must I change my code that it works? Thanks in advance!
My code:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("slider1", label = h3("Quantity of n"), min = 10, max = 100, value = 50),
sliderInput("slider2", label = h3("Mean of group 1"), min = 0, max = 100, value = 50),
numericInput("num", label = h3("SD of group 1"), value = 1)
),
mainPanel(
textOutput("Text1")
)
)
)
server <- function(input, output) {
group1=reactive({
rnorm(n=input$slider1,mean=input$slider2,sd=input$num)
})
# Shapiro-Wilk-Test
### shapiro.test(....)[[2]][1] shows the p-value
ND_G1=shapiro.test(group1())[[2]][1] # with "rnorm(10,5,2)" instead of group1() it works
output$Text1 <- renderText({paste("The p-value is: ",ND_G1)})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
I am trying to change the values from a sliderInput dynamically. The difficulty now is that I want to change from a sliderInput with one value, to a sliderInput with a range, which seems not to work.
The first actionbutton in the code below works, while the second does not what it is intended to do.
Is the only possibility to switch to an uiOutput element?
Code
library(shiny)
app <- shinyApp(
ui = bootstrapPage(
sliderInput("sld1", min = 0, max = 10, label = "y1", value = 5),
actionButton("acb1", "Change Value"),
actionButton("acb2", "Change Value to Range")
),
server = function(input, output, session) {
observeEvent(input$acb1, {
updateSliderInput(session, "sld1", value = 2)
})
observeEvent(input$acb2, {
updateSliderInput(session, "sld1", value = c(2,7))
})
})
runApp(app)
You can maybe add the slider dynamically using renderUI
#rm(list = ls())
library(shiny)
app <- shinyApp(
ui = bootstrapPage(
uiOutput("myList"),
actionButton("acb1", "Change Value"),
actionButton("acb2", "Change Value to Range")
),
server = function(input, output, session) {
slidertype <- reactiveValues()
slidertype$type <- "default"
observeEvent(input$acb1,{slidertype$type <- "normal"})
observeEvent(input$acb2, {slidertype$type <- "range"})
output$myList <- renderUI({
if(slidertype$type == "normal"){
sliderInput("sld1", min = 0, max = 10, label = "y1", value = 2)
}
else if(slidertype$type == "range"){
sliderInput("sld1", min = 0, max = 10, label = "y1", value = c(2,7))
}
else{
sliderInput("sld1", min = 0, max = 10, label = "y1", value = 5)
}
})
})
runApp(app)
so I'm trying to make a tax calculation app. In the sidebar I'm using tabsetPanel to display two panels with different inputs relating to the individual and then tax rates.
The mainPanel will also be using tabsetPanel where I plan to plot graphs etc. I have an update button that doesn't seem to be working.
ui.R
Looks like this:
shinyUI(fluidPage(
titlePanel("flatTax"),
sidebarLayout(
sidebarPanel(
h1("Flat Tax Calculator"),
helpText("Input your information below and see how a flat tax could
affect your tax bill."),
#Individual Specific Variables
tabsetPanel(
tabPanel("You",
numericInput(inputId = "incomeNum",
label = "Your annual income:",
value = 0
),
textInput(inputId = "testText",
label = "Test Input"
),
),
tabPanel("Tax Settings",
sliderInput(inputId = "basicIncome",
label = "Choose a monthly basic income",
value = 600, min = 0, max = 1200, step = 50
),
sliderInput(inputId = "taxFree",
label = "Choose a tax free allowance",
value = 10000, min = 0, max = 20000, step = 250
),
sliderInput(inputId = "flatIncomeTax",
label = "Choose a flat tax rate",
value = 50, min = 0, max = 100, step = 1
),
sliderInput(inputId = "flatPropertyTax",
label = "Choose a land value tax rate",
value = 1, min = 0, max = 100, step = 1
)),
# Action Button
actionButton(inputId = "updateButton",
label = "Update"),
plotOutput("text")
)
),
mainPanel(
tabsetPanel(
tabPanel("Summary",
h3("Test Output", textOutput("test"),
h3("Your new income tax bill is:", textOutput("incomeFT")),
h3("Your new property tax bill is:", textOutput("propertyFT")),
textOutput("annualBasicIncome")
)
),
tabPanel("Graphs",
h3("Placeholder"),
h3("Holding the place"),
h3("Plaice holster")
)
)
)
)
))
server.R
Looks like this:
shinyServer(
function(input, output) {
#action button stuff
incomeFT <- eventReactive(input$updateButton, {
((input$incomeNum-input$taxFree)/100*input$flatIncomeTax)
})
output$incomeFT <- renderPrint({
incomeFT()
})
propertyFT <- eventReactive(input$updateButton, {
input$propertyNum/100*input$flatPropertyTax
})
output$propertyFT <- renderPrint({
propertyFT()
})
annualBasicIncome <- eventReactive(input$updateButton, {
switch(as.numeric(input$relStat),
return((input$basicIncome*12)+((input$basicIncome*12)*input$childNum)),
return((2*(input$basicIncome*12))+((input$basicIncome*12)*input$childNum))
)
})
output$annualBasicIncome <- renderPrint({
annualBasicIncome()
})
test <- eventReactive(input$updateButton, {
input$testText
})
output$test <- renderText({
test()
})
})
Without reactivity it seems to work, but the button makes it less distracting to use. I've tried using verbatimTextOutput instead of textOutput but grey bars are sent across the main panel with not outputs in.
Help please?
For some reason, the actionButton does not work inside the tabsetPanel. If you put it outside it (and inside sidebarPanel) it will work. I suggest you try to use one actionButton for each tabPanel. I haven't try it, but I believe it should work. Please, if you try it, let me know the results.
Cheers.