I'm building a shiny app for the Random Forest. The widgets have to define two parameters:
the number of trees, between 1 and 1000
sliderInput("nTree", "Number of trees", min = 1, max = 100, value = 10)
a tree to visualise, between 1 and the number of trees (input$nTree) that depends on the first widget
sliderInput("iTree", "Tree to visualise", min = 1, max = nTree, value = 10)
How can I define nTree inside the second widget? Its value depends on the first widget.
Thanks in advance.
You can make the slider dynamically like so:
library(shiny)
ui =(pageWithSidebar(
headerPanel("Test Shiny App"),
sidebarPanel(
sliderInput("nTree", "Number of trees", min = 1, max = 1000, value = 10),
#display dynamic UI
uiOutput("iTree")),
mainPanel()
))
server = function(input, output, session){
#make dynamic slider
output$iTree <- renderUI({
sliderInput("iTree", "Tree to visualise", min=1, max=input$nTree, value=10)
})
}
runApp(list(ui = ui, server = server))
Related
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 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.
I have been working on a side project that involves a simple shiny app that allows users to input the parameters of a dice roll for a board game then have the code preform 10,000 rolls with those parameters and present the average of the rolls. I have a basic code that successfully makes this happen but I am struggling how to make it into a shiny app to make accessible to others.
The issue I face is that in the server part of the shiny code I do not know how to store the intermediate results within a single reactive() function. Is there a local storage option that works with a repeating function?
The code I am using is:
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("10,000 Roll Simulator"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
numericInput(inputId = "num_tac", label = "TAC",
value =1 , min = 1, max = 20),
numericInput(inputId = "num_def", label = "DEF",
value =1 , min = 1, max = 10),
numericInput(inputId = "num_arm", label = "ARM",
value =0 , min = 0, max = 10)
)
)
)
server <- function(input, output){
data()<- reactive({
One_roll<- function(){dice <- sample(1:6, size = input$num_tac, replace = TRUE)
return(sum((dice >= input$num_def)-input$num_arm))
sims<-replicate(10000, One_roll()}
output$stats <- renderPrint({mean(data())})
}
# Run the application
shinyApp(ui = ui, server = server)
Any help would be greatly appreciated, thank you!
A few issues with your code :
data()<- is not allowed. Use data<- instead then call it with data()
Using input$ inside a function is definitely not the right way to pass parameters
This is a modified server function where the One_roll function is defined outside the reactive, but called inside, with input passed as parameters:
server <- function(input, output){
One_roll<- function(num_tac,num_def,num_arm){
dice <- sample(1:6, size = num_tac, replace = TRUE)
sum((dice >= num_def)-num_arm)
}
data<- reactive(replicate(10000, One_roll(input$num_tac,input$num_def, input$num_arm )))
output$stats <- renderPrint(mean(data()))
}
And also you need a textOutput in the ui function to call the renderText for example:
ui <- fluidPage(
# Application title
titlePanel("10,000 Roll Simulator"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
numericInput(inputId = "num_tac", label = "TAC",
value =1 , min = 1, max = 20),
numericInput(inputId = "num_def", label = "DEF",
value =1 , min = 1, max = 10),
numericInput(inputId = "num_arm", label = "ARM",
value =0 , min = 0, max = 10)
), mainPanel = textOutput("stats")
)
)
You could also save all the user entered data into a static variable first and then use them as normal variables.
server <- function(input, output) {
temp <- reactive({
tac <- input$num_tac
def <- input$num_def
arm <- input$num_arm
One_roll <- function(tac, def, arm) {
dice <- sample(1:6, size = tac, replace = TRUE)
sum((dice >= def) - arm)
}
data <- replicate(10000, One_roll(tac, def, arm))
#remember to print the data again so the results will be saved to temp
data
})
output$stats <- renderPrint({
mean(temp())
})
}
I try to make two mutually dependent input sliders in a shiny app but don't seem to get it to work. I plan to use this kind of situation in a shiny app and for ease illustrate it here with a simplified 'glass half empty / full' example in which one slider should show glass fullness and one emptyness:
library(shiny)
ui =(pageWithSidebar(
headerPanel("Glass fullness"),
sidebarPanel(
sliderInput("Full", "% water", min = 0, max = 1, value = 0.2),
#display dynamic UI
uiOutput("Empty")),
mainPanel()
))
server = function(input, output, session){
# make dynamic slider
output$Empty <- renderUI({
sliderInput("Empty", "% air", min=0, max=1, value=1-input$Full)
})
}
runApp(list(ui = ui, server = server))
I understand the value = 0.2 and value=1-input$Full cause above code only to make the second slider dependent on the first but not the other way around. My problem is that I want to make both dependent on each other. I tried adding an uiOutput("Full") & dynamic slider for Full but did not manage to work around circular coding.
The result of above code looks as follows:
Glass half empty/full screenshot
Any help greatly appreciated!
Hi define your sliders in the UI and updated them in the server when it's needed :
library(shiny)
ui =pageWithSidebar(
headerPanel("Glass fullness"),
sidebarPanel(
sliderInput(inputId = "Full", label = "% water", min = 0, max = 1, value = 0.2),
sliderInput(inputId = "Empty", label = "% air", min = 0, max = 1, value = 1 - 0.2),
uiOutput("Empty")),
mainPanel()
)
server = function(input, output, session){
# when water change, update air
observeEvent(input$Full, {
updateSliderInput(session = session, inputId = "Empty", value = 1 - input$Full)
})
# when air change, update water
observeEvent(input$Empty, {
updateSliderInput(session = session, inputId = "Full", value = 1 - input$Empty)
})
}
shinyApp(ui = ui, server = server)
It is because in the second slider you have:
sliderInput("Empty", "% air", min=0, max=1, value=1-input$Full)
where value is 1-input$Full therefore it does depend on the first one, but in the first slider value is 0.2:
sliderInput("Full", "% water", min = 0, max = 1, value = 0.2),
and due to this 0.2, there is no relation with the second one.
Although, as you mention, you will end up with circular dependency.