Problem: I have the following sample app in which the user can make changes to an rhandsontable object. I want to check if the modifications that the user is doing is valid. Already implemented: If not valid, the cell color changes to dark red.
Question: Is there a possibility to check in R (not only visually) the whole rhandsontable if it contains of only valid inputs, i.e. some TRUE/FALSE flag that can be returned and is an attribute of rhandsontable object or some hidden option or so?
library(shiny)
library(rhandsontable)
ui <- fluidPage(
rHandsontableOutput("table")
)
server <- function(input, output, session) {
output$table <- renderRHandsontable(
rhandsontable(mtcars)
)
observe({
str(input$table)
})
}
shinyApp(ui, server)
You can read in the table with hot_to_r and then do the checks. In the example, if you change one cell to a character, the flag is set to FALSE. This is because a character is returned as NA in the input (I'm not sure why not the character is returned):
library(shiny)
library(rhandsontable)
ui <- fluidPage(
rHandsontableOutput("table"),
verbatimTextOutput("flag")
)
server <- function(input, output, session) {
# flag for numeric values
is_table_ok <- reactiveVal(FALSE)
output$table <- renderRHandsontable(
rhandsontable(mtcars)
)
observeEvent(input$table, {
table_object <- hot_to_r(input$table)
flag <- !is.na(table_object)
flag <- purrr::reduce(flag, `&&`)
is_table_ok(flag)
})
output$flag <- renderPrint({
is_table_ok()
})
}
shinyApp(ui, server)
Related
In the below example code I reactively subset the mtcars dataframe inside the renderPlot() function. However, in my larger App with many render functions in the server section I am having to repeat the same rv$x[1:input$samples], etc., over and over in many places. How would I apply this subsetting instead "at the top", into the rv <- reactiveValues(...) function itself or equivalent "master function"? I tried subsetting inside the reactiveValues() and got the message "Warning: Error in : Can't access reactive value 'samples' outside of reactive consumer. Do you need to wrap inside reactive() or observer()?" I assumed incorrectly that the reactiveValues() function is a "reactive consumer".
If someone can answer this basic understanding question, please explain the logic for correctly subsetting "at the top" because I am getting very embarrassed by my repeated questions about Shiny reactivity.
library(shiny)
ui <- fluidPage(
sliderInput('samples','Nbr of samples:',min=2,max=32,value=16),
plotOutput("p")
)
server <- function(input, output, session) {
rv <- reactiveValues(
x = mtcars$mpg,
y = mtcars$wt
)
output$p <- renderPlot({plot(rv$x[1:input$samples],rv$y[1:input$samples])})
}
shinyApp(ui, server)
There are multiple ways you can handle this.
Here is one way to create new subset reactive values inside observe.
library(shiny)
ui <- fluidPage(
sliderInput('samples','Nbr of samples:',min=2,max=32,value=16),
plotOutput("p")
)
server <- function(input, output, session) {
rv <- reactiveValues(
x = mtcars$mpg,
y = mtcars$wt
)
observe({
rv$x_sub <- rv$x[1:input$samples]
rv$y_sub <- rv$y[1:input$samples]
})
output$p <- renderPlot({plot(rv$x_sub,rv$y_sub)})
}
shinyApp(ui, server)
I'd use reactiveValues only if you need them to be modified in different places.
reactive is shiny's basic solution for this:
library(shiny)
library(datasets)
ui <- fluidPage(
sliderInput(
'samples',
'Nbr of samples:',
min = 2,
max = 32,
value = 16
),
plotOutput("p")
)
server <- function(input, output, session) {
reactive_mtcars <- reactive({mtcars[1:input$samples,]})
output$p <- renderPlot({
plot(reactive_mtcars()$mpg, reactive_mtcars()$wt)
})
}
shinyApp(ui, server)
I want to save the value from username input if it doesn't exist in data frame, and render text if it already exists (for reprex purpose).
Rendering text part works perfectly, but I don't know how to save it and use it later.
I want to save the value permanently, not only on current session
I've got this error:
Warning: Error in <-: invalid (NULL) left side of assignment
library(shiny)
ui <- fluidPage(
textInput("username", "username"),
actionButton("save", "Save!"),
textOutput("confirmation")
)
server <- function(input, output, session) {
df <- reactive(data.frame(column1 = "user1"))
exist <- reactive(input$username %in% df()$column1)
observeEvent(input$save, {
if (exist() == TRUE) {
output$confirmation <- renderText("Username already exists!")
} else {
df() <- rbind(df(), input$username) # <-- THIS dosn't work
}
})
}
shinyApp(ui, server)
EDIT:
Thanks to #I_O answer, I figured out this solution
reactiveVal() keep the changes in current session.
write_csv() and read_csv() part, allows app to use previously saved usernames.
saved_df <- read_csv("C:\\Users\\Przemo\\Documents\\R\\leaRn\\Shiny\\Moodtracker\\testers\\test_safe.csv")
ui <- fluidPage(
textInput("username", "username"),
actionButton("save", "Save!"),
textOutput("confirmation")
)
server <- function(input, output, session) {
df <- reactiveVal(saved_df)
exist <- reactive(input$username %in% df()$column1)
observeEvent(input$save, {
if (exist() == TRUE) {
output$confirmation <- renderText("Username already exists!")
} else {
output$confirmation <- renderText("")
df(rbind(df(), input$username))
write_csv(df(), "C:\\Users\\Przemo\\Documents\\R\\leaRn\\Shiny\\Moodtracker\\testers\\test_safe.csv")
}
})
}
shinyApp(ui, server)
I am currently trying in vain to use the debounce function in Shiny to delay my input a bit. The goal is to have the renderText not fire every few milliseconds, but only after 2 second intervals.
I tried to implement the following solution. Thereby I absolutely need the reactiveValues and observeEvent functions. Other solutions here never take this combination into account and I am currently stuck. My example code is shortened. In reality the variable name1$data is still used by different functions and the RenderText accesses different variables.
if (interactive()) {
ui <- fluidPage(
textInput("IText1", "Input i want to slow down"),
textOutput("OName")
)
server <- function(input, output, session) {
Name1 <- reactiveValues()
observeEvent(input$IText1, {Name1$data <- input$IText1})
#Solutions on stackoverflow
#Just causes errors for me
#Name1$t <- debounce(Name1$data, 2000)
output$OName <- renderText({
Name1$data
})
}
shinyApp(ui, server)
}
Thank you very much for any hint!
Normally we debounce reactive conductors (reactive({......})):
ui <- fluidPage(
textInput("IText1", "Input i want to slow down"),
textOutput("OName")
)
server <- function(input, output, session) {
Name1 <- reactive({
input$IText1
})
Name1_d <- debounce(Name1, 2000)
output$OName <- renderText({
Name1_d()
})
}
shinyApp(ui, server)
EDIT
Or you need
server <- function(input, output, session) {
Name1 <- reactiveValues()
observe({
invalidateLater(2000, session)
Name1$data <- isolate(input$IText1)
})
output$OName <- renderText({
Name1$data
})
}
I have the following example:
library(shiny)
ui <- fluidPage(
textOutput("out"),
actionButton("plusX", "Increase X"),
actionButton("redraw", "redraw")
)
server <- function(input, output, session) {
x <- 0
observeEvent(input$plusX, {x <<- x+1})
output$out <- renderText({
input$redraw
x
})
}
shinyApp(ui, server)
Is this considered an anti-pattern in Shiny to modify a non-reactive variable in this way? Obviating the super assignment which can be problematic by itself.
I know this could be done, for example with a reactiveVal to store X, and isolate to obtain a similar result. This second way seems clearer and that would be my usual choice, but I was wondering if there any caveats in the first one, or it is possible way of doing that.
library(shiny)
ui <- fluidPage(
textOutput("out"),
actionButton("plusX", "Increase X"),
actionButton("redraw", "redraw")
)
server <- function(input, output, session) {
x <- reactiveVal(0)
observeEvent(input$plusX, {x(x()+1)})
output$out <- renderText({
input$redraw
isolate(x())
})
}
shinyApp(ui, server)
In this example there is no important difference between both codes as you are not using the benefit of ReactiveVal.
The benefit of ReactiveVal is that it has a reactive nature and thus can interact with other reactive elements.
Try for example to add a table to your code that depends on x:
output$tab <- renderTable({data.frame(y = x)})
(x() in the case of ReactiveVal)
The difference you will see that in the case of ReactiveVal the table automatically updates with plusX whereas in the case of the regular variable it does not update.
I am having trouble with nested selectizeInputs, i.e. a group of select inputs where the selection in the first determines the choices in the second, which control the choices in the third, and so on.
Let's say I have an select1 that lets you choose a dataset, and select2 which lets you pick a variable in the dataset. Obviously the choices in select2 depend on the selection in select1. I find that if a user selects a variable from select2, and then changes select1, it doesn't immediately wipe out the value from select2, but instead it goes through a reactive sequence with the new value in select1, and the old value from select2, which is suddenly referencing a variable in a different dataset, which is a problem.
Example:
library(shiny)
ui =fluidPage(
selectizeInput('d',choices=c('mtcars','iris'),
label="Datasets"),
uiOutput("vars"),
htmlOutput("out")
)
server = function(input, output, session) {
output$vars <- renderUI({
req(input$d)
selectizeInput("v",choices=names(get(input$d)), label="Variables",
options=list(onInitialize=I('function() {this.setValue("");}')))
})
output$out <- renderUI({
req(input$d,input$v)
HTML(paste0("The max is ",max(get(input$d)[[input$v]])))
})
}
runApp(list(ui = ui, server = server))
On launch, select mpg, and displays max value.
Now, after selecting mpg, if you switch to iris, you will get a barely noticeable error, then it corrects itself. This is a toy example, so the error is insignificant, but there could easily be cases where the error is much more dire (as is the case with the app I am currently developing).
Is there a way to handle nested selectizeInputs such that changes in an upstream selectizeInput won't evaluate with old values of down stream selectizeInputs when changed?
Thanks
edit: This issue turns out to have to do more with modules than anything else I believe:
library(shiny)
library(DT)
testModUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns("out"))
}
testMod <- function(input, output, session, data) {
output$out <- DT::renderDataTable({
data()
},caption="IN MODULE")
}
ui =fluidPage(
selectizeInput('d',choices=c('mtcars','iris'),
label="Datasets"),
uiOutput("vars"),
testModUI("test"),
DT::dataTableOutput("test2")
)
server = function(input, output, session) {
output$vars <- renderUI({
req(input$d)
selectizeInput("v",choices=names(get(input$d)), label="Variables",
options=list(onInitialize=I('function() {this.setValue("");}')))
})
observe({
req(input$d,input$v)#,get(input$d)[[input$v]])
validate(
need(input$v %in% names(get(input$d)), 'Wait.')
)
callModule(testMod,"test",reactive(data.frame(v1=max(get(input$d)[[input$v]]))))
})
output$test2 <- DT::renderDataTable({
req(input$d,input$v)#,get(input$d)[[input$v]])
validate(
need(input$v %in% names(get(input$d)), 'Wait.')
)
data.frame(v1=max(get(input$d)[[input$v]]))
},caption="OUTSIDE MODULE")
}
runApp(list(ui = ui, server = server))
Hello you can put condition to check if your code is going to run, here you just need that input$v to be a valid variable from input$d, so do :
output$out <- renderUI({
req(input$d,input$v)
if (input$v %in% names(get(input$d))) {
HTML(paste0("The max is ",max(get(input$d)[[input$v]])))
}
})
# or
output$out <- renderUI({
req(input$d,input$v)
validate(
need(input$v %in% names(get(input$d)), 'Wait.')
)
HTML(paste0("The max is ",max(get(input$d)[[input$v]])))
})
EDIT with module, you can define your module with an expression to validate like this :
testMod <- function(input, output, session, data, validExpr) {
output$out <- DT::renderDataTable({
validate(need(validExpr(), FALSE))
data()
},caption="IN MODULE")
}
And call the module in the server with the expression in a function :
observe({
req(input$d,input$v)
callModule(
module = testMod,
id = "test",
data = reactive({ data.frame(v1=max(get(input$d)[[input$v]])) }),
validExpr = function() input$v %in% names(get(input$d))
)
})