Подмножество таблицы данных на основе выбора ячейки другого источника данных - PullRequest
Новая
       6

Подмножество таблицы данных на основе выбора ячейки другого источника данных

0 голосов
/ 30 октября 2019

У меня блестящее приложение с 3 таблицами данных. Первая содержит только 5-ю строку с Species, во 2-й таблице содержится случайная Species, а третья таблица должна получить выбранные ячейки из первых 2-х таблиц и объединить их в новую таблицу. В то время как первый, кажется, работает нормально, второй выбор таблицы, кажется, неправильный, и это происходит потому, что он задает подстановку по ячейке, а не по значению ячейки. 

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)

1 Ответ

2 голосов
/ 30 октября 2019

См. Код ниже. Вы пытались установить подмножество данных по сравнению с созданием нового кадра данных (который сверху звучит как то, что вы хотите) + вы хотите использовать [tablename]_cell_clicked, у которого есть список row, column, value против [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)

** Обновлено на основании разъяснений ОП 

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