从Shiny DataTable中的单元获取价值 [英] Get value from cell in Shiny DataTable

查看:100
本文介绍了从Shiny DataTable中的单元获取价值的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我在Shiny中有此DataTable,当我单击一行时,我想从变量文本框中的第一列获取值.

I have this DataTable in Shiny and I would like to get the value from the first column in a variable textbox when I click an row.

因此在这种情况下(如屏幕截图所示),当我单击此行时,我想在现在为Error: object of type 'closure' is not subsettable的位置获取Factuur Factuur. 我设法得到行号:

So in this case as seen in the screenshot, when I click this row, I would like to get Factuur Factuur in the place where now is Error: object of type 'closure' is not subsettable. I managed to get the row number:

UI: p(verbatimTextOutput('chauffeurdetails'))

UI: p(verbatimTextOutput('chauffeurdetails'))

服务器: output$chauffeurdetails = renderText ({ chauffeurdetail = input$results_rows_selected })

Server: output$chauffeurdetails = renderText ({ chauffeurdetail = input$results_rows_selected })

任何人都认为我如何从第一列而不是仅从行号获取值?

Anyone thought how I could get the value from the first column instead of only the row number?

整个R代码:

# install packages if needed
if (!require("DT")) install.packages("DT")
if (!require("tidyr")) install.packages("tidyr")
if (!require("dplyr")) install.packages("dplyr")
if (!require("readxl")) install.packages("readxl")
if (!require("shiny")) install.packages("shiny")
if (!require("expss")) install.packages("expss")

# activate packages
library("tidyr")
library("dplyr")
library("readxl")
library("DT")
library("shiny")
library("expss")

# Lees MI bestand
MIinport <- read_excel("~/Documents/MI.xlsx", col_types = c("skip", "skip", "text", "skip", "text", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "text", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "text","skip",  "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "text","skip",  "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip", "skip"))
# Hernoem kolommen
MIinport <- unite(MIinport, KlantRef, Klant, Referentie, sep=" | ", remove = TRUE)
colnames(MIinport)<- c("Chauffeur", "Kenteken", "Klant", "ARDNK")
# Filter locatiewerk
MIinport <- subset(MIinport, is.na(MIinport$Kenteken))
MIinport$Kenteken <- NULL

DNK <- subset(MIinport, ARDNK == "DNK")
DNK$ARDNK <- NULL
AR <- subset(MIinport, ARDNK == "AR")
AR$ARDNK <- NULL

DNKfreq1 <- ftable(DNK$Chauffeur, DNK$Klant, dnn = c("Chauffeur", "Klant"))
DNKfreq2 <- as.data.frame(DNKfreq1)
DNKdata <- subset(DNKfreq2, Freq>0)
colnames(DNKdata)<- c("Chauffeur", "Klant", "Aantal")
list.DNKklanten <- as.list(unique(sort(DNKdata$Klant)))

ARfreq1 <- ftable(AR$Chauffeur, AR$Klant, dnn = c("Chauffeur", "Klant"))
ARfreq2 <- as.data.frame(ARfreq1)
ARdata <- subset(ARfreq2, Freq>0)
colnames(ARdata)<- c("Chauffeur", "Klant", "Aantal")
list.ARklanten <- as.list(unique(sort(ARdata$Klant)))

# Onderscheid studenten - FALSE = Student | TRUE = Senior
ARdata$Student <- as.numeric(grepl('[.]', ARdata$Chauffeur))
ARstudent <- subset(ARdata, Student == 0)
ARstudent$Student <- NULL
ARdata$Student <- NULL


# App
library(shiny)

ui <- basicPage(
  p (""),
  sidebarLayout(
    sidebarPanel(
      div(
      h3("Zoek instellingen"),
      uiOutput("chooselist"),
      checkboxInput("StudentOption", label = "Alleen studenten", value = FALSE),
      radioButtons("ARofDNK", label = "AR of DNK", choices = c("AR", "DNK"), selected = "AR", inline = TRUE)
    ),
    div(tags$hr(),
        h3("Chauffeur details"),
        p(textOutput('chauffeurdetails')))),

    mainPanel(
      DT::dataTableOutput("results")
    )
  )
)
server <- function(input, output, session) {
# update datatable
output$chooselist <- renderUI({ 
  if (input$ARofDNK == "AR"){
    tagList(
    selectInput("select", "Selecteer een klant", choices = c(" ", list.ARklanten))
    )
  } else {
    tagList(
    selectInput("select", "Selecteer een klant", choices = c(" ", list.DNKklanten))
    )
  }
  })
  output$value <- renderPrint({ input$ARofDNK })

  SelectedKlant <- reactive({
    if (input$StudentOption == TRUE & input$ARofDNK == "AR") {
      a <- subset(ARstudent, (ARstudent$Klant == input$select))
      return(a)
    } 
    else if (input$StudentOption == FALSE & input$ARofDNK == "AR") {
      a <- subset(ARdata, (ARdata$Klant == input$select))
      return(a)
    } else if (input$ARofDNK == "DNK"){
      a <- subset(DNKdata, (DNKdata$Klant == input$select))
      return(a)
    }
})

  output$results <- DT::renderDataTable(SelectedKlant(), options = list(pageLength = 20, dom = 'tip', order = list(2,'desc')), rownames = FALSE, width = 500, elementId = "results", colnames=c('Naam', 'Locatie', 'Aantal'), selection = 'single')

#  output$chauffeurdetails = renderText ({
#    SelectedKlant()[input$results_rows_selected,1]
#  })

  output$chauffeurdetails = renderText ({
    req(length(input$results_rows_selected)>0)
    SelectedKlant()[input$results_rows_selected,1]
  })  

# output$chauffeurdetails = renderText ({
#     chauffeurdetail = input$results_rows_selected
# })

  session$onSessionEnded(function() {
    stopApp()
  })
  session$on

  }

# Run the application 
shinyApp(ui = ui, server = server, options = list(launch.browser=TRUE))

示例数据:https://www .dropbox.com/s/zjxusxcan0ps1s3/Input%20Test.xlsx?dl = 0 这些数据包含对隐私敏感的信息,因此我创建了一个小的替换项.

Example data: https://www.dropbox.com/s/zjxusxcan0ps1s3/Input%20Test.xlsx?dl=0 Those data contains privacy sensitive information, so I created a small replacement.

推荐答案

output$chauffeurdetails = renderText ({ SelectedKlant()[input$results_rows_selected,1] })

output$chauffeurdetails = renderText ({ SelectedKlant()[input$results_rows_selected,1] })

应该解决它.

您的最后一个问题是经典的stringAsFactor,并且第一列是一个因素,因此我们需要使用as.character()

Your last problem was the classic stringAsFactor and that the first column was a factor and there for we need to convert it to character with as.character()

这是服务器代码的有效版本

here is a working version of the server code

server <- function(input, output, session) {
  # update datatable
  output$chooselist <- renderUI({ 
    if (input$ARofDNK == "AR"){
      tagList(
        selectInput("select", "Selecteer een klant", choices = c(" ", list.ARklanten))
      )
    } else {
      tagList(
        selectInput("select", "Selecteer een klant", choices = c(" ", list.DNKklanten))
      )
    }
  })
  output$value <- renderPrint({ input$ARofDNK })

  SelectedKlant <- reactive({
    if (input$StudentOption == TRUE & input$ARofDNK == "AR") {
      a <- subset(ARstudent, (ARstudent$Klant == input$select))
      return(a)
    } 
    else if (input$StudentOption == FALSE & input$ARofDNK == "AR") {
      a <- subset(ARdata, (ARdata$Klant == input$select))
      return(a)
    } else if (input$ARofDNK == "DNK"){
      a <- subset(DNKdata, (DNKdata$Klant == input$select))
      return(a)
    }
  })

  output$results <- DT::renderDataTable(SelectedKlant(), options = list(pageLength = 20, dom = 'tip', order = list(2,'desc')), rownames = TRUE, width = 500, elementId = "results", colnames=c('Naam', 'Locatie', 'Aantal'), selection = 'single')

  #  output$chauffeurdetails = renderText ({
  #    SelectedKlant()[input$results_rows_selected,1]
  #  })

  output$chauffeurdetails = renderText ({
    req(length(input$results_rows_selected)>0)
    as.character(SelectedKlant()[input$results_rows_selected,1])
  })  

  # output$chauffeurdetails = renderText ({
  #     chauffeurdetail = input$results_rows_selected
  # })

  session$onSessionEnded(function() {
    stopApp()
  })
  session$on

}

希望这会有所帮助!

这篇关于从Shiny DataTable中的单元获取价值的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆