R Shiny 错误：警告：$ 中的错误：“闭包”类型的对象不是子集

Question

我正在使用以下代码，除非我运行该行，否则我总是会收到此子集错误

df <- read.csv("./world-happiness-report-cleaned.csv") 在运行应用程序之前手动操作。我在设置什么子集，我错在哪里？我似乎找不到错误，而且我对 Shiny 非常陌生，所以我以前从未处理过这个问题。非常感谢！！

此链接指向包含我使用的 csv 的文件箱：https://filebin.net/wjctohctz1sxm16y

服务器.R

# Elit Jasmine Dogu, ejd5mm
# Project One DS 3002
library(dplyr)
library(countrycode)
library(shiny)
df <- read.csv("./world-happiness-report-cleaned.csv")

    #saveRDS(df, "./df.RDS")
server <- function(input, output) {
    #reading in the data and basic data cleaning 
    #df<- read.csv("world-happiness-report-cleaned.csv")
    #df <<- readRDS("./df.RDS")
    #df <- read.csv("./world-happiness-report-cleaned.csv")
    
    # Filter data based on user selections
    output$table <- DT::renderDataTable(DT::datatable({
        data <- df %>%
            filter(
                if(input$year != "All") {
                    Year ==input$year
                } else {TRUE}
            ) %>%
            filter(
                if(input$country != "All") {
                    Country ==input$country
                } else {TRUE}
            ) %>%
            filter(
                if(input$continent != "All") {
                    Continent ==input$continent
                } else {TRUE}
            )
        
        return(data)
        
    }))
        # Generate a summary of the dataset (on the left panel)
        output$summary <- renderPrint({
            data <- df %>%
                filter(
                    if(input$year != "All") {
                        Year ==input$year
                    } else {TRUE}
                ) %>%
                filter(
                    if(input$country != "All") {
                        Country ==input$country
                    } else {TRUE}
                ) %>%
                filter(
                    if(input$continent != "All") {
                        Continent ==input$continent
                    } else {TRUE}
                )
            
            return(summary(data))
            
        })
    
       #Generate a function to show the number of rows w/ any given dataframe selection/restriction
    rows = function() {
        data <- df %>%
            filter(
                if(input$year != "All") {
                    Year ==input$year
                } else {TRUE}
            ) %>%
            filter(
                if(input$country != "All") {
                    Country ==input$country
                } else {TRUE}
            ) %>%
            filter(
                if(input$continent != "All") {
                    Continent ==input$continent
                } else {TRUE}
            )
        
        return(nrow(data)) #returns number of rows of the data
    }
    
    #Generate a function to show the number of columns w/ any given dataframe selection/restriction
    cols = function() {
        data <- df %>%
            filter(
                if(input$year != "All") {
                    Year ==input$year
                } else {TRUE}
            ) %>%
            filter(
                if(input$country != "All") {
                    Country ==input$country
                } else {TRUE}
            ) %>%
            filter(
                if(input$continent != "All") {
                    Continent ==input$continent
                } else {TRUE}
            )
        
        return(ncol(data)) #returns the number of columns of the data
    }

    #Using the functions created above
        output$columns  <- renderText({
            paste("Number of Columns:" , cols() ) #text to display the number of columns
        })
        output$rows  <- renderText({
            paste("Number of Rows (Records):" , rows() ) #text to display the number of rows 
        })

        output$data_ex  <- renderText({
            paste("Please see README.md file for information regarding the dataset.") #text to display where to find more information
        })
 

        # Downloadable csv of selected dataset 
        output$downloadData <- downloadHandler(
            filename = function() {
                selected <-c() #this assists with the name of the file
                if (input$year != "All") { 
                    selected <-c(selected, input$year)
                }
                if (input$country != "All") {
                    selected <-c(selected, input$country)
                }
                if (input$continent != "All") {
                    selected <-c(selected, input$continent)
                }
                if (length(selected) == 0) {
                    selected <- c("AllData")
                }
                
                paste0(paste(selected, collapse="-"), ".csv")
            },
            content = function(con) {
                data <- df %>%
                    filter(
                        if(input$year != "All") {
                            Year ==input$year
                        } else {TRUE}
                    ) %>%
                    filter(
                        if(input$country != "All") {
                            Country ==input$country
                        } else {TRUE}
                    ) %>%
                    filter(
                        if(input$continent != "All") {
                            Continent ==input$continent
                        } else {TRUE}
                    )
                write.csv(data, con, row.names = TRUE) #saves the filtered data
            }
        )
}

ui.R

# Elit Jasmine Dogu, ejd5mm
# Project One DS 3002
library(shiny)
library(shinyWidgets)

ui <- fluidPage(
    #text with project name and my information
    titlePanel("World Happiness Report"),
    tags$h3("DS 3002- Project One"),
    tags$h4("Elit Dogu, ejd5mm 3rd Year UVA"),
    # use a gradient in background, setting background color to blue
    setBackgroundColor(  
        #https://rdrr.io/cran/shinyWidgets/man/setBackgroundColor.html used this website for help on background color
        color = c("#F7FBFF", "#2171B5"),
        gradient = "radial",
        direction = c("top", "left")
    ),
    # Sidebar layout with input and output definitions ----
    sidebarLayout(
        
        # Sidebar panel for inputs ----
        sidebarPanel(
            
            # Output: Header + summary of distribution ----
            h4("Summary"),
            verbatimTextOutput("summary"),
            
            # Download button
            downloadButton("downloadData", "Download")
        ),
    # Create a new Row in the UI for selectInputs
    # Main panel for displaying outputs ----
    mainPanel(

    fluidRow(  #manipulates the original dataframe given user selection
        column(4,
               selectInput("year",  #selection for the year variable
                           "Year:",
                           c("All",
                             unique(as.numeric(df$Year))))
        ),
        column(4,
               selectInput("country",  #selection for the country variable
                           "Country:",
                           c("All",
                             unique(as.character(df$Country))))
        ),
        column(4,
               selectInput("continent",  #selection for the continent variable
                           "Continent:",
                           c("All",
                             unique(as.character(df$Continent))))
        )
    ),
    # Create a new row for the table
    DT::dataTableOutput("table"),
    
    # Create a new column for the text to be displayed
    column(12,
           verbatimTextOutput("columns") #column to display col count
    ),
    column(12,
           verbatimTextOutput("rows") #column to display row count
    ),

    column(12,
           verbatimTextOutput("data_ex") #column to display more information text
            )
        )
    )
)

谢谢！！

Answer 1

问题是您在 UI 中使用df$......。如果您在 server 函数内定义 df，则它不会在 UI 中定义。所以你会得到这个错误，因为 R 将 df 识别为 'stats' 包提供的函数（“闭包”类型的对象是一个函数）。

Answer 2

预先：StéphaneLaurent's answer 是您需要解决的第一件事。以下不会导致该错误，尽管出于其他原因我仍然建议进行更改。

---

在您的rows 和cols 函数中，您正在直接访问input$。这是错误的，至少有两个原因：

1. （通用函数式编程）你的函数超出了范围，触及了它们没有明确传递的东西。这可能有点关于编程风格，但是使用未显式传递给它的变量的函数可能很难排除故障。

2. input$ 只能从reactive*、observe* 或render* 块（即闪亮反应的东西）中访问。除了这些之外，任何人都不应尝试对input$ 或output$ 做任何事情。

作为修复，通过使函数独立且仅工作标量/向量，使函数与闪亮无关。 （我也会稍微简化一下逻辑。）

  #Generate a function to show the number of rows w/ any given dataframe selection/restriction
  rows = function(year, country, continent) {
    data <- df %>%
      filter(
        year == "All" | year == Year,
        country == "All" | country == Country,
        continent == "All" | continent == Continent
      )
    return(nrow(data)) #returns number of rows of the data
  }

  # ...

  output$rows  <- renderText({
    paste("Number of Rows (Records):" , rows(input$year, input$country, input$continent) )
  })

坦率地说，你的cols 函数有点奇怪……你可以整天改变一帧的行数，但列数不会改变。除非您 dplyr::select 在某些列之外，否则它应该始终是 ncol(df)。

至于逻辑的简化，您的 if 语句嵌入到您的 dplyr::filter 链中并没有错，但我认为更符合 R 习惯的方式是我所建议的。在您的情况下，如果一个变量是"All"，那么它返回一个TRUE，dplyr::filter 适用于所有行。如果不是，则返回一个logical 向量（每行1），指示帧的变量是否与所选输入匹配。

在我的版本中，我做了非常相似的事情：第一个 year == "All" 仍将解析为单个逻辑（假设 year，来自 input$year），但右侧将与行数。你可以测试一下它的样子：

TRUE | c(T,F,T,F)
# [1] TRUE TRUE TRUE TRUE
FALSE | c(T,F,T,F)
# [1]  TRUE FALSE  TRUE FALSE