R Shiny input selected all does not select any input - r

Using R Shiny to build an interactive dashboard, I want to select all choices in the input by default. For some reason, when running the app, all choices are still deselected though.
Code (UI):
library(shiny)
data <- read.csv2("data.csv")
input <- as.list(data$v1)
checkboxGroupInput("input",
label = "input",
choices = input,
selected = input)
Any suggestions what could go wrong? Data is just a normal dataframe, input a normal list.

All seems to be fine with me, even with the as.list which I dont think is necessary. Maybe it conflicting with the name you're using input
rm(list = ls())
library(shiny)
select1 <- unique(mtcars$cyl)
ui <- fluidPage(checkboxGroupInput("select1",label = "input",choices = select1,selected = select1))
server <- function(input, output, session) {}
runApp(list(ui = ui, server = server))

Related

Problem with DT table update in shiny and extract table contents as R objects

Im trying to follow the examples (https://yihui.shinyapps.io/DT-edit/) for editing a DT table in R shiny, but cannot seem to get it to update correctly. Below is a toy example. As a test, table edits should print to the main panel when hitting "go," but the edits are not passed along. I am not sure what I am doing wrong.
Second, I would like to be able to work with the table as an R object that I can pass along to other aspects of the code (e.g., pass one of the columns as a vector to something else). But I am not 100% sure how to do this. Ideally this might be something like "hot_to_r" in the rhandsontable package, but I am not sure how this might be done for DT. Thank you in advance for your help.
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("use DT package"),
sidebarLayout(
sidebarPanel(
h4('A Table Using Server-side Processing'),
fluidRow(
column(2),
column(8, DT::dataTableOutput('tb')),
column(2)
),
actionButton("go", "go")
),
mainPanel(
verbatimTextOutput("test"), #to test if the table updates
)))
server <- (function(input, output, session) {
DF <- data.frame(Original_Name = rep("place holder", 3), New_Name = rep("place holder", 3), stringsAsFactors = FALSE)
output$tb <- renderDT(DF, selection = "none", server = TRUE, editable = "all")
# update edited cells ("all")
observeEvent(input$tb_cell_edit, {
DF <<- editData(DF, input$tb_cell_edit, 'tb')
})
#print the table to test that it works
#but what I really want is to create an R object that I can use
#to extract column "Original_Name" and "New_Name"
observeEvent(input$go,{
output$test<-renderPrint(DF)
})
})
runApp(list(ui=ui,server=server), launch.browser=TRUE) #launch in browser

why R Shiny Loading Spinner from shinycssloaders is not showing up

I'm trying to add a Loading Spinner on my table output. But the Spinner disappeared when I ues the column name of the table to update the choices of a checkboxGroupInput. Here is a example of the issue.
Is there any way to fix this or are there any other loading icon options?
library(shiny)
library(shinycssloaders)
data(mtcars)
ui <- fluidPage(
actionButton(inputId = 'a', label = 'show dataset'),
checkboxGroupInput(inputId = 'b', label = 'Select Column'),
tableOutput('table')%>% withSpinner(),
)
server <- function(input, output, session) {
data = eventReactive(input$a, {
# Pause for 3 seconds to simulate a long computation.
Sys.sleep(3)
mtcars
})
# loading spin disappear afer I add updateCheckboxGroupInput based on the output data column names
observeEvent(input$a, {updateCheckboxGroupInput(session, 'b', choices = colnames(data()))})
# if updateCheckboxGroupInput does not depend on output data, loading spin will show up
#observeEvent(input$a, {updateCheckboxGroupInput(session, 'b', choices = c('a','b','c'))})
output$table = renderTable({data()})
}
shinyApp(ui = ui, server = server)
You have an extra comma on this line:
tableOutput('table')%>% withSpinner(),
Just incase anyone else looks at this, the example is also using pipes, i.e. %>%, but no package that adds them. You can switch to withSpinner(tableOutput('table')) or include library(magrittr)

Use functions or loops to create shiny UI elements

I am creating a shiny app and realized I am repeating a particular UI element so I am wondering if there is a way to wrap this in a function and supply parameters to make it work in different cases. In my server file, I have
output$loss <- renderUI({
req(input$got)
if(input$got %in% Years) return(numericInput('got_snow', label = 'John Snow', value = NA))
if(!input$got %in% Years) return(fluidRow(column(3)))
})
and in the ui file, I have:
splitLayout(
cellWidths = c("30%","70%"),
selectInput('got', label = 'Select age', choices = c('',Years) , selected = NULL),
uiOutput("loss")
)
Since I find myself using these several times and only changing a few things in both the UI and server files, I wanted to wrap these in a function and use them as and when I please. I tried this for the server file
ui_renderer <- function(in_put, label, id){
renderUI({
req(input[[in_put]])
if(input[[in_put]] %in% Years) return(numericInput(id, label = label, value = NA))
if(!input[[in_put]] %in% Years) return(fluidRow(column(3)))
})
}
output$p_li <- ui_renderer(input='li', "Enter age", id="c_li")
and in my ui file, I put
uiOutput('c_li')
but it's not working. Any help is greatly appreciated.
I was unable to test your code since there was no minimal working example. I don't know if this is a typo in your example, but your are trying to render c_li, but your output is called p_li. Not sure how wrapping a render object in a standard function works, but I have done something similar using reactive values instead.
This is a minimal example using some of your terminology. It is not a working example, but an outline of the idea to my proposed solution.
# Set up the UI ----
ui <- fluidPage(
uiOutput("loss")
)
# Set up the server side ----
server <- function(input, output, session) {
# Let us define reactive values for the function inputs
func <- reactiveValues(
value <- "got",
label <- "select age",
id <- "xyz"
)
# Set up an observer for when any of the reactive values change
observeEvent({
func$value
func$label
func$id
}, {
# Render a new UI any time a reactive value changes
output[["loss"]] <- renderUI(
if (input[[func$value]] %in% years) {
numericInput(func$id, label = func$label, value = NA)
} else {
fluidRow(
column(3)
)
}
)
})
}
# Combine into an app ----
shinyApp(ui = ui, server = server)
The general idea is to define a set of reactive values and set up an observer that will render the UI every time one or more of the reactive values change. You can assign a new value to any of the reactive values using direct assignment, e.g. current$value <- "object_two". Making that change will update the UI using Shiny's reactive pattern, which means you only need to change one value to update the UI.

Modifying a Non-Reactive R Dataframe while running Shiny App

I'm building my first Shiny app and I'm running into some trouble.
When I register a new user for the app, I need to add a row with some empty values to a dataframe, that will be used to generate recommendations.
user_features3 <- rbind(user_features3,c(612,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0))
This works alright while the app isn't running, and the 612th row is added. But while it's running, this has no effect on user_features3. I think this may be because R is busy with the webapp.
If I make a reactive value, say values <- reactiveValues() and then
value$df <- user_features3, I can modify the values in this reactive one, but I am unable to access the non-reactive one in a similar manner while the app is running.
I need to update it in real-time so that I can use it to generate movie recommendations. Any suggestions?
This solves your asked question, but modifying non-reactive variables can cause problems as well. In general, thinking about modifying a non-reactive variable within a shiny environment indicates perhaps you aren't thinking about how to scale or store or properly maintain the app state. For instance, if you are expecting multiple users, then know that this data is not shared with the other users, it is the current-user only. There is no way around this using local variables. (If you need to "share" something between users, you really need a data backend such as some form of SQL, including SQLite. See: https://shiny.rstudio.com/articles/persistent-data-storage.html)
In addition to all of the other shiny tutorials, I suggest you read about variable scope in shiny, specifically statements such as
"A read-only data set that will load once, when Shiny starts, and will be available to each user session", talking about data stored outside of the server function definition;
"This local copy of [this variable] is not be visible in other sessions", talking about a variable stored within the server function; and
"Objects defined in global.R are similar to those defined in app.R outside of the server function definition".
Having said that, two offered solutions.
Reactive Frame (encouraged!)
library(shiny)
ui <- fluidPage(
# App title ----
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
textInput(inputId = "sometext", label = "Some Text:",
placeholder = "(nothing meaningful)"),
actionButton(inputId = "addnow", label = "Add!")
),
mainPanel(
tableOutput("myframe")
)
)
)
server <- function(input, output, session) {
rxframe <- reactiveVal(
data.frame(txt = character(0), i = integer(0),
stringsAsFactors = FALSE)
)
observeEvent(input$addnow, {
newdat <- data.frame(txt = isolate(input$sometext),
i = nrow(rxframe()) + 1L,
stringsAsFactors = FALSE)
rxframe( rbind(rxframe(), newdat, stringsAsFactors = FALSE) )
})
output$myframe <- shiny::renderTable( rxframe() )
}
shinyApp(ui, server)
This example uses shiny::reactiveVal, though it would be just as easy to use shiny::reactiveValues (if multiple reactive variables are being used).
Non-Reactive Frame (discouraged)
library(shiny)
ui <- fluidPage(
# App title ----
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
textInput(inputId = "sometext", label = "Some Text:",
placeholder = "(nothing meaningful)"),
actionButton(inputId = "addnow", label = "Add!")
),
mainPanel(
tableOutput("myframe")
)
)
)
server <- function(input, output, session) {
nonrxframe <- data.frame(txt = character(0), i = integer(0),
stringsAsFactors = FALSE)
output$myframe <- shiny::renderTable({
req(input$addnow)
nonrxframe <<- rbind(nonrxframe,
data.frame(txt = isolate(input$sometext),
i = nrow(nonrxframe) + 1L,
stringsAsFactors = FALSE),
stringsAsFactors = FALSE)
nonrxframe
})
}
shinyApp(ui, server)
Both allow sequencing as the screenshots below demonstrate. Many will argue that the first (reactive) example is cleaner and safer. (Just the use of <<- is deterrent enough for me!)

Interactive Column/Table Updates with textInput in R Shiny

UPDATE
I've gotten to what I think is the root problem. The following R Shiny App produces a UI with 2 text input boxes, as well as event observers that print messages to the console as the text changes in their respective text input boxes. The issue is that only one of these event observers works correctly, and I can't figure out why.
ui.R (shortened)
library(shiny)
library(shinydashboard)
library(DT)
library(data.table)
shinyUI(
renderUI({
fluidPage(
column(12, dataTableOutput("Main_table")),
box(textInput("TEST_BOX", label=NULL, value="TEST"))
)
})
)
server.R (shortened)
shinyServer(function(input, output) {
test <- reactiveValues()
test$data <- data.table(ID = 1, Group = 1)
output$Main_table <- renderDataTable({
datatable(data.frame(test$data,
New_Group=as.character(textInput("BOX_ID", label = NULL, value = "TEST2",
width = '100px'))), escape=F
)})
observeEvent(input$TEST_BOX, {
print("Test Box Success")
})
observeEvent(input$BOX_ID, {
print("Box ID Success")
})
})
Original Post:
I'm attempting to create a simple app in R Shiny to allow the user to interactively update the values in a column of a small table, then be able to hit a "Save Changes" button and update the table to include their selections.
I've gotten really close with the code below (I think), but for some reason the inputs cbox_1 to cbox_10 always come back as NULL.
ui.R
library(shiny)
library(shinydashboard)
library(DT)
library(data.table)
shinyUI(fluidPage(
dashboardBody(uiOutput("MainBody")
)
))
server.R
# Load libraries
library(shiny)
library(shinydashboard)
library(DT)
library(data.table)
# Define server logic
shinyServer(function(input, output) {
# Create sample data
vals <- reactiveValues()
vals$Data <- data.table(ID = 1:10, Group = 1:1)
# Create main UI with Save Changes button and additional text input box for testing.
output$MainBody <- renderUI({
fluidPage(
box(width=12,
h3(strong("Group Testing"),align="center"),
hr(),
box(textInput("test", label=NULL, value="TESTING")),
column(6, offset = 5, actionButton("save_changes","Save changes")),
column(12, dataTableOutput("Main_table"))
)
)
})
# Function to be used to create multiple text input boxes.
shinyInput = function(FUN, len, id, ...) {
inputs = character(len)
for (i in seq_len(len)) {
inputs[i] = as.character(FUN(paste0(id, i), label = NULL, value = vals$Data$Group[i], width = '100px', ...))
}
inputs
}
# Renders table to include column with text input boxes. Uses function above.
output$Main_table <- renderDataTable({
datatable(data.frame(vals$Data, New_Group=shinyInput(textInput, nrow(vals$Data),"cbox_")), options = list(dom = 't', pageLength = nrow(vals$Data), paging=FALSE, searching=FALSE), rownames=FALSE,
escape=F)
}
)
# Tests if the test input box works.
observeEvent(input$test, {
print("Success1")
})
# Tests if the first input box in the table works.
observeEvent(input$cbox_1, {
print("Success2")
})
# Tests if the Save Changes button works.
observeEvent(input$save_changes, {
print("Success3")
# Assigns the values in the input boxes (New_Group) to the existing Group column.
for (i in 1:nrow(vals$Data)) {
vals$Data$Group[i] <- eval(paste0("input$cbox_", i))
}
datatable(data.frame(vals$Data, New_Group=shinyInput(textInput, nrow(vals$Data),"cbox_")), options = list(pageLength = nrow(vals$Data), paging=FALSE, searching=FALSE), rownames=FALSE,
escape=F)
})
})
The first two observeEvents at the end of the code are solely for testing purposes. "Success2" is never printed even when the contents of the first box are changed. "Success1" is printed when the test box is changed, but I'm not sure why one works and the other doesn't. I've tried inserting a browser() statement in various places of the code to check the value of cbox_1, but it always comes back NULL. I'd also be open to alternate solutions to this problem if I'm approaching it completely wrong. Thanks.
After further research, an approach utilizing the rhandsontable package seemed like the best solution. I modeled my code after this example:
Data input via shinyTable in R shiny application
I also utilized several of the options described here:
https://jrowen.github.io/rhandsontable/#introduction

Resources