I am trying to take input from a dropdown, and displaying a string depending on the selection
in ui.R:
selectInput(inputId = "engine",
label = h3("Select Search Engine"),
choices = c("Bing", "Google"),
selected = "Bing"))
in server.R:
if ( input$engine == "Bing"){
output$value <- renderText({ input$engine })
}
This works fine when the if statement is set to something trivial like 1 == 1 and outputs the text string, but not when I try to check the actual input (the if statement doesn't trigger). Seems like it should be something easy but I've been stuck on this for a while now....what am I doing wrong?
I don't know why you would want that if statement here but this works:
library(shiny)
server <- function(input, output) {
output$value <- renderText({
if ( input$engine == "Bing") {
ret <- paste0("https://", input$text, "/?pid=", input$engine,"+{adgroupname}+{keyword}+{matchtype}+{adposition}")
} else {
ret <- paste0("https://", input$text, "/?pid=", input$engine,"+{adgroupname}+{keyword}+{matchtype}+{adposition}")
}
ret
})
}
ui <- shinyUI(fluidPage(
fluidRow(
column(3,
selectInput(inputId = "engine",
label = h3("Select Search Engine"),
choices = c("Bing", "Google"),
selected = "Bing")),
column(3,
textInput("text", label = h3("URL"), value = "www.test.com"))),
hr(),
h3("Final Url:"),
fluidRow(column(9, h4(textOutput("value"), style = "color:blue")))
))
shinyApp(ui = ui, server = server)
Related
I have the following app which allows for text to be entered and it is then saved as VALUE and printed on a panel.
Although it looks like I can only do this with one text input at a time - even if I click add (so I don't believe this button is working). On top of that I would like for the user to be able to add multiple inputs (like I have below).
And then my VALUE function should be list with multiple inputs.
code below
library(shiny)
ui <- fluidPage(
headerPanel("R Package App"),
sidebarPanel(
# selectInput("options", "options", choices=c('abc','def')),
textInput("textbox", "Enter R Package Name", ""),
actionButton("add","Add")
),
mainPanel(
textOutput("caption")
)
)
server <- function(input, output, session) {
observe({
VALUE <- ''
if(input$add>0) {
isolate({
VALUE <- input$textbox
})
}
updateTextInput(session, inputId = "textbox", value = VALUE)
})
output$caption <- renderText({
input$textbox
})
}
shinyApp(ui = ui, server = server)
Have you considered using selectizeInput with it's create option?
library(shiny)
packagesDF <- as.data.frame(installed.packages())
ui <- fluidPage(
headerPanel("R Package App"),
sidebarPanel(
selectizeInput(
inputId = "selectedPackages",
label = "Enter R Package Name",
choices = packagesDF$Package,
selected = NULL,
multiple = TRUE,
width = "100%",
options = list(
'plugins' = list('remove_button'),
'create' = TRUE,
'persist' = TRUE
)
)
),
mainPanel(textOutput("caption"))
)
server <- function(input, output, session) {
output$caption <- renderText({
paste0(input$selectedPackages, collapse = ", ")
})
}
shinyApp(ui = ui, server = server)
I am having some trouble getting the functionality in my app that I'm looking for because of the way observeEvent works (which is normally very intuitive).
The basic functionality I'm looking for is that a user can input a couple numbers, click "submit", and then a modal pops up to take the user's name. After that, the app records the name and sums the numbers, and then clears the inputs. Then I'd like the user to be able repeat the process using the same name - but the app currently is structured so that the sums use an observeEvent that responds only when the name is different (i.e., using the same name twice in a row doesn't work, though I'd like it to). You can see in the app that my attempt at a solution is to reset the input for the inputSweetAlert (using shinyjs), but it can't access it, I assume because it's not actually on the UI side. I am using shinyWidgets sweetAlerts, which I'd like to continue doing.
Here's an example app:
library("shiny")
library("shinyWidgets")
library("shinyjs")
ui <- fluidPage(
shinyjs::useShinyjs(),
numericInput("num1", "Enter a number", value=NULL),
numericInput("num2", "Enter another number", value=NULL),
actionButton(inputId = "go", label = "submit"),
verbatimTextOutput(outputId = "res1"),
verbatimTextOutput(outputId = "res2")
)
server <- function(input, output, session) {
observeEvent(input$go, {
inputSweetAlert(session = session, inputId = "name", title = "What's your name?")
})
x <- reactiveValues(val=NULL)
observeEvent(input$name, {
x$val <- input$num1 + input$num2
confirmSweetAlert(session = session, inputId = "confirmed", title = "Success!", text = "Your responses have been recorded. All is in order.", type = "success", btn_labels = c("Ok, let me continue")
)
})
## A possible approach to a solution...
observeEvent(input$confirmed, {
shinyjs::reset("num1")
shinyjs::reset("num2")
shinyjs::reset("name")
})
output$res1 <- renderPrint(paste("Name:", input$name))
output$res2 <- renderPrint(paste("Sum:", x$val))
}
shinyApp(ui = ui, server = server)
Thanks for any help you can provide!
You could reset input$name via JS:
runjs('Shiny.setInputValue("name", null, {priority: "event"});')
Here is a working example:
library("shiny")
library("shinyWidgets")
library("shinyjs")
ui <- fluidPage(
shinyjs::useShinyjs(),
numericInput("num1", "Enter a number", value = NULL),
numericInput("num2", "Enter another number", value = NULL),
actionButton(inputId = "go", label = "submit"),
verbatimTextOutput(outputId = "res1"),
verbatimTextOutput(outputId = "res2")
)
server <- function(input, output, session) {
observeEvent(input$go, {
inputSweetAlert(session = session, inputId = "name", title = "What's your name?")
runjs('Shiny.setInputValue("name", null, {priority: "event"});')
})
x <- reactiveValues(val = NULL)
observeEvent(input$name, {
x$val <- input$num1 + input$num2
confirmSweetAlert(session = session, inputId = "confirmed", title = "Success!", text = "Your responses have been recorded. All is in order.", type = "success", btn_labels = c("Ok, let me continue"))
})
observeEvent(input$confirmed, {
shinyjs::reset("num1")
shinyjs::reset("num2")
shinyjs::reset("mytext")
})
output$res1 <- renderPrint(paste("Name:", input$name))
output$res2 <- renderPrint(paste("Sum:", x$val))
}
shinyApp(ui = ui, server = server)
For further information please see this article.
EDIT: In apps using modules, the call to runjs() can be adapted like this in order to namespace the id:
runjs(paste0("Shiny.setInputValue(\"", ns("name"), "\", null, {priority: \"event\"});"))
Here is a workaround. The idea consists in changing the input id at each click on the button.
library("shiny")
library("shinyWidgets")
library("shinyjs")
ui <- fluidPage(
shinyjs::useShinyjs(),
numericInput("num1", "Enter a number", value=NULL),
numericInput("num2", "Enter another number", value=NULL),
actionButton(inputId = "go", label = "submit"),
verbatimTextOutput(outputId = "res1"),
verbatimTextOutput(outputId = "res2")
)
server <- function(input, output, session) {
go <- reactive({
input$go
})
observeEvent(input$go, {
inputSweetAlert(session = session, inputId = sprintf("name-%d", go()),
title = "What's your name?")
})
x <- reactiveValues(val=NULL)
observeEvent(input[[sprintf("name-%d", go())]], {
x$val <- input$num1 + input$num2
confirmSweetAlert(session = session, inputId = "confirmed", title = "Success!", text = "Your responses have been recorded. All is in order.", type = "success", btn_labels = c("Ok, let me continue")
)
})
## A possible approach to a solution...
observeEvent(input$confirmed, {
shinyjs::reset("num1")
shinyjs::reset("num2")
shinyjs::reset("mytext")
})
output$res1 <- renderPrint(paste("Name:", input[[sprintf("name-%d", go())]]))
output$res2 <- renderPrint(paste("Sum:", x$val))
}
shinyApp(ui = ui, server = server)
I'm trying to create a shiny app that allows users to select multiple things from a checkbox. Based on the inputs, it should return all the relevant text output fields.
To do this, I'm indexing the checkbox and using multiple criteria in the if statements, but something doesn't work when the input1 is selected: if I select both input2 and input1, then it just shows the result for input2; if I just select input1, then the shiny app crashes.
I tried to add more conditions just to check...but no luck.
Code below:
library(shiny)
library(shinydashboard)
ui <- shinyUI(
navbarPage("DBC Comparison",
tabPanel("Stats" ,
sidebarLayout(
sidebarPanel(
checkboxGroupInput("comp_type", "Comparison type", choices = c("input1", "input2", "input3")),
actionButton(
inputId = "submit_loc",
label = "Submit")
, width = 3),
mainPanel(
fluidRow(
column(6, textOutput("selected_var1")),
#DT::dataTableOutput("table")#,
# div(style = 'overflow-x: scroll', tableOutput('table'))
column(6,textOutput("selected_var2"))
), position="left"))
)
))
##
##
server <- shinyServer(function(input, output) {
observeEvent(
eventExpr = input$submit_loc,
handlerExpr =
{
if(input$comp_type[1] == 'input2' || input$comp_type[2] == 'input2' || (input$comp_type[1] == 'input1' & input$comp_type[2] == 'input2'))
{
output$selected_var2 <- renderText({
"2"
})}
else if(input$comp_type[1] == 'input1' ||input$comp_type[2] == 'input1'||input$comp_type[3] == 'input1'|| (input$comp_type[1] == 'input1' & input$comp_type[2] == 'input2')
|| (input$comp_type[2] == 'input1' & input$comp_type[1] == 'input2')
{
output$selected_var1 <- renderText({
"1"
})
}
})
})
##
shinyApp(ui = ui, server = server)
Any ideas?
input$comp_type[2] == 'something' produces NA if you don't have at least 2 items selected. So your if statement return an error.
Also, I try not using render on observe.
I modify your example to use a eventReactive which is easier.
As I didn't get anything about your if conditions, I just wrote some random ones to let you see how I would deal with that.
library(shiny)
library(shinydashboard)
ui <- shinyUI(
navbarPage("DBC Comparison",
tabPanel("Stats" ,
sidebarLayout(
sidebarPanel(
checkboxGroupInput("comp_type", "Comparison type", choices = c("input1", "input2", "input3")),
actionButton(
inputId = "submit_loc",
label = "Submit")
, width = 3),
mainPanel(
fluidRow(
column(6, textOutput("selected_var"))
#DT::dataTableOutput("table")#,
# div(style = 'overflow-x: scroll', tableOutput('table'))
), position="left"))
)
))
##
##
server <- shinyServer(function(input, output) {
toDisplay <- eventReactive(input$submit_loc, {
if (all(c("input1", "input2", "input3") %in% input$comp_type)) {
return("all input selected")
} else if (all(c("input2", "input3") %in% input$comp_type)) {
return("input2 and input3 selected")
} else if ("input1" %in% input$comp_type) {
return("At least input1 is selected")
} else {
return("you are not in a random case I wrote")
}
})
output$selected_var <- renderText({
toDisplay()
})
})
##
shinyApp(ui = ui, server = server)
I want to retrieve the list of inputs in the current shiny session.
We can retrieve the list of inputs using names(input).
I have a uiOutput and based on different conditions I am rendering different types inputs. The current problem I am facing is that when the condition changes the inputs from previous renderUI is also present in the list. Is there a way to get only the inputs in the current session?
To explain my query better I have the following sample code:
library(shiny)
ui <- fluidPage(
sliderInput(inputId = "slider",label = "", min = 1, max = 3, value = 1),
uiOutput("UI"),
actionButton(inputId = "btn", label = "Show Inputs"),
verbatimTextOutput(outputId = "textOp")
)
server <- function(input, output){
observeEvent(input$slider,{
if(input$slider == 1){
output$UI <- renderUI(
textInput("txt1",label = "Slider in position 1")
)
}else if(input$slider == 2){
output$UI <- renderUI(
textInput("txt2",label = "Slider in position 2")
)
}else{
output$UI <- renderUI(
textInput("txt3",label = "Slider in position 3")
)
}
})
observeEvent(input$btn,{
output$textOp <- renderText(
paste0(names(input), ",")
)
})
}
shinyApp(ui = ui, server = server)
In the above code when I first click on action button labelled "Show Input" I get the following text as the output:
btn, slider, txt1,
Now when I move the slider to 2 my output is as follows:
btn, slider, txt1, txt2,
Here txt1 was generated when the slider was at position 1, and this renderUI was overridden by output$UI <- renderUI(textInput("txt2",label = "Slider in position 2")). I want an input list where txt1 is not there. Is there a way to do that?
I came up with kind of a workaround, assuming you dont have any inputs that should take a value of NULL. You could set the values of the inputs, that you wish to remove, to NULL and filter for non - NULLs when you display the names.
library(shiny)
ui <- fluidPage(
tags$script("
Shiny.addCustomMessageHandler('resetValue', function(variableName) {
Shiny.onInputChange(variableName, null);
});
"
),
sliderInput(inputId = "slider",label = "", min = 1, max = 3, value = 1),
uiOutput("UI"),
actionButton(inputId = "btn", label = "Show Inputs"),
verbatimTextOutput(outputId = "textOp")
)
server <- function(input, output, session){
observeEvent(input$slider,{
for(nr in 1:3){
if(nr != input$slider) session$sendCustomMessage(type = "resetValue", message = paste0("txt", nr))
}
})
output$UI <- renderUI(
textInput(paste0("txt", input$slider), label = paste0("Slider in position ", input$slider))
)
global <- reactiveValues()
observe({
inp = c()
for(name in names(input)){
if(!is.null(input[[name]])){
inp <- c(inp, name)
}
}
isolate(global$inputs <- inp)
})
output$textOp <- renderText({
global$inputs
})
}
shinyApp(ui = ui, server = server)
I'm trying to use the shinyFiles library in my shinyApp, in order to give the user the possibility to select a group of files or a directory.
My idea is to use a uiOutput that changes depending on a checkbox selection.
Here I report the code, that maybe is more explicative than words
UtilityUI <- fluidPage(
titlePanel("page1"),
fluidRow(
column(2,
wellPanel(
tags$p("Check the box below if you want to choose an entire directory"),
checkboxInput(inputId = 'directory_flag', label = 'Directory path?', value = FALSE),
uiOutput("input_selection_ui")
)
),
column(8
#...
)
)
)
UtilityServer <- function(input, output, session) {
output$input_selection_ui <- renderUI({
if(input$directory_flag == TRUE) {
shinyDirButton(id = "infiles", label = "Choose directory", title = "Choose a directory")
} else {
shinyFilesButton(id = "infiles", label = "Choose file(s)", title = "Choose one or more files", multiple = TRUE)
}
})
shinyFileChoose(input, 'infiles', roots=getVolumes(), session=session, restrictions=system.file(package='base'))
shinyDirChoose(input, 'infiles', roots=getVolumes(), session=session, restrictions=system.file(package='base'))
}
shinyApp(UtilityUI, UtilityServer)
The problem borns when the "shinyFiles" button is pressed: the popup window doesn't load the roots, in both cases (shinyDirButton and shinyFilesButton).
If I don't use the uiOutput function everything works well... But in that case I cannot change my UI dinamically...
Thanks a lot for your replies,
Inzirio
It seems I can't get it to work either with renderUI(). Instead I implemented the same behavior using conditionalPanel() to show alternative buttons. This seems to work. Here is the code:
ui <- shinyUI(fluidPage(
checkboxInput(
inputId = 'directory_flag',
label = 'Directory path?',
value = FALSE
),
conditionalPanel(
"input.directory_flag == 0",
shinyFilesButton(
id = "infile",
label = "Choose file(s)",
title = "Choose one or more files",
multiple = TRUE
)
),
conditionalPanel(
"input.directory_flag == 1",
shinyDirButton(id = "indir", label = "Choose directory", title = "Choose a directory")
)
))
server <- shinyServer(function(input, output, session) {
shinyFileChoose(
input,
'infile',
roots = getVolumes(),
session = session,
restrictions = system.file(package = 'base')
)
shinyDirChoose(
input,
'indir',
roots = getVolumes(),
session = session,
restrictions = system.file(package = 'base')
)
})
shinyApp(ui, server)