1

我在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 个表格，所以这将是疯狂的代码（我知道），我想必须有一个优雅的解决方案。代码>

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"))
    ))))

服务器.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中实现。

4

1 回答 1

0

[[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”。我还必须更改一些已弃用的闪亮语句。

于 2021-02-07T12:36:03.507 回答