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'
Related
I want to collect user inputs, and output them as a table/data frame within Shiny. Inspired by the post here (Collect All user inputs throughout the Shiny App), I was able to do this but with some issues below. Here I have attached the example code, where I intend to collect the user input using the reactive textInput box. The number of textInput boxes is according to the user input for "Number of box". The output table looks fine when I kept increasing the "Number of box", such as I increased the number of boxes from 1 to 2 (see attached screenshot 1 and 2). However, when I changed the number of boxes from 2 back to 1, the output table still showed the previous results "textBox2 the second input" (see screenshot 3). My question is how to remove this previous input ("textBox2 the second input") and only print out the current user input. Thanks!
Example code
library(shiny)
ui <- basicPage(
fluidRow(column(6,
numericInput("nbox", "Number of box", value = 1,
min = 1))),
fluidRow(column(6,style='padding:0px;',
wellPanel(
uiOutput("textInputBox"))),
column(6, style='padding:0px;',
tableOutput('show_inputs')))
)
server <- shinyServer(function(input, output, session){
output$textInputBox <- renderUI({
num <- as.integer(input$nbox)
lapply(1:num, function(i) {
textInput(paste0("textBox", i),
label = paste0("textBox", i))
})
})
AllInputs <- reactive({
myvalues <- NULL
for(i in 1:length(names(input))){
myvalues <- as.data.frame(rbind(myvalues,
(cbind(names(input)[i],input[[names(input)[i]]]))))
}
names(myvalues) <- c("User input variable","User input value")
myvalues
})
output$show_inputs <- renderTable({
AllInputs()
})
})
shinyApp(ui = ui, server = server)
Screen shot (1,2,3 in order)
Created inputs are not deleted when a new renderUI is called, so there is no solution this way.
A workaround is to use a counter (like the one previously used to create the input) and use it to rebuild the names:
AllInputs <- reactive({
num <- as.integer( input$nbox )
my_names <- paste0("textBox", 1:num)
all_values <- stack( reactiveValuesToList(input) )
myvalues <- all_values[ all_values$ind %in% c("nbox", my_names),
c(2, 1)]
names(myvalues) <- c("User input variable","User input value")
myvalues
})
Note the use of reactiveValuesToList to replace the loop.
In the shiny application multiple numeric input widgets are generated dynamically each having an initial value inside which are row-column numbers. The sum of those values are also displayed in main panel.
As the user changes the numeric input values the sum updates accordingly. Currently it is instantly. I want to delay the process of inputs in main panel for all numeric inputs by adding action/submit button till I change more than one numeric Inputs.
But I am getting the following error if action/submit buttons are used inside the render functions.
Warning: Error in <<-: number of items to replace is not a multiple of replacement length.
If not inside render functions where else to place as these widgets are generated inside renderUI only.
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel(title = "Use of action/submit button for multiple inputs"),
sidebarLayout(
sidebarPanel(numericInput("rows","Input No. of rows",value = 3,min=1),
br(),
numericInput("col","Input No. of cols",value = 1,min=1)),
mainPanel(textOutput("display"),
uiOutput("plo")
))))
Server.r
server <- function(input,output){
# creating input widgets dynamically
output$plo <- renderUI({
z <- input$col
lapply(seq(input$col), function(j){
column(width=3,
lapply(seq(input$rows),function(i){
numericInput(inputId = paste0("range",paste0(i,j)),label = j,value = paste0(i,j))
})
)
})
})
# capturing the value of input widgets in a matrix
cm <- reactive({
c <- input$col
r <- input$rows
changed_m <- matrix(nrow = r,ncol = c)
lapply(seq(input$col), function(j){
lapply(seq(input$rows),function(i){
changed_m[i,j] <<- input[[paste0("range",paste0(i,j))]]
})
})
changed_m
})
# display the sum
output$display <- renderText({
paste0("Sum of matrix: ",sum(cm()))
})
}
Here is a working example of a possible solution. You can store the string to display (or just the sum of course) in a reactiveVal, and update this only when the user clicks the button, or display an alternative text when one of the inputs has changed so the user knows the sum is no longer correct.
Hope this helps!
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel(title = "Use of action/submit button for multiple inputs"),
sidebarLayout(
sidebarPanel(numericInput("rows","Input No. of rows",value = 3,min=1),
br(),
numericInput("col","Input No. of cols",value = 1,min=1),
actionButton('update' ,'update!')),
mainPanel(textOutput("display"),
uiOutput("plo")
))))
server <- function(input,output){
# creating input widgets dynamically
output$plo <- renderUI({
z <- input$col
lapply(seq(input$col), function(j){
column(width=3,
lapply(seq(input$rows),function(i){
numericInput(inputId = paste0("range",paste0(i,j)),label = j,value = paste0(i,j))
})
)
})
})
# capturing the value of input widgets in a matrix
cm <- reactive({
c <- input$col
r <- input$rows
changed_m <- matrix(nrow = r,ncol = c)
lapply(seq(input$col), function(j){
lapply(seq(input$rows),function(i){
x=input[[paste0("range",paste0(i,j))]]
changed_m[i,j] <<- ifelse(!is.null(x),x,0)
})
})
changed_m
})
# initialize our reactiveVal with an empty string
my_sum <- reactiveVal('')
# observer that listens to the button click, then updates the sum string.
observeEvent(input$update,{
my_sum(paste0("Sum of matrix: ",sum(cm())))
})
# observer that listens to changes in the input, then updates the sum string.
observeEvent(cm(),ignoreNULL = T,ignoreInit = T, {
isolate(my_sum('invalidated. Press button to update.'))
})
# display the sum string
output$display <- renderText({
my_sum()
})
}
shinyApp(ui,server)
I want to delete the last row of a table using an action button. I have tried to follow this post Shiny: dynamically add/ remove textInput rows based on index
but I don't know how to apply the idea to my particular case.
A minimal reproducible example
library(shiny)
ui <- fluidPage(
sidebarPanel(numericInput("c1","Example", NA),
actionButton("update", "Update Table"),
br(), br(),
actionButton("reset", "Clear")
),
mainPanel( tableOutput("example")
)
)
server <- function(input, output, session) {
# stores the current data frame, called by values() and set by
values(new_data_table)
values <- reactiveVal(data.frame(A=1, B=2, C=3))
# update values table on button click
observeEvent(input$update,{
old_values <- values()
A_new <- input$c1
B_new <- A_new + 2
C_new <- A_new + B_new
new_values <- data.frame(A=A_new, B=B_new, C=C_new)
# attach the new line to the old data frame here:
new_df <- rbind(old_values, new_values)
#store the result in values variable
values(new_df)
#reset the numeric input to NA
updateNumericInput(session, "c1", "Example", NA)
})
#delete last row
deleteEntry <- observeEvent(input$reset,{
#....
})
#Print the content of values$df
output$example <- renderTable({ return(values()) })
}
shinyApp(ui = ui, server = server)
Actually I don't know how to call the last row of my interactive data frame. I have tried something like values() <- values[nrow(values())-1] but it doesn't work. Any suggestion?
EDITED
Following the suggestion below I have modified the deleteEntry function and now it works.
##delete last row
deleteEntry <- observeEvent(input$reset,{
values( values()[-nrow(values()),])
})
To remove the last row of a data.frame as a reactiveVal , use this syntax:
values(values()[-nrow(values()),])
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
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.