I have similar issue to R Shiny selectInput, I would like to use the input to slice my data like this:
selectInput("category", "Choose a Category:",
choices = c('Any', levels(as.factor(unique(BD$DX_01_Cat))))),
uiOutput("secondSelection")
if (input$category != "Any"){
subsetSubsTab <<- subsetSubsTab[subsetSubsTab$DX_01_Cat==input$category];
output$secondSelection <- renderUI({
selectInput("subdiagnosis", "Choose a Subdiagnosis:", choices = c("Any", as.character(subsetSubsTab[subsetSubsTab$DX_01_Cat==input$category, DX_01_Sub])) , selected = "Any")
})
if (input$subdiagnosis != "Any"){
subsetSubsTab <<- subsetSubsTab[subsetSubsTab$DX_01_Sub==input$subdiagnosis];
}
but the last if statement does not work.
I get warning Warning: Error in if: argument is of length zero,
the subsetSubsTab actualize for a second and goes back. Could someone help please?
Related
I would like to build a Shiny App with two tabs:
In one tab, some values are entered as input. In the next tab, the user can find an output that is based on the values entered in the first tab.
However, before proceeding to the output I want to check if summing up three entries will give the fourth entry.
To do so, I want to use reactive expressions that contain the values of the different entries.
Here is an example of what I would like to do:
# clean environment
rm(list = ls(all = TRUE))
library(shiny)
# Create user interface (UI)
u <- tagList(
navbarPage(
# UI for input
title = "",
id = "Example_App",
tabPanel("Model input",
fluidRow(
column(11, offset = 0,
br(),
h4("Model input"),
br(),
sidebarPanel(
div(textInput('str_Input1', 'Input 1\n', "",
placeholder = "5.6, 6.7, 4.1"), class = "subheading"),
div(textInput('str_Input2', 'Input 2\n', "",
placeholder = "5.6, 6.7, 4.1"), class = "subheading"),
div(textInput('str_Input3', 'Input 3\n', "",
placeholder = "5.6, 6.7, 4.1"), class = "subheading"),
div(textInput('str_Input4', 'Input 4\n', "",
placeholder = "5.6, 6.7, 4.1"), class = "subheading"),
actionButton('jumpToModelOutput', 'Run')),
mainPanel(
h4('You entered'),
verbatimTextOutput("oid_Input1"),
verbatimTextOutput("oid_Input2"),
verbatimTextOutput("oid_Input3"),
verbatimTextOutput("oid_Input4"))))),
# UI for output
tabPanel("Model output",
fluidRow(
column(11, offset = 0,
br(),
h4('Your output will be here.'))
))))
# Define server output
s <- shinyServer(function(input, output, session) {
# Define reactive expressions
num_Input1 <- reactive(as.numeric(unlist(strsplit(input$str_Input1,","))))
num_Input2 <- reactive(as.numeric(unlist(strsplit(input$str_Input2,","))))
num_Input3 <- reactive(as.numeric(unlist(strsplit(input$str_Input3,","))))
num_Input4 <- reactive(as.numeric(unlist(strsplit(input$str_Input4,","))))
# Define server output for input check
output$oid_Input1 <- renderPrint({
cat("Input 1:\n")
print(num_Input1())
})
output$oid_Input2 <- renderPrint({
cat("Input 2:\n")
print(num_Input2())
})
output$oid_Input3 <- renderPrint({
cat("Input 3:\n")
print(num_Input3())
})
output$oid_Input4 <- renderPrint({
cat("Input 4:\n")
print(num_Input4())
})
# Check if conditions are fulfilled before switching to Model output
observeEvent(input$jumpToModelOutput, {
if(!all.equal((num_Input1() + num_Input2() + num_Input3()),num_Input4())){
showNotification("Error.", type = "error")
}else{
updateTabsetPanel(session, "Example_App",
selected = "Model output")
}})
})
# Create the Shiny app
shinyApp(u, s)
When I enter "1,2,3" into all tabs and press the button, the App stops and I get the following message:
"Listening on http://127.0.0.1:3925
Warning: Error in !: invalid argument type"
Removing the ! gives the following message:
Warning: Error in if: argument is not interpretable as logical
As far as I get the messages, the reactive expressions are not interpreted as numeric (?) but summing them up and printing them gives correct results.
Could anyone please help me finding the problem?
The issue is that all.equal returns a string containing a report of the difference in the passed values. That's why the docs (see ?all.equal) state:
Do not use all.equal directly in if expressions—either use isTRUE(all.equal(....)) or identical if appropriate.
Hence, to fix your issue wrap inside isTRUE:
observeEvent(input$jumpToModelOutput, {
if (!isTRUE(all.equal(num_Input1() + num_Input2() + num_Input3(), num_Input4()))) {
showNotification("Error.", type = "error")
} else {
updateTabsetPanel(session, "Example_App",
selected = "Model output"
)
}
})
all.equal returns a string if the elements are not equal, and you can't use a ! on a string. You can first check with isTRUE if it's TRUE or not and then negate it (note: you can't use isFALSE because in case it's not TRUE, all.equal returns a string). If you expect the elements to be exactly equal, you could use identical to make things easier.
I've also summed up all element in each input before adding them, is this what you wanted to do?
# Check if conditions are fulfilled before switching to Model output
observeEvent(input$jumpToModelOutput, {
if(!isTRUE(all.equal((sum(num_Input1()) + sum(num_Input2()) + sum(num_Input3())),sum(num_Input4())))){
showNotification("Error.", type = "error")
}else{
updateTabsetPanel(session, "Example_App",
selected = "Model output")
}})
Hello and thanks for the help. I am trying to make an app that updates the selections of one pickerinput depending on the selections of another. The idea is that if one pickerinput has something selected then the other removes all current selections (and vice versa), but I get an error when trying to update the pickerinputs
My code is the following:
library(shiny)
library(shinywidgets)
var1 <- c(1,2,3,4,1,2,3)
var2 <- c(1,2,3,3,1,2,2,1,2,1)
shinyApp(
ui = fluidPage(
pickerInput("primero",
"opciones a escoger",
choices = var1,
selected = var1,
multiple = TRUE
),
pickerInput("segundo",
"opciones a escoger 2",
choices = var2,
multiple = TRUE
)
),
server = function(input, output, session){
valor <- reactive({
c( input$primero)
})
observeEvent(input$primero,{
req(valor())
updatePickerInput(session,"segundo",
choices = var2,
selected =
if_else(length(valor())>0, NULL, head(var2,1))
)
})
}
)
Error message:
Warning: Error in : `false` must be NULL, not a double vector.
[No stack trace available]
Any ideas for suggestions? Thanks a lot
if_else requires that the class/type of both its second and third arguments must be the same. Further, since it is intended to be a vectorized logical if/else, having one of them be NULL does not make sense.
Looking more at the code, you are using it incorrectly: do not assume that it (or base::ifelse) is a drop-in replacement for if/else, they are very much different. Replace your observeEvent with:
observeEvent(input$primero,{
req(valor())
updatePickerInput(session,"segundo",
choices = var2,
selected =
if (!length(valor()) > 0) head(var2, 1)
)
})
I'm shortcutting it slightly here: when we have if and no else, when the conditional evaluates to FALSE then it returns NULL, which is what I think your if_else(length(valor()) > 0, NULL, ..) meant.
I am new to Shiny R.Can anyone help me solve the issue below.
I am trying to plot the data using a dataset, and with a user defined option "All" added to the "selectlist" of "region" provided in UI.
When "All" option is selected from "selectlist", how can I use the below observer to store information about all the regions into vector "l", so that the same can be used to query based on other user inputs
observe({
if("All" %in% input$region) {
selected <- setdiff(allchoice, "All")
updateSelectInput(session, "region", selected = selected)
}
})
Ref: How to add a user defined value to the select list of values from dataset
UI.R
library(shiny)
library("RMySQL")
library(ggplot2)
library(plotly)
library(DT)
library(dplyr)
dataset <- read.csv("dataset.csv", header=TRUE)
dataset$X <- NULL
allchoice <- c("All", levels(dataset$region))
fluidPage(
title = "ABC XYZ",
hr(),
fluidRow(
titlePanel("ABC XYZ"),
sidebarPanel(
dateRangeInput('dateRange',
label = 'Date Input',
start = as.Date("1967-01-01"), end = Sys.Date()),
selectInput("region", label = "Region",
choices = allchoice,
selected = 1),
selectInput("gender", label = "Gender",
choices = unique(dataset$gender), multiple = TRUE,
selected = unique(dataset$gender)),
selectInput('x', 'X', names(dataset), names(dataset)[[2]]),
selectInput('y', 'Y', names(dataset), names(dataset)[[8]]),
hr()
),
mainPanel(
column(12, plotlyOutput("plot1")),
hr(),
column(12, plotlyOutput("plot2"))
)
)
)
Server.r
library(ggplot2)
library("RMySQL")
library("mgcv")
library(plotly)
function(input, output, session) {
dataset <- read.csv("dataset.csv", header=TRUE)
dataset$X <- NULL
dataset$date <- as.Date(dataset$date)
if(input$region == "All"){
l <- observe({
if("All" %in% input$region) {
selected <- setdiff(allchoice, "All")
updateSelectInput(session, "region", selected = selected)
}
})
}
else{
l <- reactive(subset(dataset, region %in% input$region))
}
k <- reactive({subset(l(), date >= as.Date(input$dateRange[1]) & date <= as.Date(input$dateRange[2]))})
n <- reactive(subset(k(), gender %in% input$gender))
#output plots
output$plot1 <- renderPlotly({
p <- ggplot(n(), aes_string(x=input$x, y=input$y)) + geom_point(alpha=0.4)
ggplotly(p)
})
output$plot2 <- renderPlotly({
q <- ggplot(n(), aes_string(x=input$x, y=input$y)) + geom_smooth()
ggplotly(q)
})
}
Error I am facing -
Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Stack trace (innermost first):
46: .getReactiveEnvironment()$currentContext
45: .subset2(x, "impl")$get
44: $.reactivevalues
43: $ [D:\Demo\server.R#36]
42: server $ [D:\Demo\server.R#36]
1: runApp
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Note: My vocabulary above may be off, so please correct me if I'm wrong, I am totally new to the world of R.
Thanks in advance.
EDIT 1:
Listening on http://127.0.0.1:5128
We recommend that you use the dev version of ggplot2 with `ggplotly()`
Install it with: `devtools::install_github('hadley/ggplot2')`
Warning in origRenderFunc() :
Ignoring explicitly provided widget ID "2988253b22c1"; Shiny doesn't use them
We recommend that you use the dev version of ggplot2 with `ggplotly()`
Install it with: `devtools::install_github('hadley/ggplot2')`
`geom_smooth()` using method = 'gam'
Warning in origRenderFunc() : Ignoring explicitly provided widget ID "29885be33e8"; Shiny doesn't use them
and even when i do that, I am getting many exceptions and sometimes the same exceptions as above again. Just worried if the same will affect the application in the long run, can you suggest anything about that?
Thanks again.
You have not provided an example data so i can only guess and via looking at your error which says clearly whats the problem: no active reactive context, i assume that it is exactly in this part:
if(input$region == "All"){
l <- observe({
if("All" %in% input$region) {
selected <- setdiff(allchoice, "All")
updateSelectInput(session, "region", selected = selected)
}
})
}
else{
l <- reactive(subset(dataset, region %in% input$region))
}
[!] but actually i do not understand what for you need the observer...i think it should work totally fine if you just use if...else... statement.
[!] And additionally i have no idea why at first you say you wanna get the vector of choices (except "All") and you use it as selected choice in selectInput, may i ask what for?
and else statement should give you subset of the data based on input$region.
So shortly saying: if gives you updatedSelectInput and else gives you dataset --> It actually does not make sense at all..
and should be as simple as that, if "All" is selected then there is no need to subset the dataset, if any other choice then "All" is selected then the subset of the dataset should happen:
l <- reactive({
if(input$region == "All"){
dataset
}else{
dataset <- subset(dataset, region %in% input$region)
}})
I have a series of inputs in my R Shiny app that I am using as arguments to a function to select specific data from a data frame. On of the inputs is dateInput:
dateInput("dateSelect", "Date", format = "yyyy-mm-dd", value = NA)
In my function, I need to specify if dateSelect is blank or not selected, to be able select All dates. See an example that is working correctly, that isn't a date, and a simple selectInput:
selectInput("teamSelect", "Team", choices = c("All", levels(newEffortstable$team)))
In the function, this works to select 'All teams':
if(!missing(teamSelect)){
if(teamSelect!="All"){
selections[["teamEfforts"]] =
newEffortstable$effortNo[which(newEffortstable$team %in% teamSelect)]
}else{
selections[["teamEfforts"]] = newEffortstable$effortNo
}
}
I have tried the following with NA and NULL and " " and keep getting 'Error in if: argument is of length zero'
if(!missing(dateSelect)){
if(!dateSelect== "NA"){
selections[["dateEfforts"]] =
newEffortstable$effortNo[which(newEffortstable$date == dateSelect)]
}else{
selections[["dateEfforts"]] = newEffortstable$effortNo
}
}
Thanks!
There's one option you didn't try out yet: checking the length. When no date is given, dateInput returns an empty Date vector as illustrated in the example below.
So you could check if(length(input$dateSelect) == 0), but this is not the most solid shiny option. In order to avoid that you have to check all possibilities (i.e. NULL, NA, "", numeric(0) etc), you can use the function isTruthy() as in the example below:
shinyApp(
ui = fluidPage(
dateInput("dateSelect","Date"),
verbatimTextOutput("out"),
textOutput("text")
),
server = function(input,output,session){
output$text <- renderText({
if(!isTruthy(input$dateSelect)){
"NO DATE"
} else {
paste("The chosen date is:",input$dateSelect)
}
})
output$out<- renderPrint({str(input$dateSelect)})
}
)
I try to populate a list on shiny with the elements of the list passed over from a shiny input. The list should accumulate all the made choices. The list should finally be sent to the shiny output. Actually I already get a list which I can send to output. This list is however always just of length one and this single element gets updated as the input does. Actually I am only interested in the "names" of the list, this is why I assign the value 1 to each name element:
UI.R
shinyUI(
fluidRow(
column(1,
# reactive input
selectInput("Input1",
label = "Select Parameter 1",
choices = c("none",letters[1:16]),
multiple = T),
selectInput("Input2",
label = "Select Parameter 2",
choices = c("none",c(1:24) )
multiple = T),
# printout of list
htmlOutput("printoutList")
) # end of column
) # end of fluid row
) # end of Shiny UI
Shiny.R
# create an empty list
container <- list()
shinyServer(function(input, output) {
# pass over input to reactive
inputInfo <- reactive({
if(input$Input1 == "none" | input$Input2 == "none") {
"-"
} else {
paste(input$Input1 ,input$Input2, sep = "")
}
})
# fill list and pass over list to output
output$printoutList <- renderUI({
container[[inputInfo()]] <- 1
paste("You have chosen: ", names(container), sep = "")
})
)} #end of shinyServer function
Any idea how to solve this? I already tried around a lot... unfortunately I am quite new to R, especially to shiny ! I would really appreciate any kind of help! Thanks !
include the multiple = TRUE argument for selectInput
selectInput("Input1",
label = "Select Parameter 1",
choices = c("none",letters[1:16]),
multiple = TRUE
)
But also it seems like your server and ui files are mixed up and you don't have the shinyServer function in the code.