Rのユーザー入力を使用してデータテーブルの出力が光沢を帯びて

Question

私はユーザーが特定の入力を選択できるようにするアプリケーションに取り組んでいます。この場合、アプリはさまざまなオプションから選択する2つのselectizeInputオプションを提供します。

次のデータセットです。server.R

library(shiny) 
trim.leading <- function (x) sub("^\\s+", "", x) 

uniqueValues <- function(x){ 
values <- c() 
s <- (unlist(strsplit(x, ",", fixed = TRUE))) 
v <- trim.leading(s) 
}  

geog <- c() 
geog <- unique(unlist(c(geog, sapply(data_set$Region, uniqueValues)))) 


shinyServer(function(input, output, session) { 

    updateSelectizeInput(session, 'country', choices = unique(data_set$Country), server = TRUE) 
    updateSelectizeInput(session, 'geogPref', choices = geog, server = TRUE) 

    country <- reactive({ 
    c <- c() 
    c <- c(c, input$country) 
    }) 


    dataset <- reactive({ 
    data <- data_set 
    if (input$country){ 
     data$c1 <- grepl(paste(country(), collapse = "|"), data$Country) 
    } 
    else { 
     data$c1 <- TRUE 
    } 

    if (input$geogPref){ 
     data$c2 <- grepl(input$geogPref, data$Region) 
    } 
    else { 
     data$c2 <- TRUE 
    } 


    data <- data[which(data$c1 == TRUE & data$c2 == TRUE),c("Name", "Contact", "ContactPerson")] 

    return (data) 

    }) 

    output$results <- DT::renderDataTable(
    DT::datatable(unique(dataset()), 
        rownames = FALSE, options = list(searchable = FALSE) 
    ) 

}) 

で

data_test = data.frame(Name = c ("ABC","ABC","ABC","DEF","DEF", "XYZ", "XYZ", "PQR"), 
      Country = c("US, Japan","US, Japan","US, Japan","Canada, US","Canada, US", "UK, US", "UK, US", "Germany"), 
      Region = c("North America, Asia","North America, Asia","North America, Asia","North America","North America", "Europe, North America", "Europe, North America", "Europe"), 
      Contact = c(1234,1234,1234,7578,7578,9898,9898,7660), 
      ContactPerson = c("Geoff","Mary","Mike","Don","Sean","Jessica","Justin","John")) 

ui.R

で

dashboardPage(skin = "blue", 
    dashboardHeader(title = 'My APP'), 

    dashboardSidebar(
    sidebarMenu(
     menuItem("Profiles", tabName = "profiles", icon=icon("user")), 
     menuItem("Search", tabName = "search", icon=icon("search")), 
     menuItem("About App", tabName="about", icon = icon("info")) 
    ) 
), 
    dashboardBody(
    tabItems(
      tabItem(tabName ="profiles", 
        tabBox(title = "", 
          width = 12, id = "tabset1", height = "850px", 
        tabPanel("People", 
          fluidRow(
          box(title = "Filters", solidHeader = TRUE, 
           background = "blue" , collapsible = TRUE, width = 12, 
            fluidRow(
            column(4,selectizeInput("country",label="Country",choices= NULL, multiple = TRUE)), 
            column(4,selectizeInput("geogPref",label="Region",choices= NULL, multiple = TRUE)) 
             ) 
          ) 
          ), 
          box(title = "Filtered Results", 
           collapsible = TRUE, status = "success", 
           width = 12, DT::dataTableOutput('results')) 
          ), 
        tabPanel("Details", 
          fluidRow(
            box(width = 4, background = "blue", 
             collapsible = TRUE, solidHeader = TRUE) 
            ) 
          ) 
         ) 
        ), 
      tabItem(tabName ="search", 
        titlePanel("Search"), 

        fluidRow(
          ) 
        ), 
      tabItem(tabName="about", 
        titlePanel("About APP"), 
        HTML("This is an app.") 
        ) 
      ) 
    ) 
) 

したがって、ユーザーの選択に基づいて、私はフィルタリングする必要がありますこれらの文字列をすべて含む行を取り出し、関連する行のみを使用して表を更新します。私はフィルタでテーブルを更新することができません。このコードで、このエラーが発生します。

Error in if: argument is of length zero 
Stack trace (innermost first): 
    96: <reactive:dataset> [D:\shinyapps\myapp/server.R#21] 
    85: dataset 
    84: unique 
    83: DT::datatable 
    82: exprFunc 

私が間違っていることを助けてくれる人はいますか？

Answer 1

あなたは、サーバーのコードを簡素化することができます。

shinyServer(function(input, output, session) { 

     updateSelectizeInput(session, 'country', choices = unique(data_set$Country), server = TRUE) 
     updateSelectizeInput(session, 'geogPref', choices = geog, server = TRUE) 

     dataset <- reactive({ 
     data <- data_set 
     if (length(input$country)){ 
      data$c1 <- grepl(paste(input$country, collapse = "|"), data$Country) 
     } 
     else { 
      data$c1 <- TRUE 
     } 

     if (length(input$geogPref)){ 
      data$c2 <- grepl(paste(input$geogPref, collapse = "|"), data$Region) 
     } 
     else { 
      data$c2 <- TRUE 
     } 

     data[data$c1 & data$c2 ,c("Name", "Contact", "ContactPerson")] 
     }) 

     output$results <- DT::renderDataTable(
     DT::datatable(dataset(), 
         rownames = FALSE, options = list(searchable = FALSE) 
     )) 
    })