Update two sets of radiobuttons reactively - shiny - r

I have read this (How do I make the choices in radioButtons reactive in Shiny?) which shows me how to update radioButtons in a reactive way. However, when I try and update two sets of buttons from the same data, only one set renders. Example:
Server:
# Create example data
Wafer <- rep(c(1:3), each=3)
Length <- c(1,1,2,1,1,1,3,5,1)
Width <- c(3,1,6,1,1,1,1,1,6)
dd <- data.frame(Wafer, Length, Width)
shinyServer(function(input, output, session){
# Create reactive dataframe to store data
values <- reactiveValues()
values$df <- data.frame()
# Get Lengths and Widths of wafer from user input
a <- eventReactive(input$do, {
subset(dd, Wafer %in% input$wafer, select = Length:Width)
})
# Update reactive data frame will all Lengths and Widths that have been selected by the user input
observe({
if(!is.null(a())) {
values$df <- rbind(isolate(values$df), a())
}
})
output$wl <- renderDataTable({ a() })
# Update radio buttons with unique Length and Widths stored in values$df
# Which ever "observe" I put first in the code, is the one which updates
# the radio buttons. Cut and paste the other way round and "width"
# updates but not "length" radio buttons
observe({
z <- values$df
updateRadioButtons(session, "length", choices = unique(z$Length), inline=TRUE)
})
observe({
z <- values$df
updateRadioButtons(session, "width", choices = unique(z$Width), inline=TRUE)
})
})
ui:
library(markdown)
shinyUI(fluidPage(
titlePanel("Generic grapher"),
sidebarLayout(
sidebarPanel(
numericInput("wafer", label = h3("Input wafer ID:"), value = NULL),
actionButton("do", "Search wafer"),
radioButtons("length", label="Length", choices=""),
radioButtons("width", label="Width", choices = "")
),
mainPanel(
dataTableOutput(outputId="wl")
)
)
)
)
In the above, radiobuttons do update but only for the first set of buttons in order of code i.e. above "length" updates but "width" doesn't. If I write them in reverse, "width" updates but "length" doesn't. Do I need to define a new session maybe?

It turns out that:
"it's because a JS error occurs if the choices argument isn't a
character vector."
I have posted an issue on Shiny's Github:
https://github.com/rstudio/shiny/issues/1093
This can be resolved by:
To fix your problem, you can either convert your choices to characters
using as.character or set selected to a random string such as "".
See:
Update two sets of radiobuttons - shiny

Related

R Shiny: Modify output values in a data frame

The following simple shiny app displays a word and its sentiment as stored in the R data frame named sent.
library(shiny)
sent <- data.frame(word=c('happy', 'sad', 'joy', 'upset'),
sentiment=c('positive', 'negative', 'positive', 'negative'),
stringsAsFactors = FALSE)
ui <- fluidPage(
numericInput(inputId = 'num', label='', value=1, min=1, max=nrow(sent)),
br(),
h4("Word:"),
textOutput('word'),
br(),
h4("Sentiment:"),
textOutput('sentiment')
)
server <- function(input, output){
output$word <- renderText({ sent$word[input$num] })
output$sentiment <- renderText({ sent$sentiment[input$num] })
}
shinyApp(ui=ui, server=server)
I would like to modify this in 2 ways:
(1) I would like the user to be able to scroll through the words in the column sent$word, rather than using numericInput()
(2) More importantly, I would like the user to be able to modify the sentiment value associated with each word. Ideally, this would be a drop down menu (with 'positive' and 'negative' as options), which would display the current sentiment value stored in sent for that word, but which could be changed by the user and overridden in the dataframe.
Any suggestions?
This should do the trick
library(shiny)
sent <- data.frame(word=c('happy', 'sad', 'joy', 'upset'),
sentiment=c('positive', 'negative', 'positive', 'negative'),
stringsAsFactors = FALSE)
sent2 <- reactiveVal(sent)
i <- 1
i2 <- reactiveVal(i)
ui <- fluidPage(
uiOutput("wordSelect"),
br(),
h4("Word:"),
textOutput('word'),
br(),
h4("Sentiment:"),
textOutput('sentiment'),
br(),
uiOutput("change"),
actionButton("go","Change")
)
server <- function(input, output){
output$wordSelect <- renderUI({
selectizeInput(inputId = 'wrd', label='select word', choices=sent$word, selected=sent$word[i2()])
})
output$word <- renderText({ input$wrd })
output$sentiment <- renderText({ sent$sentiment[which(sent2()$word==input$wrd)] })
observeEvent(input$go, {
out <- sent
out$sentiment[which(sent$word==input$wrd)] <- input$newLabel
sent <<- out
sent2(out)
i <<- which(sent$word==input$wrd)+1
if(i > length(sent$word)) {
i <<- i - 1
}
i2(i)
})
output$change <- renderUI({
radioButtons("newLabel", label="Change value", choices=c('positive','negative'), sent$sentiment[which(sent2()$word==input$wrd)])
})
}
shinyApp(ui=ui, server=server)
The adjusted output is first stored in a reactiveVal named sent2(). This is required for you see the adjure values while running the Shiny App.
A selectizeInput() is used to scroll through the words (Q1).
radioButtons() are used to select positive and negative values. The default value is whatever value is currently applied to the corresponding word.
An actionButton() is used to make the change when wanted.
UPDATE: I added sent <<- out so that your sent dataframe actually gets updated. Be aware that this will overwrite the values you had stored in sent before.
UPDATE: Each time the action button is clicked, the index of the currently selected word is determined using which(). Then it is incremented and stored in i and i2(). The new index is used to determine the default value of selectizeInput(). This way, when no manual selection of words is done, you will scroll through all options. When a word is selected manually, you will continue incrementing from that word onwards. When the last word is reached, the value does not increment further

Display only one value in selectInput in R Shiny app

I am trying to dynamically populate the values of the selectInput from the data file uploaded by the user. The selectInput must contain only numeric columns.
Here is my code snippet for server.R
...
idx <- sapply(data.file, is.numeric)
numeric_columns <- data.file[, idx]
factor_columns <- data.file[, !idx]
updateSelectInput(session, "bar_x", "Select1", choices = names(numeric_columns))
updateSelectInput(session, "bar_y", "Select2", choices = names(factor_columns))
...
Corresponding ui.r
...
selectInput("bar_x", "Select1", choices = NULL),
selectInput("bar_y", "Select2", choices = NULL)
...
The code works fine as long as there are more than one values in any dropdown. However, it fails as soon as it encounters only one value to be displayed in the selectInput.
How can I handle this specific condition, given that the data is uploaded and it cannot be controlled if there is just one column as numeric?
It appears that in 2019, this issue still exists. The issue that I have seen is that when there is only one option in the dropdown, the name of the column is displayed instead of the one option.
This appears to only be a graphical problem, as querying the value for the selectInput element returns the correct underlying data.
I was unable to figure out why this problem exists, but an easy way around this bug is to simply change the name of the column so that it looks like the first element in the list.
library(shiny)
ui <- fluidPage(
selectInput("siExample",
label = "Example Choices",
choices = list("Loading...")),
)
server <- function(input, output, session) {
# load some choices into a single column data frame
sampleSet <- data.frame(Example = c("test value"))
# rename the set if there is only one value
if (length(sampleSet$Example) == 1) {
# This should only be done on a copy of your original data,
# you don't want to accidentally mutate your original data set
names(sampleSet) <- c(sampleSet$Example[1])
}
# populate the dropdown with the sampleSet
updateSelectInput(session,
"siExample",
choices = sampleSet)
}
shinyApp(ui = ui, server = server)
Info: Code was adapted by OP to make error reproducible.
To solve your issue use val2 <- val[,idx, drop = FALSE]
You dropped the column names by subsetting the data.frame().
To avoid this use drop = FALSE; see Keep column name when select one column from a data frame/matrix in R.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
# drj's changes START block 1
#selectInput('states', 'Select states', choices = c(1,2,4))
selectInput('states', 'Select states', choices = NULL)
# drj's changes END block 1
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
observe({
#drj's changes START block 2
#val <- c(1,2,3)
#names(val) <- c("a","b","c")
#updateSelectInput(session, 'states', 'Select states', choices = names(val[1]))
val <- as.data.frame(cbind(c("_1","_2","_3"), c(4, 4, 6)))
names(val) <- c("a","b")
val$b <- as.numeric(val$b)
idx <- sapply(val, is.numeric)
val2 <- val[,idx, drop = FALSE]
updateSelectInput(session, 'states', 'Select states', choices = names(val2))
#drj's changes END block 2
})
}
# Run the application
shinyApp(ui = ui, server = server)

R Shiny: How to dynamically append arbitrary number of input widgets

The goal
I am working on a Shiny app that allows the user to upload their own data and focus on the entire data or a subset by providing data filtering widgets described by the below graph
The select input "Variable 1" will display all the column names of the data uploaded by the user and the selectize input "Value" will display all the unique values of the corresponding column selected in "Variable 1". Ideally, the user will be able to add as many such rows ("Variable X" + "Value") as possible by some sort of trigger, one possibility being clicking the "Add more" action button.
A possible solution
After looking up online, I've found one promising solution given by Nick Carchedi pasted below
ui.R
library(shiny)
shinyUI(pageWithSidebar(
# Application title
headerPanel("Dynamically append arbitrary number of inputs"),
# Sidebar with a slider input for number of bins
sidebarPanel(
uiOutput("allInputs"),
actionButton("appendInput", "Append Input")
),
# Show a plot of the generated distribution
mainPanel(
p("The crux of the problem is to dynamically add an arbitrary number of inputs
without resetting the values of existing inputs each time a new input is added.
For example, add a new input, set the new input's value to Option 2, then add
another input. Note that the value of the first input resets to Option 1."),
p("I suppose one hack would be to store the values of all existing inputs prior
to adding a new input. Then,", code("updateSelectInput()"), "could be used to
return inputs to their previously set values, but I'm wondering if there is a
more efficient method of doing this.")
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
# Initialize list of inputs
inputTagList <- tagList()
output$allInputs <- renderUI({
# Get value of button, which represents number of times pressed
# (i.e. number of inputs added)
i <- input$appendInput
# Return if button not pressed yet
if(is.null(i) || i < 1) return()
# Define unique input id and label
newInputId <- paste0("input", i)
newInputLabel <- paste("Input", i)
# Define new input
newInput <- selectInput(newInputId, newInputLabel,
c("Option 1", "Option 2", "Option 3"))
# Append new input to list of existing inputs
inputTagList <<- tagAppendChild(inputTagList, newInput)
# Return updated list of inputs
inputTagList
})
})
The downside
As pointed by Nick Carchedi himself, all the existing input widgets will undesirably get reset every time when a new one is added.
A promising solution for data subsetting/filtering in Shiny
As suggested by warmoverflow, the datatable function in DT package provides a nice way to filter the data in Shiny. See below a minimal example with data filtering enabled.
library(shiny)
shinyApp(
ui = fluidPage(DT::dataTableOutput('tbl')),
server = function(input, output) {
output$tbl = DT::renderDataTable(
iris, filter = 'top', options = list(autoWidth = TRUE)
)
}
)
If you are going to use it in your Shiny app, there are some important aspects that are worth noting.
Filtering box type
For numeric/date/time columns: range sliders are used to filter rows within ranges
For factor columns: selectize inputs are used to display all possible categories
For character columns: ordinary search boxes are used
How to obtain the filtered data
Suppose the table output id is tableId, use input$tableId_rows_all as the indices of rows on all pages (after the table is filtered by the search strings). Please note that input$tableId_rows_all returns the indices of rows on all pages for DT (>= 0.1.26). If you use the DT version by regular install.packages('DT'), only the indices of the current page are returned
To install DT (>= 0.1.26), refer to its GitHub page
Column width
If the data have many columns, column width and filter box width will be narrow, which makes it hard to see the text as report here
Still to be solved
Despite some known issues, datatable in DT package stands as a promising solution for data subsetting in Shiny. The question itself, i.e. how to dynamically append arbitrary number of input widgets in Shiny, nevertheless, is interesting and also challenging. Until people find a good way to solve it, I will leave this question open :)
Thank you!
are you looking for something like this?
library(shiny)
LHSchoices <- c("X1", "X2", "X3", "X4")
#------------------------------------------------------------------------------#
# MODULE UI ----
variablesUI <- function(id, number) {
ns <- NS(id)
tagList(
fluidRow(
column(6,
selectInput(ns("variable"),
paste0("Select Variable ", number),
choices = c("Choose" = "", LHSchoices)
)
),
column(6,
numericInput(ns("value.variable"),
label = paste0("Value ", number),
value = 0, min = 0
)
)
)
)
}
#------------------------------------------------------------------------------#
# MODULE SERVER ----
variables <- function(input, output, session, variable.number){
reactive({
req(input$variable, input$value.variable)
# Create Pair: variable and its value
df <- data.frame(
"variable.number" = variable.number,
"variable" = input$variable,
"value" = input$value.variable,
stringsAsFactors = FALSE
)
return(df)
})
}
#------------------------------------------------------------------------------#
# Shiny UI ----
ui <- fixedPage(
verbatimTextOutput("test1"),
tableOutput("test2"),
variablesUI("var1", 1),
h5(""),
actionButton("insertBtn", "Add another line")
)
# Shiny Server ----
server <- function(input, output) {
add.variable <- reactiveValues()
add.variable$df <- data.frame("variable.number" = numeric(0),
"variable" = character(0),
"value" = numeric(0),
stringsAsFactors = FALSE)
var1 <- callModule(variables, paste0("var", 1), 1)
observe(add.variable$df[1, ] <- var1())
observeEvent(input$insertBtn, {
btn <- sum(input$insertBtn, 1)
insertUI(
selector = "h5",
where = "beforeEnd",
ui = tagList(
variablesUI(paste0("var", btn), btn)
)
)
newline <- callModule(variables, paste0("var", btn), btn)
observeEvent(newline(), {
add.variable$df[btn, ] <- newline()
})
})
output$test1 <- renderPrint({
print(add.variable$df)
})
output$test2 <- renderTable({
add.variable$df
})
}
#------------------------------------------------------------------------------#
shinyApp(ui, server)
Now, I think that I understand better the problem.
Suppose the user selects the datasets::airquality dataset (here, I'm showing only the first 10 rows):
The field 'Select Variable 1' shows all the possible variables based on the column names of said dataset:
Then, the user selects the condition and the value to filter the dataset by:
Then, we want to add a second filter (still maintaining the first one):
Finally, we get the dataset filtered by the two conditions:
If we want to add a third filter:
You can keep adding filters until you run out of data.
You can also change the conditions to accommodate factors or character variables. All you need to do is change the selectInput and numericInput to whatever you want.
If this is what you want, I've solved it using modules and by creating a reactiveValue (tmpFilters) that contains all selections (variable + condition + value). From it, I created a list with all filters (tmpList) and from it I created the proper filter (tmpListFilters) to use with subset.
This works because the final dataset is "constantly" being subset by this reactiveValue (the tmpFilters). At the beginning, tmpFilters is empty, so we get the original dataset. Whenever the user adds the first filter (and other filters after that), this reactiveValue gets updated and so does the dataset.
Here's the code for it:
library(shiny)
# > MODULE #####################################################################
## |__ MODULE UI ===============================================================
variablesUI <- function(id, number, LHSchoices) {
ns <- NS(id)
tagList(
fluidRow(
column(
width = 4,
selectInput(
inputId = ns("variable"),
label = paste0("Select Variable ", number),
choices = c("Choose" = "", LHSchoices)
)
),
column(
width = 4,
selectInput(
inputId = ns("condition"),
label = paste0("Select condition ", number),
choices = c("Choose" = "", c("==", "!=", ">", ">=", "<", "<="))
)
),
column(
width = 4,
numericInput(
inputId = ns("value.variable"),
label = paste0("Value ", number),
value = NA,
min = 0
)
)
)
)
}
## |__ MODULE SERVER ===========================================================
filter <- function(input, output, session){
reactive({
req(input$variable, input$condition, input$value.variable)
fullFilter <- paste0(
input$variable,
input$condition,
input$value.variable
)
return(fullFilter)
})
}
# Shiny ########################################################################
## |__ UI ======================================================================
ui <- fixedPage(
fixedRow(
column(
width = 5,
selectInput(
inputId = "userDataset",
label = paste0("Select dataset"),
choices = c("Choose" = "", ls("package:datasets"))
),
h5(""),
actionButton("insertBtn", "Add another filter")
),
column(
width = 7,
tableOutput("finalTable")
)
)
)
## |__ Server ==================================================================
server <- function(input, output) {
### \__ Get dataset from user selection ------------------------------------
originalDF <- reactive({
req(input$userDataset)
tmpData <- eval(parse(text = paste0("datasets::", input$userDataset)))
if (!class(tmpData) == "data.frame") {
stop("Please select a dataset of class data.frame")
}
tmpData
})
### \__ Get the column names -----------------------------------------------
columnNames <- reactive({
req(input$userDataset)
tmpData <- eval(parse(text = paste0("datasets::", input$userDataset)))
names(tmpData)
})
### \__ Create Reactive Filter ---------------------------------------------
tmpFilters <- reactiveValues()
### \__ First UI Element ---------------------------------------------------
### Add first UI element with column names
observeEvent(input$userDataset, {
insertUI(
selector = "h5",
where = "beforeEnd",
ui = tagList(variablesUI(paste0("var", 1), 1, columnNames()))
)
})
### Update Reactive Filter with first filter
filter01 <- callModule(filter, paste0("var", 1))
observe(tmpFilters[['1']] <- filter01())
### \__ Other UI Elements --------------------------------------------------
### Add other UI elements with column names and update the filter
observeEvent(input$insertBtn, {
btn <- sum(input$insertBtn, 1)
insertUI(
selector = "h5",
where = "beforeEnd",
ui = tagList(variablesUI(paste0("var", btn), btn, columnNames()))
)
newFilter <- callModule(filter, paste0("var", btn))
observeEvent(newFilter(), {
tmpFilters[[paste0("'", btn, "'")]] <- newFilter()
})
})
### \__ Dataset with Filtered Results --------------------------------------
resultsFiltered <- reactive({
req(filter01())
tmpDF <- originalDF()
tmpList <- reactiveValuesToList(tmpFilters)
if (length(tmpList) > 1) {
tmpListFilters <- paste(tmpList, "", collapse = "& ")
} else {
tmpListFilters <- unlist(tmpList)
}
tmpResult <- subset(tmpDF, eval(parse(text = tmpListFilters)))
tmpResult
})
### \__ Print the Dataset with Filtered Results ----------------------------
output$finalTable <- renderTable({
req(input$userDataset)
if (is.null(tmpFilters[['1']])) {
head(originalDF(), 10)
} else {
head(resultsFiltered(), 10)
}
})
}
#------------------------------------------------------------------------------#
shinyApp(ui, server)
# End
If you are looking for a data subsetting/filtering in Shiny Module :
filterData from package shinytools can do the work. It returns an expression as a call but it can also return the data (if your dataset is not too big).
library(shiny)
# remotes::install_github("ardata-fr/shinytools")
library(shinytools)
ui <- fluidPage(
fluidRow(
column(
3,
filterDataUI(id = "ex"),
actionButton("AB", label = "Apply filters")
),
column(
3,
tags$strong("Expression"),
verbatimTextOutput("expression"),
tags$br(),
DT::dataTableOutput("DT")
)
)
)
server <- function(input, output) {
x <- reactive({iris})
res <- callModule(module = filterDataServer, id = "ex", x = x, return_data = FALSE)
output$expression <- renderPrint({
print(res$expr)
})
output$DT <- DT::renderDataTable({
datatable(data_filtered())
})
data_filtered <- eventReactive(input$AB, {
filters <- eval(expr = res$expr, envir = x())
x()[filters,]
})
}
shinyApp(ui, server)
You can also use lazyeval or rlang to evaluate the expression :
filters <- lazyeval::lazy_eval(res$expr, data = x())
filters <- rlang::eval_tidy(res$expr, data = x())
You need to check for existing input values and use them if available:
# Prevent dynamic inputs from resetting
newInputValue <- "Option 1"
if (newInputId %in% names(input)) {
newInputValue <- input[[newInputId]]
}
# Define new input
newInput <- selectInput(newInputId, newInputLabel, c("Option 1", "Option 2", "Option 3"), selected=newInputValue)
A working version of the gist (without the reset problem) can be found here: https://gist.github.com/motin/0d0ed0d98fb423dbcb95c2760cda3a30
Copied below:
ui.R
library(shiny)
shinyUI(pageWithSidebar(
# Application title
headerPanel("Dynamically append arbitrary number of inputs"),
# Sidebar with a slider input for number of bins
sidebarPanel(
uiOutput("allInputs"),
actionButton("appendInput", "Append Input")
),
# Show a plot of the generated distribution
mainPanel(
p("This shows how to add an arbitrary number of inputs
without resetting the values of existing inputs each time a new input is added.
For example, add a new input, set the new input's value to Option 2, then add
another input. Note that the value of the first input does not reset to Option 1.")
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
output$allInputs <- renderUI({
# Get value of button, which represents number of times pressed (i.e. number of inputs added)
inputsToShow <- input$appendInput
# Return if button not pressed yet
if(is.null(inputsToShow) || inputsToShow < 1) return()
# Initialize list of inputs
inputTagList <- tagList()
# Populate the list of inputs
lapply(1:inputsToShow,function(i){
# Define unique input id and label
newInputId <- paste0("input", i)
newInputLabel <- paste("Input", i)
# Prevent dynamic inputs from resetting
newInputValue <- "Option 1"
if (newInputId %in% names(input)) {
newInputValue <- input[[newInputId]]
}
# Define new input
newInput <- selectInput(newInputId, newInputLabel, c("Option 1", "Option 2", "Option 3"), selected=newInputValue)
# Append new input to list of existing inputs
inputTagList <<- tagAppendChild(inputTagList, newInput)
})
# Return updated list of inputs
inputTagList
})
})
(The solution was guided on Nick's hints in the original gist from where you got the code of the promising solution)

Update two sets of radiobuttons - shiny

I asked this question (Update two sets of radiobuttons reactively - shiny) yesterday but perhaps it was too messy to get a response. I have stripped the question down: why can't I get two sets of radiobuttons to update reactively:
server.R:
# Create example data
Wafer <- rep(c(1:3), each=3)
Length <- c(1,1,2,1,1,1,3,5,1)
Width <- c(3,1,6,1,1,1,1,1,6)
dd <- data.frame(Wafer, Length, Width)
shinyServer(function(input, output, session){
# Get Lengths from user input
a <- eventReactive(input$do, {
subset(dd, Wafer %in% input$wafer, select = Length)
})
# Get Widths from user input
b <- eventReactive(input$do, {
subset(dd, Wafer %in% input$wafer, select = Width)
})
#Observe and update first set of radiobuttons based on a(). Does
#render
observe({
z <- a()
updateRadioButtons(session, "length", choices = unique(z$Length), inline=TRUE)
})
#Observe and update second set of radiobuttons based on b(). Does
#not render
observe({
z <- b()
updateRadioButtons(session, "width", choices = unique(z$Width), inline=TRUE)
})
output$l <- renderDataTable({ a() })
output$w <- renderDataTable({ b() })
})
ui.R:
library(markdown)
shinyUI(fluidPage(
titlePanel("Generic grapher"),
sidebarLayout(
sidebarPanel(
numericInput("wafer", label = h3("Input wafer ID:"), value = NULL),
actionButton("do", "Search wafer"),
radioButtons("length", label="Length", choices=""),
radioButtons("width", label="Width", choices = "")
),
mainPanel(
dataTableOutput(outputId="l"),
dataTableOutput(outputId="w")
)))
)
In the above, I can only get one set of radiobuttons to reactive ("Length"). However, if I comment out the Length observe, the Width one works so my code must be OK in isolation. Maybe I'm missing something simple?
This might be a bug of the updateRadioButtons function. When selected is not set, it is replaced by the first choice. I guess this causes an error if the choices list is numeric.
To fix your problem, you can either convert your choices to characters using as.character or set selected to a random string such as "".
Using as.character is probably better as you then get your first selection automatically selected.

Resetting Input field to null after clicking button in R Shiny

I am building an application in which users can enter data values for table by column. Once ADD button is clicked the entered values would be appended by column to the existing one. e.g.
if col1, 2, 3 are entered and ADD is clicked we have in the display
col1
2
3
and if col2, 4, 7 are entered and ADD clicked we have have the display
col1 col2
2 4
3 7
etc.
I would like it such that when the add button is clicked, the input fields are cleared to allow for the entry of new column. Please find below codes for the ui and server. The output table also does not display properly, any assistance to solve this problem too would be appreciated.
ui.R
shinyUI(pageWithSidebar(
headerPanel("My data table"),
sidebarPanel(h5("Enter input"),
textInput("colname","Enter Column Name",NA),
numericInput("x","X",NA),
numericInput("y","Y",NA),
br(),
actionButton("Add","ADD")),
mainPanel(verbatimTextOutput("out"))
))
And
server.R
shinyServer(function(input,output){
myTable <- reactive({
if(input$Add > 0)
return(isolate({
colnm <- input$colname
x <- input$x
y <- input$y
result <- data.frame(rbind(colnm,x,y))
result
}))
})
output$out <- renderTable({
myTable()
})
})
The table needs to be rendered using renderTable rather then verbatimTextOutput. I guess you want to keep old inputs. One way to do this would be to use reactiveValues. EDIT: I didnt see you wanted to reset inputs. To reset inputs use the updateNumericInput and updateTextInput function. You will also need to pass a session variable inot your server function.
runApp(
list(ui = pageWithSidebar(
headerPanel("My data table"),
sidebarPanel(h5("Enter input"),
textInput("colname","Enter Column Name",NA),
numericInput("x","X",NA),
numericInput("y","Y",NA),
br(),
actionButton("Add","ADD")),
mainPanel(tableOutput("out"))
),
server = function(input,output,session){
myValues <- reactiveValues()
observe({
if(input$Add > 0){
isolate({
colnm <- input$colname
x <- input$x
y <- input$y
if(!is.null(myValues$myDf)){
myValues$myDf <- cbind(myValues$myDf,
data.frame(setNames(list(c(x, y)), colnm))
)
}else{
myValues$myDf <- data.frame(setNames(list(c(x, y)), colnm))
}
})
updateNumericInput(session, "x","X", NA)
updateNumericInput(session, "y","Y", NA)
updateTextInput(session, "colname","Enter Column Name",NA)
}
})
output$out <- renderTable({
myValues$myDf
})
})
)
EDIT:
You could change to
updateNumericInput(session, "x","X", 3)
updateNumericInput(session, "y","Y", 5)
updateTextInput(session, "colname","Enter Column Name",'Default NAME')
and it works. Now the values change to default values of 3,5 and 'Default NAME'

Resources