Shiny Error: replacement has 2 rows, data has 1

Question

我正在尝试创建一个 Shiny 应用程序，用户可以在其中 select 下拉框中的“选项”（使用 selectInput 创建），Shiny 将显示数据 table 相应地。现在，我有部分用户可以在每次观察时单击 link，它会直接 link 到网站找出答案，但当用户 [=20] 时我似乎无法让它工作=] “全部”以外的选项。基本上，当我 select 选项“AZ”或“NC”时，它引发了这个错误“替换有 2 行，数据有 1”。请看图片，您可能会明白我的意思。 Data table with "All" option selected, no error Data table when "AZ" is selected, incurred error

感谢您的帮助！

这是可重现的代码。

# load packages
library(shiny)

# Create a sample df
names <- c("Mister Car Wash", "Driven Brands Car Wash")
city <- c("Tucson", "Charlotte")
state <- c("AZ", "NC")
locations <- c("350 locations", "300 locations")
website <- c("www.mistercarwash.com", "www.drivenbrandscarwash.com")
car_df <- data.frame(names, city, state, locations, website)

# # create the ui

ui <- fluidPage(
  titlePanel("Top 99 Car Wash Chains in the U.S."),
  sidebarLayout(
    sidebarPanel(
      selectInput(
        inputId ="statenames",
        label = "Select the State:",
        choices = c("All", "AZ", "NC"),
        selected = "All") # default value
    ),
    mainPanel(
      width=9,
      DT::dataTableOutput('table')
    )
  )
)

# create the server
server <- function(input, output) {
  output$table <- renderDT({
      data <- car_df
      if (input$statenames != "All") {
        data <- data[car_df$state == input$statenames,]
      } else{ 
        (input$statenames == car_df$State)
        
      }
      #add html link tags
      data$Website <- paste0("<a href='//", car_df$website,"'>",car_df$website,"</a>")
      
      datatable(data, extensions = 'Buttons', rownames = FALSE, escape = FALSE, selection = 'none',
                colnames = c('names', 'city', 'state', 'locations','website'),
                options = list(buttons = c("copy", "csv", "excel"), paging = FALSE, dom = 'Bfrtip')
      )
    
    })
      

    
}
  

# Call shinyapp
shinyApp(ui=ui, server=server)

Answer 1

罪魁祸首是你的陈述

data$Website <- paste0("<a href='//", car_df$website,"'>",car_df$website,"</a>")

如您所知，当您 select 一个状态时，data 只有一个记录。但是，car_df 有 2 条记录。

试试这个

output$table <- renderDT({
    req(input$statenames)
    data <- car_df
    if (input$statenames != "All") {
      data <- data[car_df$state == input$statenames,]
      data$Website <- paste0("<a href='//", data$website,"'>",data$website,"</a>")
    } else{ 
      #(input$statenames == car_df$State)
      data$Website <- paste0("<a href='//", car_df$website,"'>",car_df$website,"</a>")
    }
    #add html link tags
    #data$Website <- paste0("<a href='//", car_df$website,"'>",car_df$website,"</a>")
    
    
    datatable(data, extensions = 'Buttons', rownames = FALSE, escape = FALSE, selection = 'none',
              colnames = c('names', 'city', 'state', 'locations','website'),
              options = list(buttons = c("copy", "csv", "excel"), paging = FALSE, dom = 'Bfrtip')
    )
    
  })