Как получить значения строки из выбранной строки в таблице данных в приложении R Shiny

Мне нужно получить выбранное значение 1-го столбца строки из таблицы данных DT. Используя DataTable_rows_selected, я могу получить выбранное количество строк. Теперь я ищу способы извлечь значения строк из таблицы данных. В приведенном ниже примере есть два события ObservationEvent на основе кнопки действия, первое событие наблюдения - это импорт и отображение данных, а второе событие должно отображать значение 1-го столбца выбранной строки, чтобы я мог использовать то же достижение. Другие особенности. Обратите внимание: в Actual Application импортированные данные представляют собой API веб-службы, которые я анализирую в R и конвертирую во фрейм данных.

Пример примера:

library(shiny)
library(shinydashboard)
library(DT)

ui <- dashboardPage(
dashboardHeader(title = "Data Table Example"),
dashboardSidebar(
sidebarMenu(
  menuItem('Tabs', tabName='tabs',
           menuSubItem('Tab 1', tabName='tab1'),
           menuSubItem('Tab 2', tabName='tab2')
  )
)
),

dashboardBody(

tabItems(
  tabItem(tabName='tab1',
          actionButton("import","Import"),
          br(),
          tags$div(tags$h3(tags$b(" Get Selected Row Values",align="middle",style="color: rgb(57,156,8)"))),
          br(),
          DT::dataTableOutput('ProductDataTable')
  ),
  tabItem(tabName='tab2',
          actionButton("display","Display"),
          uiOutput('info')
   )
 )
 )
 )

server <- function(input, output) {

observeEvent(input$import,{

Product <- read.csv2("RulesData.csv", header=TRUE, sep=";")

output$ProductDataTable <- DT::renderDataTable({

DT::datatable(Product,selection = "single",

                extensions = c('Buttons', 'ColReorder', 'FixedHeader', 'Scroller'),
                rownames=FALSE,
                options=list(dom = 'Bfrtip',
                             searching = T,
                             pageLength = 25,
                             searchHighlight = TRUE,
                             colReorder = TRUE,
                             fixedHeader = TRUE,
                             filter = 'bottom',
                             buttons = c('copy', 'csv','excel', 'print'),
                             paging    = TRUE,
                             deferRender = TRUE,
                             scroller = TRUE,
                             scrollX = TRUE,
                             scrollY = 700

                ))
})

})

observeEvent(input$display,{

row_count <- input$ProductDataTable_rows_selected

output$info <- renderPrint({

  cat('Row Selected: ')
  cat(row_count, sep = ', ')
  cat(Product[1,2], sep = ', ')


 })

})
}

shinyApp(ui, server)

person string    schedule 26.06.2017    source источник


Ответы (2)


проверьте этот код ниже, если это то, что вы ищете:

library(shiny)
library(shinydashboard)
library(DT)

ui <- dashboardPage(
  dashboardHeader(title = "Data Table Example"),
  dashboardSidebar(
    sidebarMenu(
      menuItem('Tabs', tabName='tabs',
               menuSubItem('Tab 1', tabName='tab1'),
               menuSubItem('Tab 2', tabName='tab2')
      )
    )
  ),

  dashboardBody(

    tabItems(
      tabItem(tabName='tab1',
              actionButton("import","Import"),
              br(),
              tags$div(tags$h3(tags$b(" Get Selected Row Values",align="middle",style="color: rgb(57,156,8)"))),
              br(),
              DT::dataTableOutput('ProductDataTable')
      ),
      tabItem(tabName='tab2',
              actionButton("display","Display"),
              uiOutput('info')
      )
    )
  )
)

server <- function(input, output) {

  Product <- reactive({mtcars})

  observeEvent(input$import,{


    output$ProductDataTable <- DT::renderDataTable({

      DT::datatable(Product(),selection = "single",

                    extensions = c('Buttons', 'ColReorder', 'FixedHeader', 'Scroller'),
                    rownames=FALSE,
                    options=list(dom = 'Bfrtip',
                                 searching = T,
                                 pageLength = 25,
                                 searchHighlight = TRUE,
                                 colReorder = TRUE,
                                 fixedHeader = TRUE,
                                 filter = 'bottom',
                                 buttons = c('copy', 'csv','excel', 'print'),
                                 paging    = TRUE,
                                 deferRender = TRUE,
                                 scroller = TRUE,
                                 scrollX = TRUE,
                                 scrollY = 700

                    ))
    })

  })

  observeEvent(input$display,{


    output$info <- renderPrint({
      row_count <- input$ProductDataTable_rows_selected
      data <- Product()[row_count, ] 
      cat('Row Selected: ')
      cat(data[,1]) #display the selected row 1st col value  


    })

  })
}

shinyApp(ui, server)

Я использовал набор данных mtcars в качестве примера, проблема заключалась в том, что ваши данные находились внутри observer (один с input$import) и, поскольку вам нужно использовать его для другого анализа, такого как отображение значения строки первого столбца (я не понял ну, что Вы имели в виду, поскольку Ваш код говорит о другом) данные должны были быть перемещены за пределы observer и помещены в reactive.

[ОБНОВЛЕНИЕ]

Я использовал оператор if для импорта данных вместо observeEvent

library(shiny)
library(shinydashboard)
library(DT)

ui <- dashboardPage(
  dashboardHeader(title = "Data Table Example"),
  dashboardSidebar(
    sidebarMenu(
      menuItem('Tabs', tabName='tabs',
               menuSubItem('Tab 1', tabName='tab1'),
               menuSubItem('Tab 2', tabName='tab2')
      )
    )
  ),

  dashboardBody(

    tabItems(
      tabItem(tabName='tab1',
              actionButton("import","Import"),
              br(),
              tags$div(tags$h3(tags$b(" Get Selected Row Values",align="middle",style="color: rgb(57,156,8)"))),
              br(),
              DT::dataTableOutput('ProductDataTable')
      ),
      tabItem(tabName='tab2',
              actionButton("display","Display"),
              uiOutput('info')
      )
    )
  )
)

server <- function(input, output) {

  Product <- reactive({
    if(input$import == 0)
  {
    return()
  }
    isolate({
      input$import
      data <- mtcars # Here read Your data: read.csv2("RulesData.csv", header=TRUE, sep=";")
      })
  })


    output$ProductDataTable <- DT::renderDataTable({

      DT::datatable(Product(),selection = "single",

                    extensions = c('Buttons', 'ColReorder', 'FixedHeader', 'Scroller'),
                    rownames=FALSE,
                    options=list(dom = 'Bfrtip',
                                 searching = T,
                                 pageLength = 25,
                                 searchHighlight = TRUE,
                                 colReorder = TRUE,
                                 fixedHeader = TRUE,
                                 filter = 'bottom',
                                 buttons = c('copy', 'csv','excel', 'print'),
                                 paging    = TRUE,
                                 deferRender = TRUE,
                                 scroller = TRUE,
                                 scrollX = TRUE,
                                 scrollY = 700

                    ))
    })


  observeEvent(input$display,{


    output$info <- renderPrint({
      row_count <- input$ProductDataTable_rows_selected
      data <- Product()[row_count, ] 
      cat('Row Selected: ')
      cat(data[,1]) #display the selected row 1st col value  


    })

  })
}

shinyApp(ui, server)
person Mal_a    schedule 26.06.2017
comment
Спасибо за ответ. Основываясь на событии наблюдения, мне нужно импортировать данные, поскольку мне нужно получить данные из API веб-службы на основе триггера кнопки действия. Я не могу взять свои данные за пределы и сделать их реактивными, так как это добавит накладные расходы на блестящую производительность приложения в самом начале. Я ищу некоторую опцию обратного вызова в самой таблице данных, чтобы зафиксировать значение col выбранной строки. - person string; 26.06.2017
comment
Подождите секунду, я обновлю ответ, у меня есть идея получше, чем использовать observerEvent - person Mal_a; 26.06.2017
comment
Проверьте это, я использовал оператор if для импорта данных, который будет работать точно так же, как observeEvent - ›запускать импорт данных после нажатия кнопки - person Mal_a; 26.06.2017
comment
Спасибо, что предложили альтернативный способ. Я попробую эту часть в реальном приложении и вернусь к вам. На данный момент это кажется одним из вариантов. - person string; 26.06.2017

Еще один способ получить значения строк из таблицы данных - это DT: DataTable вариант обратного вызова в сочетании с Java Script JS ().

Вот код:

library(shiny)
library(shinydashboard)
library(DT)

ui <- dashboardPage(
dashboardHeader(title = "Data Table Example"),
dashboardSidebar(
sidebarMenu(
  menuItem('Tabs', tabName='tabs',
           menuSubItem('Tab 1', tabName='tab1'),
           menuSubItem('Tab 2', tabName='tab2')
  )
)
),

dashboardBody(

tabItems(
  tabItem(tabName='tab1',
          actionButton("import","Import"),
          br(),
          tags$div(tags$h3(tags$b("Get Selected Row Values",style="color: rgb(57,156,8)"))),
          br(),
          DT::dataTableOutput('ProductDataTable')
  ),
  tabItem(tabName='tab2',
          actionButton("display","Display"),
          uiOutput('info')
  )
)
)
)

server <- function(input, output) {

observeEvent(input$import,{

Product <- mtcars

output$ProductDataTable <- DT::renderDataTable({

  DT::datatable(Product,selection = "single",
  # JS using call back function to get the row values on single click
                callback = JS("table.on('click.dt', 'tr',
                  function() {
                  Shiny.onInputChange('rows', table.rows(this).data().toArray());
                  });"),

                extensions = c('Buttons', 'ColReorder', 'FixedHeader', 'Scroller'),
                rownames=FALSE,
                options=list(dom = 'Bfrtip',
                             searching = T,
                             pageLength = 25,
                             searchHighlight = TRUE,
                             colReorder = TRUE,
                             fixedHeader = TRUE,
                             filter = 'bottom',
                             buttons = c('copy', 'csv','excel', 'print'),
                             paging    = TRUE,
                             deferRender = TRUE,
                             scroller = TRUE,
                             scrollX = TRUE,
                             scrollY = 700

                ))
})

})

observeEvent(input$display,{

row_count <- input$ProductDataTable_rows_selected

output$info <- renderPrint({
  cat('Row Selected 1st Col Value: ')
  # getting 1st row col value
  cat(input$rows[1], sep = ', ')

})

})
}

shinyApp(ui, server)
person string    schedule 30.06.2017