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)
Related
Here's the minimal reproducible example:
# This is a Shiny web application.
library(shiny)
# UI for application
ui <- fluidPage(
# Application title
titlePanel("A Problematic App - Part 2"),
# Sidebar with two slider inputs
sidebarLayout(
sidebarPanel(
sliderInput(
"NoOfSamples",
label = "Sample Size",
value = 100,
min = 10,
max = 150,
step = 10,
width = "40%"
),
sliderInput(
"KeepSamples",
label = "Samples to Keep",
value = 50,
min = 10,
max = 150,
step = 10,
width = "40%"
)
),
# Shows the resulting table
mainPanel(
tableOutput("table1"),
tableOutput("table2")
)
)
)
# Server logic
server <- function(input, output) {
# Using the iris dataset
datExpr <- as.data.frame(iris)
n = reactive({
input$NoOfSamples
})
datExpr0 <- reactive({
datExpr[1:n(), ]
})
output$table1 <- renderTable({
datExpr0()
})
# Displays the first table correctly if the rest is commented out
keepSamples = reactive({
input$KeepSamples
})
datExpr <- reactive({
datExpr0()[keepSamples(),]
})
output$table2 <- renderTable({
datExpr()
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have created live examples for demonstration.
With the second part of the program commented out.
The complete program. [Shinyapps.io] is supressing the error details, so attached is a screenshot of a local run.
The error is object of type 'closure' is not subsettable. While many questions (and answers) regarding this error exist, I am yet to find any explaining the behaviour demonstrated above.
Why does this happen?
The normal (script-equivalent) works as expected.
datExpr <- as.data.frame(iris)
n = 50
datExpr0 <- datExpr[1:n, ]
datExpr0
keepSamples = 10
datExpr <- datExpr0[keepSamples,]
datExpr
Is there a way to achieve what the normal script does in the shiny app?
The issue is that you have both a dataframe and a reactive in your app called datExpr. Simply rename one of both (I decided for the reactive).
EDIT There is of course nothing special about that in shiny.
A simple example to illustrate the issue:
datExpr <- iris
datExpr <- function() {}
datExpr[1:2]
#> Error in datExpr[1:2]: object of type 'closure' is not subsettable
And you see that we get the famous object of type 'closure' is not subsettable error too. The general issue or lesson is that in R you can't have two different objects with the same name at the same time.
# This is a Shiny web application.
library(shiny)
# UI for application
ui <- fluidPage(
# Application title
titlePanel("A Problematic App - Part 2"),
# Sidebar with two slider inputs
sidebarLayout(
sidebarPanel(
sliderInput(
"NoOfSamples",
label = "Sample Size",
value = 100,
min = 10,
max = 150,
step = 10,
width = "40%"
),
sliderInput(
"KeepSamples",
label = "Samples to Keep",
value = 50,
min = 10,
max = 150,
step = 10,
width = "40%"
)
),
# Shows the resulting table
mainPanel(
tableOutput("table1"),
tableOutput("table2")
)
)
)
# Server logic
server <- function(input, output) {
# Using the iris dataset
datExpr <- as.data.frame(iris)
n = reactive({
input$NoOfSamples
})
datExpr0 <- reactive({
datExpr[1:n(), ]
})
output$table1 <- renderTable({
datExpr0()
})
# Displays the first table correctly if the rest is commented out
keepSamples = reactive({
input$KeepSamples
})
datExpr1 <- reactive({
datExpr0()[keepSamples(),]
})
output$table2 <- renderTable({
datExpr1()
})
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:3648
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 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 am trying to create a Shiny app which
a) prompts user to upload a file which contains numeric data,
b) reads the file and assigns the data points to different variables,
c) calculates new variables from the captured variables
d) display a 'Gauge' using the calculated variables
The code successfully executes but the Gauge chart is not rendered properly. There is no error or warning message either. Instead, I am getting the following message:
"Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON."
And instead of the gauge output I am getting that tiny spec in the middle, as seen in the attached image.
The entire code is fairly long, hence providing just the relevant snippets of code.
Would really appreciate if you can help fix this.
library(shiny)
library(flexdashboard)
ui <- fluidPage(
tabPanel("Sensitivity Analysis",
sidebarLayout(
sidebarPanel(
uiOutput("Sensitivity_Analysis")
),
mainPanel(
gaugeOutput("sensitivity", width = "600px", height = "600px")
)
)
),
server <- function (input, output)
{
output$input_financials=renderUI({
fluidRow(fileInput("file1", "Choose CSV File",multiple = FALSE,accept = c("text/csv","text/comma-separated-values,text/plain",".csv")),
actionButton("process","Process"))})
data_input=reactiveValues()
observeEvent(input$process,{
file_input <- input$file1
if (is.null(file_input)) {
return(NULL)}
## File is read and all the inputs are assigned to variables
....
## Output for Gauge begins
output$sensitivity <- flexdashboard::renderGauge({
gauge_limit <- data_input$wc_value
data_input$cash_rel_dpo <- ## Formula for cash_del_dpo
data_input$cash_rel_dro <- ## Formula for cash_del_dro
data_input$cash_rel_dio <- ## Formula for cash_del_dio
data_input$wc_predicted_value <- (data_input$wc_predicted_value - data_input$cash_rel_dpo - data_input$cash_rel_dro - data_input$cash_rel_dio)
gauge(data_input$wc_predicted_value, min = 0, max = gauge_limit,
gaugeSectors(success = c(0, 10000),
warning = c(10001, 50000),
danger = c(50001, 1000000000))
)
})
shinyApp(ui = ui, server = server)
Screenshot of the output generated upon executing the code
There's a similar gauge in package billboarder, try this example:
library(shiny)
library(billboarder)
ui <- fluidPage(
tabPanel(
title = "Sensitivity Analysis",
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv","text/comma-separated-values,text/plain",".csv")),
actionButton(inputId = "process", label = "Process (click here to refresh the gauge)")
),
mainPanel(
billboarderOutput("sensitivity", width = "400px", height = "400px")
)
)
)
)
server <- function (input, output) {
data_input <- reactiveValues(x = 0)
observeEvent(input$process, {
data_input$x <- sample.int(1e5, size = 1)
}, ignoreInit = TRUE)
## Output for Gauge begins
output$sensitivity <- renderBillboarder({
billboarder() %>%
bb_gaugechart(
value = data_input$x,
name = "Predicted value",
steps = c(1e4, 5e4, 1e5),
steps_color = rev(c("#FF0000","#F6C600", "#60B044"))
) %>%
bb_gauge(
min = 0, max = 1e5,
units = "",
label = list(
format = htmlwidgets::JS("function(value, ratio) {return d3.format(',')(value);}") # format value with thousand separator
),
width = 80
)
})
}
shinyApp(ui = ui, server = server)
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))