Subset a data table based on cell selection of another datatable - r

I have a shiny app with 3 datatables. The first one contains only the 5th row with Species the 2nd table contains some random Species and the third table should get the selected cells from the first 2 tables and combines them into a new table. While the first seems to works fine the 2nd table selection seems to be wrong and that happens because it subsets by cell position and not by cell value.
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(
fluidRow(
DT::dataTableOutput("myDatatable"),
DT::dataTableOutput("myDatatable2"),
DT::dataTableOutput("myDatatable3")
)
)
server <- shinyServer(function(input, output, session) {
output$myDatatable <- DT::renderDataTable(matrix(iris[,5]),
selection=list( target="cell"),
server = FALSE,
rownames=FALSE)
output$myDatatable2 <- DT::renderDataTable(matrix(iris[c(25,78,67,45,90,66,78,9,8),5]),
selection=list(mode="single", target="cell"),
server = FALSE,
rownames=FALSE)
output$myDatatable3 <- DT::renderDataTable(iris[c(input$myDatatable_cells_selected,input$myDatatable2_cells_selected),],
server = FALSE,
rownames=FALSE)
})
shinyApp(ui, server)


See code below. You were trying to subset the data versus creating a new dataframe(which from above sounds like what you want) + you want to use [tablename]_cell_clicked which has a row, column, value list versus [tablename]_cells_selected.
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(
fluidRow(
DT::dataTableOutput("myDatatable"),
DT::dataTableOutput("myDatatable2"),
DT::dataTableOutput("myDatatable3")
)
)
server <- shinyServer(function(input, output, session) {
dat1 <- reactive({
matrix(iris[,5])
})
dat2 <- reactive({
matrix(iris[c(25,78,67,45,90,66,78,9,8),5])
})
dat3 <- reactive({
temp <- data.frame(results = c(input$myDatatable_cell_clicked$value, input$myDatatable2_cell_clicked$value))
})
output$myDatatable <- DT::renderDataTable(dat1(),
selection=list( target="cell"),
server = FALSE,
rownames=FALSE)
output$myDatatable2 <- DT::renderDataTable(dat2(),
selection=list(mode="single", target="cell"),
server = FALSE,
rownames=FALSE)
output$myDatatable3 <- DT::renderDataTable(dat3(),
server = FALSE,
rownames=FALSE)
})
shinyApp(ui, server)
**Updated based on OP's clarification
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(
fluidRow(
DT::dataTableOutput("myDatatable"),
DT::dataTableOutput("myDatatable2"),
DT::dataTableOutput("myDatatable3")
)
)
server <- shinyServer(function(input, output, session) {
dat1 <- reactive({
matrix(iris[,5])
})
dat2 <- reactive({
matrix(iris[c(25,78,67,45,90,66,78,9,8),5])
})
dat3 <- reactive({
dat1row <- input$myDatatable_cells_selected
dat2row <- c(25,78,67,45,90,66,78,9,8)[c(input$myDatatable2_cell_clicked$row)]
temp <- iris[c(dat1row, dat2row),]
})
output$myDatatable <- DT::renderDataTable(dat1(),
selection=list( target="cell"),
server = FALSE,
rownames=FALSE)
output$myDatatable2 <- DT::renderDataTable(dat2(),
selection=list(mode="single", target="cell"),
server = FALSE,
rownames=FALSE)
output$myDatatable3 <- DT::renderDataTable(dat3(),
server = FALSE,
rownames=FALSE)
})
shinyApp(ui, server)

Related

Select rows from one table to another then plot the data from the second table R Shiny

I want to store rows selection from the first table to a second table. Then, create plot from selected rows that are now in the second table. Below is what I have tried to do, any suggestion?
The data I have can be seen in the picture
library(shiny)
library(DT)
readfile <- read.csv("data.csv")
server <- shinyServer(function(input, output, session) {
output$x1 = DT::renderDataTable(readfile, server = FALSE)
output$x2 = DT::renderDataTable({
sel <- input$x1_rows_selected
if(length(readfile)){
readfile[sel, ]
}
}, server = FALSE)
output$x3 <- renderPlot({
s = input$x3_rows_selected
ggplot(readfile[input$x1_rows_all, ], aes(x=Month)) +
geom_bar()
})
})
ui <- fluidPage(
fluidRow(
column(6, DT::dataTableOutput('x1')),
column(6, DT::dataTableOutput('x2')),
column(6, plotOutput('x3', height = 500))
)
)
shinyApp(ui, server)

I think you just need to replace this:
ggplot(readfile[input$x1_rows_all, ], aes(x=Month))
with this:
ggplot(readfile[input$x1_rows_selected, ], aes(x=Month))
Update: Here's the whole app using the mtcars data.
library(DT)
readfile <- mtcars
server <- shinyServer(function(input, output, session) {
output$x1 = DT::renderDataTable(readfile, server = FALSE)
output$x2 = DT::renderDataTable({
sel <- input$x1_rows_selected
if(length(readfile)){
readfile[sel, ]
}
}, server = FALSE)
output$x3 <- renderPlot({
s = input$x3_rows_selected
ggplot(readfile[input$x1_rows_selected, ], aes(x=factor(cyl, levels=c(4,6,8)))) +
geom_bar()
})
})
ui <- fluidPage(
fluidRow(
column(6, DT::dataTableOutput('x1')),
column(6, DT::dataTableOutput('x2')),
column(6, plotOutput('x3', height = 500))
)
)
shinyApp(ui, server)
Here's what the output looks like - it seems to be doing what is intended.

Print the value of a selected cell from a datatable

I would like to extract the value of a selected cell instead of its row and column coordinates when I click on it as I want to use it as input for another procedure.
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(
fluidRow(
DT::dataTableOutput("myDatatable"),
verbatimTextOutput("selectedCells")
)
)
server <- shinyServer(function(input, output, session) {
output$myDatatable <- DT::renderDataTable(mtcars,
selection=list(mode="single", target="cell"),
server = FALSE,
rownames=FALSE)
output$selectedCells <- renderPrint(input$myDatatable_cells_selected)
})
shinyApp(ui, server)

You can access the value in the table with row and column number like the following:
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(fluidRow(
DT::dataTableOutput("myDatatable"),
verbatimTextOutput("selectedCells")
))
server <- shinyServer(function(input, output, session) {
output$myDatatable <- DT::renderDataTable(
mtcars,
selection = list(mode = "single", target =
"cell"),
server = FALSE,
rownames = FALSE
)
output$selectedCells <- renderPrint({
s = input$myDatatable_cells_selected
if (!is.null(s) && ncol(s) != 0) {
mtcars[s[1, 1] , s[1, 2] + 1]
} else {
NULL
}
})
})
shinyApp(ui, server)
As you can see, one must be added to column value to specify appropriate position. Handling unselected case is also important.

Inconsistent behavior during cell selection in DT datatable

I have the shiny app below in which the user clicks on a cell in the upper table and the relative cell should be displayed in the lower table. The issue is that when I unselect the cells in the upper the cells in the lower not only remain but become more.
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(
fluidRow(
DT::dataTableOutput("myDatatable"),
DT::dataTableOutput("myDatatable2")
)
)
server <- shinyServer(function(input, output, session) {
dat1 <- reactive({
matrix(iris[,5])
})
list_all <- reactiveVal(character())
observeEvent(input$myDatatable_cell_clicked, {
list_all(append(list_all(), input$myDatatable_cell_clicked$value))
})
output$myDatatable <- DT::renderDataTable(dat1(),
selection=list( target="cell"),
server = FALSE,
rownames=FALSE)
output$myDatatable2 <- DT::renderDataTable(matrix(list_all()),
selection="none",
server = FALSE,
rownames=FALSE)
})
shinyApp(ui, server)

Please try below:
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(
fluidRow(
DT::dataTableOutput("myDatatable"),
DT::dataTableOutput("myDatatable2")
)
)
server <- shinyServer(function(input, output, session) {
dat1 <- reactive({
matrix(iris[,5])
})
list_all <- reactiveVal(character())
observeEvent(input$myDatatable_cells_selected, {
if (nrow(input$myDatatable_cells_selected) == 0) {
list_all(character())
} else {
list_all(dat1()[input$myDatatable_cells_selected[,1]])
}
})
output$myDatatable <- DT::renderDataTable(dat1(),
selection=list( target="cell"),
server = FALSE,
rownames=FALSE)
output$myDatatable2 <- DT::renderDataTable(matrix(list_all()),
selection="none",
server = FALSE,
rownames=FALSE)
})
shinyApp(ui, server)
The main difference is using input$myDatatable_cells_selected which keeps the currently selected cells as opposed to input$myDatatable_cell_clicked which contains the clicked cell even when unselected, causing your issue.

Here is another version based on input$myDatatable_cells_selected using reactive over reactiveVal (should always be the preferred way in shiny) + this works for multiple columns.
library(shiny)
library(DT)
library(datasets)
ui <- shinyUI(fluidRow(
DT::dataTableOutput("myDatatable"),
DT::dataTableOutput("myDatatable2")
))
server <- shinyServer(function(input, output, session) {
dat1 <- reactive({
data.frame(iris[, 5])
})
selected <- reactive({
req(input$myDatatable_cells_selected)
selected <- input$myDatatable_cells_selected
selected[, 2] <- selected[, 2] + 1
return(selected)
})
output$myDatatable <- DT::renderDataTable(
dat1(),
selection = list(target = "cell"),
server = FALSE,
rownames = FALSE
)
output$myDatatable2 <- DT::renderDataTable(
data.frame(dat1()[selected()]),
selection = "none",
server = FALSE,
rownames = FALSE)
})
shinyApp(ui, server)

Store values based on multiple data table cell selection in a data frame

I have a shiny app with two data tables. The first one permits multiple cell selection while the 2nd one single. Every cell value should be stored inside list_all() and then displayed as a new table. The issue is that from the 1st table only the last cell selection is stored instead of every selection.
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(
fluidRow(
DT::dataTableOutput("myDatatable"),
DT::dataTableOutput("myDatatable2"),
DT::dataTableOutput("myDatatable3")
)
)
server <- shinyServer(function(input, output, session) {
output$myDatatable <- DT::renderDataTable(matrix(iris[,5]),
selection=list( target="cell"),
server = FALSE,
rownames=FALSE)
output$myDatatable2 <- DT::renderDataTable(matrix(iris[c(25,78,67,45,90,66,78,9,8),5]),
selection=list(mode="single", target="cell"),
server = FALSE,
rownames=FALSE)
list_all <- reactive({
x <- c(input$myDatatable_cell_clicked$value, input$myDatatable2_cell_clicked$value)
})
output$myDatatable3 <- DT::renderDataTable(matrix(list_all())
)
})
shinyApp(ui, server)

Something like this?
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(
fluidRow(
DTOutput("myDatatable"),
DTOutput("myDatatable2"),
DTOutput("myDatatable3")
)
)
server <- function(input, output, session) {
output$myDatatable <- renderDT(matrix(iris[,5]),
selection=list( target="cell"),
server = FALSE,
rownames=FALSE)
output$myDatatable2 <- renderDT(matrix(iris[c(25,78,67,45,90,66,78,9,8),5]),
selection=list(mode="single", target="cell"),
server = FALSE,
rownames=FALSE)
list_all <- reactiveVal(character())
observeEvent(input$myDatatable_cell_clicked, {
list_all(append(list_all(), input$myDatatable_cell_clicked$value))
})
observeEvent(input$myDatatable2_cell_clicked, {
list_all(append(list_all(), input$myDatatable2_cell_clicked$value))
})
output$myDatatable3 <- renderDT(matrix(list_all()))
}
shinyApp(ui, server)

data table disappear after editing in shiny app

I'm trying to make an editable and downloadable data table in shiny app. After I edit the table, the data table automatically disappear for some reason. This only happen when the data dat is reactive (which is necessary in my app).
Does anyone knows what is going on? Thanks a lot.
example code below:
library(shiny)
library(DT)
ui <- fluidPage(
selectInput("nrow",
"num of rows",
choices = 1:5,
selected = 3,
multiple = FALSE),
DTOutput("table")
)
server <- function(input, output){
dat = reactive({
iris[1:as.integer(input$nrow),]
})
output[["table"]] <- renderDT({
datatable(dat(), editable = "cell", extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = list(
"csv"
)
))
})
observeEvent(input[["table_cell_edit"]], {
cellinfo <- input[["table_cell_edit"]]
dat() <<- editData(dat(), input[["table_cell_edit"]], "table")
})
}
shinyApp(ui, server)

Try this:
library(shiny)
library(DT)
ui <- fluidPage(
selectInput("nrow","num of rows",choices = 1:5,selected = 3,multiple = FALSE),
DTOutput("table")
)
server <- function(input, output){
v <- reactiveValues()
observeEvent(input$nrow,{
v$dat <- iris[1:as.integer(input$nrow),]
})
output[["table"]] <- renderDT({
datatable(v$dat, editable = "cell", extensions = "Buttons", options = list(dom = "Bfrtip",buttons = list("excel")))
})
observeEvent(input[["table_cell_edit"]], {
cellinfo <- input[["table_cell_edit"]]
v$dat <<- editData(v$dat, input[["table_cell_edit"]], "table")
})
}
shinyApp(ui, server)

Is it OK like this ? A possible unwanted behavior is that the table is reset after changing the number of rows. But I don't think we can avoid that... since these are two different tables.
library(shiny)
library(DT)
ui <- fluidPage(
selectInput("nrow",
"num of rows",
choices = 1:5,
selected = 3,
multiple = FALSE),
DTOutput("table")
)
server <- function(input, output){
dat0 <- iris
dat <- reactiveVal()
observe({
dat(dat0[1:as.integer(input$nrow),])
})
output[["table"]] <- renderDT({
datatable(dat(), editable = "cell", extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = list(
"csv"
)
))
})
observeEvent(input[["table_cell_edit"]], {
cellinfo <- input[["table_cell_edit"]]
dat(editData(dat(), input[["table_cell_edit"]], "table"))
})
}
shinyApp(ui, server)

Resources