Question

我在 R 的闪亮包中构建了一个小应用程序，它根据输入的ID /名称显示所选数据框中的一些列。我的虚拟数据看起来像这样（下面的代码）：

ID1 ID2 ID3 ID4  Client Amount
1   NA  333 3344 John   100
1   88  NA  3344 John   200
1   86  777 8888 Mike   300
3   66  987 4545 Dyke   400
4   11  123 3636 Vike   500

请注意，ID1每个ID可能有多个记录，ID4和Client也可能有多个记录，但具有相同ID4或Client的多个记录不能具有不同的ID1。理想情况下，我想根据ID1或ID4操作服务器端的数据（其他记录可以与两者匹配）。

所以我构建了6个输入，4个数字输入用于ID，2个用于客户端名称（列表和文本输入）的文本输入，并且想要执行以下操作：

如果ID1没有输入，则按顺序取最后一个输入（例如，如果有客户端文本输入，客户端列表，ID2和ID3选择ID3），并将其与ID4匹配，除非其ID4。

然后如果有基于ID1输入的ID1输出表的输入，并且如果没有ID1的输入则输出基于ID4的表。

我唯一的解决方案是“暴力破解”它，因为我是编程新手，但因为我想要显示20个表，这将是疯狂的代码（我知道），我想必须有一个优雅的解决方案。代码＆GT;

ui.R：

#ui.R
library(shiny)
dataset = data.frame(ID1 = c(1,1,1,3,4), ID2 = c(NA,88,86,66,11), ID3 = 
c(333,NA,777,987,123), ID4= c(3344,3344,8888,4545, 3636), Client = c("John", 
"John", "Mike", "Dyke", "Vike"), Amount = c(100,200,300,400,500))

shinyUI(bootstrapPage(

headerPanel("Tabsets"),
sidebarPanel(
textInput('clientN', 'Client Name'),
selectInput('client', 'Client', c('None','John','Mike', 'Dyke', 'Vike')),
numericInput('id2', 'ID 2'),
numericInput('id3', 'ID 3'),
numericInput('id4', 'ID 4'),
numericInput('id1', 'ID 1')
),
mainPanel(
tabsetPanel(
tabPanel("1", tableOutput("tableA")),
tabPanel("2", tableOutput("tableA"))
))))

server.R

#server.R
library(shiny)
dataset = data.frame(ID1 = c(1,1,1,3,4), ID2 = c(NA,88,86,66,11), ID3 =
c(333,NA,777,987,123), ID4= c(3344,3344,8888,4545, 3636), Client = 
c("John", "John", "Mike", "Dyke", "Vike"), Amount = c(100,200,300,400,500))

shinyServer(function(input, output) {

select <- reactiveTable(function() {
sel <- 0
if (input$clientN != NA)
sel <- 1
if (input$client != 'None')
sel <- 2
if (input$id2 > 0)
sel <- 3
if (input$id3 > 0)
sel <- 4
if (input$id3 > 0)
sel <- 5
if (input$id1 > 0)
sel <- 6
sel

})

output$tableA <- reactiveTable(function() {
if(select == 0)
table <- dataset

if(select == 1)
table = dataset[dataset$Client == input$clientN, c('Client','Amount')]

if(select == 2)
table = dataset[dataset$Client == input$client, c('Client','Amount')]

if(select == 3)
table = dataset[dataset$ID2 == input$id2, c('Client','Amount')]

if(select == 4)
table = dataset[dataset$ID3 == input$id3, c('Client','Amount')]

if(select == 5)
table = dataset[dataset$ID4 == input$id4, c('Client','Amount')]

if(select == 6)
table = dataset[dataset$ID1 == input$id1, c('Client','Amount')]

table
})
})

但是我如何实际在一个函数中创建输入是否存在于ID1或其他输入中，并且如果仅在ID1以外的输入中将它们映射到ID4，然后在ID4中的另一个函数输出表中，除非有ID1输入哪个案例输出表由ID1？

我认为这也是一般的编程问题，而不是特定于语言或特定于包的问题，所以如果你能解释一下，我可以在 R 中实现。

Answer 1

当您分别通过 [[inputId]] 和 [["column"]] 访问输入小部件和数据框列时，您可以执行类似的操作。

示例应用的注释应该解释会发生什么。

# https://stackoverflow.com/questions/15532049/select-appropriate-columns-from-table-based-on-multiple-input

#ui.R
library(shiny)

dataset = data.frame(ID1 = c(1,1,1,3,4), ID2 = c(NA,88,86,66,11),
                     ID3 = c(333,NA,777,987,123), ID4 = c(3344,3344,8888,4545, 3636),
                     Client = c("John", "John", "Mike", "Dyke", "Vike"),
                     Amount = c(100,200,300,400,500))

ui <- shinyUI(fluidPage(

  headerPanel("Tabsets"),
  sidebarPanel(
    textInput('clientN', 'Client Name'),
    selectInput('client', 'Client', c(unique(dataset[["Client"]])), ""),
    numericInput('id2', 'ID 2', 0, min = 0),
    numericInput('id3', 'ID 3', 0, min = 0),
    numericInput('id4', 'ID 4', 0, min = 0),
    numericInput('id1', 'ID 1', 0, min = 0, max = max(dataset[["ID1"]]))
  ),
  mainPanel(
    tabsetPanel(
      tabPanel("1", tableOutput("tableA"))#,
      #tabPanel("2", tableOutput("tableB"))
    ))
))


#server.R
server <- function(input, output, session) {
  IsInputValid <- function(inputId) {
    Value <- input[[inputId]]
    # Sort out values with no (valid = truthy) value
    if (!isTruthy(Value)) return(FALSE)

    # Verify if value makes sense
    if (is.numeric(Value))
      return( Value > 0 )
    else if (is.character(Value))
      return( Value %in% trimws(dataset[["Client"]]) )
  }

  # Returns a list that contains the selectors needed to create the needed subset of `dataset`
  # The two vectors ant the top define the names of the input widgets `InpOrder` and the
  # columns of `dataset` that these inputs shall be mapped to.
  # You can use arbitrary vectors for different tables
  select <- reactive({
    ColumnMap <- c("Client", "Client", "ID2", "ID3", "ID4", "ID1")
    InpOrder  <- c("client", "clientN", "id2", "id3", "id4", "id1")

    # Loop through all the input elements specified in `InpOrder` and find out if they
    # have a meaningful value. `Index` is `TRUE`/`FALSE` after this operation.
    Index <- vapply(InpOrder, IsInputValid, logical(1))
    # Determine the last input element with the highest index in `InpOrder`. 
    Index <- as.integer(Index) * 1:length(InpOrder)

    if (sum(Index) == 0)
      return(NULL)
    else
      return(list(value = InpOrder[max(Index)], column = ColumnMap[max(Index)]))
  })

  # Render `dataset`
  output$tableA <- renderTable({
    # use complete data set if there is no valid selector
    if (!isTruthy(select())) return(dataset)

    # Select the proper subset
    table <- dataset[dataset[[select()$column]] == input[[select()$value]], c('Client','Amount')]
    # Remove rows that are all `NA`
    table <-  table[rowSums(is.na(table[ , 0:ncol(table)])) < ncol(table), ]

    return(table)
  })
}

shinyApp(ui, server)

特别说明：我必须切换“client”和“clientN”，因为 selectInput 总是返回一个有效值并且总是胜过“client”。我还必须更改一些已被弃用的闪亮语句。

根据多个输入从表中选择适当的列

1 个答案: