1

入力 ID/名前に基づいて、選択したデータフレームからいくつかの列を表示するRの光沢のあるパッケージに小さなアプリを作成しました。私のダミーデータは次のようになります(以下のコード):

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 は、ID4 およびクライアントと同様に、ID ごとに複数のレコードを持つことができますが、同じ ID4 またはクライアントを持つ複数のレコードが異なる ID1 を持つことはできないことに注意してください。理想的には、ID1 または ID4 に基づいてサーバー側でデータを操作したいと考えています (他のレコードは両方に一致する可能性があります)。

そのため、6 つの入力、ID 用の 4 つの数値入力、およびクライアント名 (リストとテキスト入力) 用のテキスト入力用に 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または他の入力に存在するかどうかを実際に1つの関数で作成し、ID1以外の入力でのみそれらをID4にマップし、次に別の関数でID1の入力がない限り、ID4による出力テーブルを作成するにはどうすればよいですか。 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)

selectInput特記事項: は常に有効な値を返し、常に「client」に切り札になるため、「client」と「clientN」を切り替える必要がありました。また、廃止されたいくつかの輝かしいステートメントを変更する必要がありました。

于 2021-02-07T12:36:03.507 に答える