如何从R Shiny App

时间:2017-06-26 09:15:09

标签: javascript r shiny shinydashboard dt

我需要从DT数据表中获取所选行的第1列值。使用 DataTable_rows_selected ,我能够获得所选的行数,现在我正在寻找从数据表中提取行值的方法。在下面的示例中,有两个 observeEvent 基于操作按钮,第一个观察事件是导入并显示数据,第二个需要显示所选行的第一个col值,这样我就可以使用相同的实现其他特性。请注意,在实际应用程序中,导入的数据是一个Web服务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)

2 个答案:

答案 0 :(得分:3)

如果您正在寻找,请查看以下代码:

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之外并放入{{1 }}

<强> [UPDATE]

我使用reactive语句导入数据而不是if

observeEvent

答案 1 :(得分:0)

从数据表中获取行值的另一种方法是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)