R shiny: how to make an operation based on textInput - r

I would like to check if a textInput has been completed, and then run an operation based on this. For some reason, the following simplified code does not work. Is there something wrong ?
library(shiny)
ui <- pageWithSidebar(
headerPanel("TEST"),
sidebarPanel(
textInput('C1', "","C1")
),
mainPanel(uiOutput("value"))
)
server <- function(input,output){
output$value <- renderUI({
#input$C1
if (is.null(input$C1)){
value <- 0}
else{
value <- 1
}
})
}
runApp(list(ui=ui,server=server))
Any suggestion highly appreciated.
Cheers

The code inside renderUI must return a "tags" object, that is, a valid html. your code returns 0 or 1, neither of which is a valid return value in that context.
all you need is to enclose the return value in something that creates such code, for example, instead of
value<-0
try
h4("0")
and everything will be fine.

Related

In R Shiny how do I check the value of a reactive and print a message

I am trying to figure out how to debug in Shiny. I would like to print a message to the console if a reactive takes a specific value. I know I can put a message inside of the reactive but I am curious to know if/how I do it from outside of the of reactive call it self. I tried to use an observeEvent() and it seems to trigger every time the reactive changes. What is the right way to print a message based on the value in a reactive?
library(shiny)
ui <- fluidPage(
textInput("name_first", "What's your first name?"),
textInput("name_last", "What's your last name?"),
textOutput("greeting")
)
server <- function(input, output, server) {
dude <- reactive(paste(input$name_first, input$name_last))
# why does this not work?
observeEvent(dude() == "a zombie", {message("run")})
output$greeting <- renderText(dude())
}
shinyApp(ui, server)
You can use req() to trigger an event only if a reactive has a certain value.
observeEvent(dude(),{
req(dude() == "a zombie")
message("run")
})
For debugging shiny apps in general, you can have a look at the browser() function
A possibility:
isZombie <- reactive({
if(dude() == "a zombie") TRUE # no need of 'else NULL'
})
observeEvent(isZombie(), {message("run")})

Render icon in R shiny based on condition

I am trying to render icons in my shiny dashboard based on a particular condition. Below is the code I am using to get the if else working . Since my code base is too big to share I am just posting the code for that particular portion:
output$cost_compare <-renderUI( ifelse(
last_week$cost < kpi_table$cost,
as.character(icon("angle-up")),
as.character(icon("angle-down"))
))
compareCostUI <- function(id) {
ns <- NS(id)
( uiOutput(ns("cost_compare")))
}
And I am using this in the ui inside a descriptionblock. Below is the code for it
descriptionBlock(
number = compareCostUI("pacing"))
What I am missing here due to which I can see the icon rendered
Ignore my last comment:
Using renderText is what you want to use if you are passing html strings to the UI. Returning character values in renderUI returns literal strings. Seems unintuitive.
I'm not sure if your compareCostUI function is causing any issues and I also didn't know the namespace of descriptionBlock but I made a small reproducible example of rendering an icon.
I'm also assuming that your two values last_week and kpi_table are reactive in some way? otherwise the output$cost_compare would actually never update.
ui <- shinyUI(
fluidPage(
actionButton("Press","press", icon = icon("refresh")),
uiOutput("cost_compare")
)
)
server <- function(input, output, session) {
output$cost_compare <- renderText({
if(input$Press%%2==0){
condition <- T
} else{
condition <-F
}
ifelse(condition,
as.character(icon("angle-up")), as.character(icon("angle-down")))
}
)
}
shinyApp(ui, server)

Adding reactive values to a dataframe - Rshiny

At the moment I am attempting the following: import a file in Rshiny, give it a number (interactive), and then move on to the next file. This part works fine. However, I would also like to store the data of every iteration, and then show it on the user interface.
However, it is not working. So I guess something is not right with the reactivity, but I am not sure how to fix it.
ui<-fluidPage(
mainPanel(
radioButtons(inputId="score",label="Give a score",choices=c(1:9),selected=1),
actionButton(inputId="new","Next file"),
tableOutput("savdat")
)
)
server<-function(input,output){
NoFiles<-length(list.files())
Here an empty reactive data.frame
outputdata<-reactive(data.frame("file"="file","score"="score"))
filename<-eventReactive(input$new,{
WhichFile<-sample(1:NoFiles,1)
filename<-list.files()[WhichFile]
return(filename)
})
scores<-eventReactive(input$new,{
return(input$score)
})
Then I would like to append the previous values of the outputdata, with the new values. But it is not working
outputdata<-eventReactive(input$new,{
rbind(outputdata(),filename(),scores())
})
output$savdat<-renderTable(outputdata())
}
shinyApp(ui, server)
Any advice would be welcome
It appears you want the reactivity to occur each time you click on the 'Next file' button. I rewrote your code to respond just once, using 'ObserveEvent', each time the 'Next file' button is clicked. The 2nd challenge is permitting values to persist upon each reactive event. While there are multiple ways to handle this, I chose an expedient technique, the '<<-' assignment statement, to permit the variable 'output data' to persist (this is generally not a good programming technique). Because the variable 'outputdata' exists in all environments, you'll need to wipe your environment each time you want to run this program.
Here's my rewrite using the same ui you created:
ui<-fluidPage(
mainPanel(
radioButtons(inputId="score",label="Give a score",choices=c(1:9),selected=1),
actionButton(inputId="new","Next file"),
tableOutput("savdat")
)
)
server<-function(input,output){
NoFiles<-length(list.files())
setupData <- function(filename,score) {
data <- data.frame(filename,score,stringsAsFactors = FALSE)
return(data)
}
observeEvent (input$new, {
WhichFile<-sample(1:NoFiles,1)
filename<-list.files()[WhichFile]
if (!exists(c('outputdata'))) {
score <- input$score
outputdata <<- data.frame (filename,score,stringsAsFactors = FALSE)
}
else {
outputdata <<- rbind(outputdata,setupData(filename,input$score))
}
# Show the table
output$savdat<-renderTable(outputdata)
})
}
shinyApp(ui, server)

Test whether any input in a set of numbered input objects in R Shiny is empty

Let's say I have created 10 selectInput dropdowns for a multi plot export and these selectInputs are called "xaxis_1", "xaxis_2", ..... , "xaxis_10"
for a single 1 I can write:
if(!is.null(input$xaxis_1)) { .... do stuff } to stop it running export when the user hasn't entered any name, and presses submit, to avoid crashes.
A bit more general you can check this:
if(!is.null(input[[paste('xaxis', i, sep = '_')]])) { ...}
how can you write it elegantly so that 1 line of code checks whether ANY of the 1:10 input[[...]] is empty, i.e. NULL?
The nr of inputs depends on how many plots the user wants to export per file, so all is build with lapply(1:input$nrofplots, function(i) { .... } renderUI structure, and my if statement needs to have the same flexibility of 1:n
In a situation like below in the image, pressing Initiate export should give a sweetalert (got that covered) saying there is at least 1 value missing
Here a snippet I used in the UI side to validate the user's inputs.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(), # Set up shinyjs
numericInput('axis1','Val 1',1),
numericInput('axis2','Val 2',1),
numericInput('axis3','Val 3',1),
actionButton('Go','Plot')
)
server <- function(input, output, session) {
#Try 1, space, AAA and check what shiny will return
observe(print(input$axis1))
observe({
All_Inputs <- vapply(paste0('axis',1:3),
function(x){isTruthy(input[[x]])},
logical(1))
All_InputsCP <- all(All_Inputs)
shinyjs::toggleState(id="Go", condition = All_InputsCP) #This is to make the button Go able or disable according to condition All_InputsCP #
})
}
shinyApp(ui, server)
I hope it helps.

Detect Specific UI Change in R Shiny [duplicate]

Let's say we have a set of widgets each with their own input label. How do we create a reactive object whose value is the character that represents the input ID of the last widget that was modified?
For example, if we have
ui.R
shinyUI(fluidPage(
textInput('txt_a', 'Input Text A'),
textInput('txt_b', 'Input Text B")
))
server.R
shinyServer(function(input, output) {
last_updated_widget <- reactive({
#hypothetical code that indicates ID value of last updated widget
})
})
The desired result is as follows. If the user modifies the first text box, then the value of last_updated_widget() would be "txt_a". If they modify the second box, the value of last_updated_widget() becomes "txt_b". I'm in search of a result that extends to the obvious generalization of setting the value to be the ID of any of the widgets that was adjusted last.
I'd like this to work for an arbitrary number of widget inputs, including the case that they were generated by a renderUI() statement. So making a separate reactive() statement for each widget isn't an option. However, if the reactive statement requires a loop over all the widget names (or something like that) I can certainly work with that. And multiple reactive statements is okay, as long as it's a fixed amount, and not a function of the number of widgets.
It seems like a pretty simple problem, so I was surprised when it became a roadblock for me. I feel like the solution would be really obvious and I'm just not seeing, so if it is, I apologize for making it a new question. But any help would be greatly appreciated.
Here's a solution that works, though it looks a little awkward because of a nested observe(). I'm not sure what a better way would be, but there could be something nicer.
Basically, use an observe() to loop over all the available inputs, and for each input, use another observe() that will only trigger when that input is changed and set a variable to the id of the input.
runApp(shinyApp(
ui = shinyUI(
fluidPage(
textInput('txt_a', 'Input Text A'),
textInput('txt_b', 'Input Text B'),
uiOutput('txt_c_out'),
verbatimTextOutput("show_last")
)
),
server = function(input, output, session) {
output$txt_c_out <- renderUI({
textInput('txt_c', 'Input Text C')
})
values <- reactiveValues(
lastUpdated = NULL
)
observe({
lapply(names(input), function(x) {
observe({
input[[x]]
values$lastUpdated <- x
})
})
})
output$show_last <- renderPrint({
values$lastUpdated
})
}
))
You can use a reactive value created with reactiveValues() to store the name of the last used widget. Later use an observer to keep track of the activity of each widget and update the reactive value with the name of the last used widget.
In the folowing example, the name of the last used widget is stored in last_updated_widget$v and will active the verbatimTextOutput each time it changes. You can use last_updated_widget$v at any place in the server.
library(shiny)
runApp(list(
ui = shinyUI(
fluidPage(
textInput('txt_a', 'Input Text A'),
textInput('txt_b', 'Input Text B'),
verbatimTextOutput("showLast")
)
),
server = function(input, output, session) {
last_updated_widget <- reactiveValues( v = NULL)
observe ({
input$txt_a
last_updated_widget$v <- "txt_a"
})
observe ({
input$txt_b
last_updated_widget$v <- "txt_b"
})
output$showLast <- renderPrint({
last_updated_widget$v
})
}
))

Resources