从 Shiny DataTable 中的单元格获取值
Posted
技术标签:
【中文标题】从 Shiny DataTable 中的单元格获取值【英文标题】:Get value from cell in Shiny DataTable 【发布时间】:2018-05-30 11:45:16 【问题描述】:我在 Shiny 中有这个 DataTable,当我单击一行时,我想从变量文本框中的第一列中获取值。
所以在这种情况下,如屏幕截图所示,当我点击这一行时,我想在现在是Error: object of type 'closure' is not subsettable
的地方得到Factuur Factuur
。
我设法得到了行号:
用户界面:
p(verbatimTextOutput('chauffeurdetails'))
服务器:
output$chauffeurdetails = renderText ( chauffeurdetail = input$results_rows_selected )
有人想过我如何从第一列而不是仅从行号获取值吗?
整个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 这些数据包含隐私敏感信息,所以我创建了一个小的替代品。
【问题讨论】:
你能贴出给出错误的代码吗? @SBista 上面的代码正在运行并显示行号。 @SBista 我添加了整个闪亮的代码 假设ARstudent
是您的数据集,您可以尝试 ARstudent[input$results_rows_selected,1]
@SBista,当我将此服务器部分更改为 output$chauffeurdetails = renderText ( SelectedKlant[input$results_rows_selected,1] ) 我在屏幕截图中收到该错误(SelectedKlant = 我的数据表的数据框)
【参考方案1】:
output$chauffeurdetails = renderText (
SelectedKlant()[input$results_rows_selected,1]
)
应该解决它。
您的最后一个问题是经典的 stringAsFactor
并且第一列是一个因素,因此我们需要将其转换为带有 as.character()
的字符
这是服务器代码的工作版本
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
希望这会有所帮助!
【讨论】:
现在,我得到了一个随机数。除了你的调整,我把 UI 里的verbatimTextOutput
改成了TextOutput
,否则根本就不行。有什么想法吗?
嗨@George 我添加了一个工作示例。如果这对您不起作用,我们需要更多信息,最好是您正在使用的一些示例数据。我的小样本应该足够了。
@Berlin Baron,我试过了,但不幸的是,我仍然收到一个数字作为反应。应要求,我在起始帖子上发布了一个示例文档。我希望你能重现我所看到的。我还删除了整个代码,这有助于您理解。
@George 我已经修复它 - 这是一个经典的 strinAsFactor
问题以上是关于从 Shiny DataTable 中的单元格获取值的主要内容,如果未能解决你的问题,请参考以下文章
C#OPEN XML:从EXCEL向DATATABLE获取数据时,空单元格被跳过