I am trying to create a shiny app where I want the user to enter a few (but variable number of) rows of a data frame (with 3 columns). The best way would be to have the user enter a row at a time, and perhaps push a button to create a new row.
What is an intuitive way to implement this in a shiny gui?
You can do something like this:
rm(list = ls())
library(shiny)
# Sample data
my_data <- data.frame(matrix(1,nrow=1,ncol=3))
colnames(my_data) <- c("one","two","three")
emptry_row <- as.data.frame(matrix(1,nrow=1,ncol=3))
colnames(emptry_row) <- colnames(my_data)
ui =fluidPage(
sidebarPanel(actionButton("add_row", "Add a row")),
mainPanel(dataTableOutput("my_table"))
)
server = function(input, output, session){
values <- reactiveValues()
values$df <- my_data
newEntry <- observe({
if(input$add_row > 0) {
isolate(values$df <- rbind(values$df, emptry_row))
}
})
output$my_table <- renderDataTable({
if(input$add_row==0){return(values$df)}
values$df
})
}
runApp(list(ui = ui, server = server))
Related
I have been going through most of the Q&As related to dataframe manipulation within Shiny and I still don't understand how to do something which, in my mind, should be very simple. I don't have experience writing Shiny apps and I'm still struggling with concepts like reactive events.
I have a dataframe A, loaded into R. I want to be able to see a specific value in a specific column in the dataframe in the UI and then edit it. After I edit the dataframe, I want to close the Shiny app and then see the edited dataframe in the Environment tab of RStudio. How do I go about doing this?
I think this might be a workable example.
Assume df is your data frame (I used iris to test, commented out below). Create a reactiveVal to hold your data, and use for editing with datatable. After editing, you can store the data back into your global environment dataframe df with <<-. An alternative is to do this when exiting the shiny app (such as through the onStop or session$onSessionEnded method).
library(shiny)
library(DT)
#df <- iris
ui <- fluidPage(
DT::dataTableOutput('data'),
)
server <- function(input, output) {
rv <- reactiveVal(df)
output$data <- DT::renderDataTable ({
DT::datatable(rv(), editable = TRUE)
})
observeEvent(input$data_cell_edit, {
info <- input$data_cell_edit
newdf <- rv()
newdf[info$row, info$col] <- info$value
rv(newdf)
df <<- rv()
})
}
shinyApp(ui = ui, server = server)
Alternative with replacing global df on exiting (requires session):
server <- function(input, output, session) {
rv <- reactiveVal(df)
output$data <- DT::renderDataTable ({
DT::datatable(rv(), editable = TRUE)
})
observeEvent(input$data_cell_edit, {
info <- input$data_cell_edit
newdf <- rv()
newdf[info$row, info$col] <- info$value
rv(newdf)
})
session$onSessionEnded(function() {
df <<- isolate(rv())
})
}
If you don't want to use reactive values, I suppose you could try the following. This can update your data.frame in the global environment as edits are made. Note that server = FALSE is added to handle changes in pages:
server <- function(input, output) {
output$data <- DT::renderDT (df, editable = TRUE, server = FALSE)
observeEvent(input$data_cell_edit, {
info <- input$data_cell_edit
df[info$row, info$col] <<- info$value
})
}
I have this question: In a Shiny App, I construct a varible with a reactive(). The thing is that, in the midle of this process (that is a long one) I construct other varibles that I need too.
For example:
#---------------UI------------------
ui <- navbarPage(
title = "example",
tabPanel('panel',
tableOutput("my_table"),
tableOutput("colum_names"))
)
#---------------SERVER------------------
server <- function(input, output) {
a <- reactive({
df_1 <- data.frame("fc"=c(1,2,3), "sc"=c(1,2,3), "tc"=c(1,2,3) )
df_2 <- subset(df_1,select=-c(fc))
column_names <- colnames(df_2)
df_3 <- df_2*2
df_3
})
output$my_table = renderTable({
a()
})
output$colum_names = renderTable({
df_column_names = data.frame(column_names())
df_column_names
})
}
#---------------APP------------------
shinyApp(ui = ui, server = server)
In this (very short) example, I would need the variable "a" (of course) and the variable "column_names". I can do something like create a new reactive that reproduce all the process until the line that contain "column_names" and finish it there. But the process is too long and I prefer to do it more "eficiently".
Any idea??
Thank you so much!
The process you're describing is correct : instead of assigning variables, just assign reactives and Shiny will handle the depedencies between them.
Note that in the example you provided, reactives aren't needed because the content is up to now static.
library(shiny)
#---------------UI------------------
ui <- navbarPage(
title = "example",
tabPanel('panel',
tableOutput("my_table"),
tableOutput("column_names"))
)
#---------------SERVER------------------
server <- function(input, output) {
df_1 <- data.frame("fc"=c(1,2,3), "sc"=c(1,2,3), "tc"=c(1,2,3) )
a <- reactive({subset(df_1,select=-c(fc))})
column_names <- reactive({colnames(a())})
output$my_table = renderTable({a()})
output$column_names = renderTable({column_names()})
}
#---------------APP------------------
shinyApp(ui = ui, server = server)
I found a interesting answer to my own question: if you want to do something like that, you can use "<<-" instead of "<-" and it save the variable when you are working insede a function (like reactive()). Let´s see:
#---------------UI------------------
ui <- navbarPage(
title = "example",
tabPanel('panel',
tableOutput("my_table"),
tableOutput("colum_names"))
)
#---------------SERVER------------------
server <- function(input, output) {
a <- reactive({
df_1 <- data.frame("fc"=c(1,2,3), "sc"=c(1,2,3), "tc"=c(1,2,3) )
df_2 <- subset(df_1,select=-c(fc))
column_names <- colnames(df_2)
# HERE THE SOLUTION!!
column_names_saved <<- column_names
df_3 <- df_2*2
df_3
})
output$my_table = renderTable({
a()
})
output$colum_names = renderTable({
df_column_names = data.frame(column_names_saved)
df_column_names
})
}
#---------------APP------------------
shinyApp(ui = ui, server = server)
Then, into the funtion you must continues with the variable "column_names", but when you need to use it later, you can use "column_name_saved". (just be carefull with one thing: onece you save the variable into the funtion, you canot change it)
Thanks!!!
I have a cumbersome function inside a server output variable.
The function returns a list of 2 data frames.
I want to extract these tables and plot them side by side.
However I do not want to create two different outputs for them in server, as I don't want the heavy function to run twice.
For the sake of giving a reproducible code :
(my getListOfDataFrames function is much heavier than in this example)
I want df1 and df2 displayed side by side with scrollX = TRUE in options
library(shiny)
library(DT)
ui <- fluidPage(
dataTableOutput("output1")
)
server <- function(input, output){
getListOfDataFrames <- function(df){
return(list(df[1:5,], df[6:10,]))
}
output$output1 <- renderDataTable({
myList <- getListOfDataFrames(mtcars)
df1 <- as.data.frame(myList[1])
df2 <- as.data.frame(myList[2])
})
}
shinyApp(ui, server)
There are plenty of examples how to create dynamic content, like example below:
library(shiny)
library(DT)
ui <- fluidPage(
uiOutput("dt")
)
server <- function(input, output){
getListOfDataFrames <- function(df){
return(list(df[1:5,], df[6:10,]))
}
myList <- getListOfDataFrames(mtcars)
output$dt <- renderUI({
ntables <- seq(myList)
# we want to create the width depending how many tables we have
width <- paste0(99/max(ntables),"%;")
lapply(ntables, function(i) {
id <- paste0("dt", i)
div(style=paste0("display:inline-block;width:",width),DT::dataTableOutput(id))
})
})
observe({
# Dynamically creating 2 tables with separate ids
lapply(seq(myList), function(i){
id <- paste0("dt", i)
output[[id]] <- DT::renderDataTable(as.data.frame(myList[i]))
})
})
}
shinyApp(ui, server)
The following code is a simpler version of my original problem.
The code should do the following steps sequentially:
The table will show entire 'mtcars'
On each click on Half button, it should show half of the previous data
On each click on One3 button, it should show one third of the previous data
** Can someone tell me how to use reactiveValues etc. to solve the problem?
library(shiny)
library(DT)
ui <- fluidPage(tabsetPanel(
tabPanel("Table",
actionButton("Half","Click for Half"),
actionButton("One3","Click for One Third"),
DTOutput("tbl")
)
))
server = function(input, output, session){
data <- reactiveValues(
tbl = mtcars
)
tbl <- eventReactive(T,data$tbl)
observeEvent(input$Half,{
data$tbl <- data$tbl[1:(round(nrow(data$tbl)/2)),]
tbl <- eventReactive(input$Half,data$tbl)
})
observeEvent(input$One3,{
data$tbl <- data$tbl[1:(round(nrow(data$tbl)/3)),]
tbl <- eventReactive(input$One3,data$tbl)
})
output$tbl <- renderDT(tbl())
}
shinyApp(ui = ui, server = server)
No need for eventreactive as reactiveValues(tbl = mtcars) default value i.e. mtcars will be there presented at output$tbl until the user hits Half then it will be updated automatically in the reactive chain.
server = function(input, output, session){
data <- reactiveValues(tbl = mtcars)
observeEvent(input$Half,{
data$tbl <- data$tbl[1:(round(nrow(data$tbl)/2)),]
})
output$tbl <- renderDT(data$tbl)
}
I am using the DT package to display a data table in my shiny app. Since I provide different data sets, I have radio buttons to select them and the data table updates automatically.
What I would like to do is to preselect the available rows from df1 in df2 when switching the datasets. At the moment, my selection always get erased. When I try to save the selected rows (uncomment the two rows), my table get reset directly.
library(shiny)
library(DT)
df1 <- data.frame(names=letters,
values=1:26)
df2 <- data.frame(names=letters,
values=(1:26)*2)[seq(1,26,2),]
ui <- shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons("dataset", label=h5("Select dataset"),
choices=list("df1"='df1',
"df2"='df2'),
selected='df1', inline=TRUE)
),
mainPanel(
DT::dataTableOutput("name_table")
)
)
)
)
Server side...
server <- function(input, output, session) {
getDataset <- reactive({
result <- list()
result[['dataset']] <- switch(input$dataset,
'df1'=df1,
'df2'=df2)
# result[['selection']] <-
# as.numeric(input$name_table_rows_selected)
return(result)
})
output$name_table <- DT::renderDataTable({
DT::datatable(getDataset()[['dataset']],
options=list(pageLength=5))
})
name_proxy = DT::dataTableProxy('name_table')
}
shinyApp(ui, server)
I used the DT table, since I need the proxy and some interaction with the data table.
You can save selected rows only when going to change df like
server <- function(input, output, session) {
dd=reactiveValues(select=NULL)
observeEvent(input$dataset,{
dd$select=as.numeric(isolate(input$name_table_rows_selected))
})
getDataset <- reactive({
result <- list()
result[['dataset']] <- switch(input$dataset,
'df1'=df1,
'df2'=df2)
return(result)
})
output$name_table <- DT::renderDataTable({
DT::datatable(getDataset()[['dataset']],
options=list(pageLength=5),
selection = list(mode = 'multiple', selected =dd$select )
)
})
name_proxy = DT::dataTableProxy('name_table')
}
shinyApp(ui, server)
Or a bit modification of #drmariod variant: use eventReactive instead of reactive
server <- function(input, output, session) {
getDataset <- eventReactive(input$dataset,{
result <- list()
result[['dataset']] <- switch(input$dataset,
'df1'=df1,
'df2'=df2)
result[['selection']] <- testing()
return(result)
})
testing <- function() {
list(selected=as.numeric(input$name_table_rows_selected))
}
output$name_table <- DT::renderDataTable({
DT::datatable(getDataset()[['dataset']],
options=list(pageLength=5),
selection=getDataset()[['selection']])
})
name_proxy = DT::dataTableProxy('name_table')
}
Hm, it looks like I found a solution, but I wonder if there is a better solution.
server <- function(input, output, session) {
getDataset <- reactive({
result <- list()
result[['dataset']] <- switch(input$dataset,
'df1'=df1,
'df2'=df2)
result[['selection']] <- testing()
return(result)
})
testing <- function() {
list(selected=as.numeric(input$name_table_rows_selected))
}
output$name_table <- DT::renderDataTable({
DT::datatable(getDataset()[['dataset']],
options=list(pageLength=5),
selection=getDataset()[['selection']])
})
name_proxy = DT::dataTableProxy('name_table')
}
I wonder, sometimes comes a processing message. and on each click the table shortly "blinks"... Would be great to get a better answer.