Recursive change in reactive table in shiny - r

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)
}

Related

Get filtered data in reactable in shiny

I have a shiny application that lets the user filter data, eventually the user should be able to download the filtered data but I cannot access the filtered/shown data from reactable.
An MWE would be the following: (Note that the getReactableState() function does not return the filtered data but would work if one had to select all filtered data.)
library(shiny)
library(reactable)
ui <- fluidPage(
reactableOutput("table"),
verbatimTextOutput("table_state")
)
server <- function(input, output) {
output$table <- renderReactable({
reactable(iris, filterable = TRUE)
})
output$table_state <- renderPrint({
print(getReactableState("table")) #< wrong code here...
# the goal would be to get the rows which are currently shown here
})
}
shinyApp(ui, server)
Not a full answer, but at least it allows to download the filtered data as a CSV (solution from here):
tags$button("Download as CSV", onclick = "Reactable.downloadDataCSV('table')")
The full solution looks like this:
library(shiny)
library(reactable)
ui <- fluidPage(
tags$button("Download as CSV", onclick = "Reactable.downloadDataCSV('table')"),
reactableOutput("table")
)
server <- function(input, output) {
output$table <- renderReactable({
reactable(iris, filterable = TRUE)
})
}
shinyApp(ui, server)

How to re-order datatable column names in a R-Shiny App?

I am writing an App which displays data via datatable. Therefore different forms of text files from users are read in. It is often the case that the order of the columns is mixed up in this files, but the information in it is valid.
After displaying the data I want to do some plausibility routines and therefore I want to say: do XY with the data in "Column A". But if there is the wrong data (because of the wrong order of the columns) the plausibility is useless. Therefore I would like reorder the column names like: Column no. 3 is not 'Column A' but contains the data of 'column B', etc.
What I want to do now is to reorder the column names, not the entire column as done here.
With the following code I am able to move the whole column, but how do I only move the column names?
Edit: Just to make things clear: no, I don't want to sort the columns while reading in the data. I want to read in the file as it is and just work with the datatable object. This is mainly because I don't know what kind of file i get and what kind of information is in there. So I first of all want to display what's in there and then have a closer look.
library(shiny)
library(DT)
ui <- fluidPage(
DTOutput("table")
)
server <- function(input, output, session){
output$table <- renderDT({
datatable(
iris,
rownames = FALSE,
extensions = "ColReorder",
options = list(
colReorder = TRUE
),
colnames = c("S-Length", "S-Width", "P-Length", "P-Width", "Species")
)
})
}
shinyApp(ui, server)
Your solution works but the datatable is re-rendered each time you reorder the column names.
Here is a solution using shinyjqui::jqui_sortable with which the datatable is not re-rendered when one sorts the column names:
library(shiny)
library(shinyjqui)
library(DT)
ui <- fluidPage(
br(),
DTOutput("dtable")
)
server <- function(input, output, session){
output[["dtable"]] <- renderDT({
datatable(head(iris, 5))
})
jqui_sortable("#dtable thead tr")
}
shinyApp(ui, server)
Well, I guess I found a solution myself via the package shinyjqui.
library(shiny)
library(DT)
library(shinyjqui) # of course you need to install the package first, if you've never used it before
ui <- fluidPage(
shinyjqui::orderInput("order",
"some order",
items = c("S-Length", "S-Width", "P-Length", "P-Width", "Species")),
tags$br(),
DTOutput("table")
)
server <- function(input, output, session){
output$table <- renderDT({
names(iris) <- input$order
datatable(
iris,
rownames = FALSE,
extensions = "ColReorder",
options = list(
colReorder = TRUE
)
)
})
}
shinyApp(ui, server)
Note: With names(iris) <- input$order I've directly changed the columns' names of the data set and not just the names of the datatable, because I wanted to further access the columns by its (new) names. One could also "only" change the (displayed) names for the datatable.
Edit: btw, here is Stéphane Laurent's version (see answer above) modularized, in case anyone needs it.
library(shiny)
library(shinyjqui)
library(DT)#
ui_modul <- function(id) {
ns <- NS(id)
tagList(
jqui_sortable( DTOutput(ns("dtable")), options = list(items= "thead th"))
)
}
server_modul <- function(id) {
moduleServer(
id,
function(input, output, session) {
output[["dtable"]] <- renderDT({
datatable(head(iris, 5))
})
}
)
}
ui <- fluidPage(
br(),
ui_modul("test")
)
server <- function(input, output, session){
server_modul("test")
}
shinyApp(ui, server)

How to use original and updated version of reactive data.table in Shiny?

I'm trying to include a dataset in a Shiny app that first gets read in and used as is, e.g. by displaying it as a table. I would like to allow the user to then be able to manipulate this dataset and update the same table output with the updated dataset.
I can get both parts to work separately - I can display the original data, and I can display reactive updated data. But I can't figure out how to get both to work using the same dataset? The below code is a simple example using iris, with an attempt to display the original dataset and then rbinding it so there are twice as many rows to display in the updated dataset when you hit 'Run'. Note that I've converted the data to data.table because my actual code will be using data.table a lot.
library(shiny)
library(data.table)
iris <- as.data.table(iris)
ui <- fluidPage(
fluidRow(column(4, actionButton("run", "Run"))),
fluidRow(column(12, tabPanel(title = "tab1",
DT::dataTableOutput("table1"))))
)
server <- function(input, output, session) {
irisdata <- reactive({
irisdata <- iris
})
irisdata <- eventReactive(input$run, {
rbind(irisdata(), iris, fill = TRUE)
})
output$table1 <- DT::renderDataTable({
irisdata()
})
}
shinyApp(ui, server)
The rbind results in: Error in : evaluation nested too deeply: infinite recursion / options(expressions=)?
Which is to be expected I suppose as it's self-referencing, but I can't figure out how to write the code otherwise?
Working code of the above example, based on the linked threads in the comments:
library(shiny)
library(data.table)
iris <- as.data.table(iris)
ui <- fluidPage(
fluidRow(column(4, actionButton("run", "Run"))),
fluidRow(column(12, tabPanel(title = "tab1",
DT::dataTableOutput("table1"))))
)
server <- function(input, output, session) {
irisdata <- reactiveValues(data = iris)
observeEvent(input$run, {
irisdata$data <- rbind(irisdata$data, iris, fill = TRUE)
})
output$table1 <- DT::renderDataTable({
irisdata$data
})
}
shinyApp(ui, server)

keep selected rows when changing dataset in shiny DT datatable

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.

The best way to get a data frame from user in shiny

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))

Resources