使用selectInput确定要在计算中使用的数据名称中的哪一列

A user selects a column name from a selectInput and I would like to use it in a calculation that will be shown in a leaflet map. The general idea is that upon selection of a column we do:

用户从selectInput中选择列名称,我想在将在传单映射中显示的计算中使用它。一般的想法是,在选择专栏后,我们会:

EduAtt_df$percent <- reactive({100*(EduAtt_df$COLUMNSELECTED/EduAtt_df$total)});

I have tried:

我试过了:

EduAtt_df$percent <- reactive({100*(EduAtt_df$[input$x]/EduAtt_df$total)});

This produces error:

这会产生错误:

Warning: Error in rep: attempt to replicate an object of type 'closure' Stack trace (innermost first): 39: $<-.data.frame 38: $<- [C:\Users\lrichards\Documents\RShiny\ACSEduAttain\ACSEduAttain/app.R#128] 37: server [C:\Users\lrichards\Documents\RShiny\ACSEduAttain\ACSEduAttain/app.R#128] 1: runApp Error in rep(value, length.out = nrows) : attempt to replicate an object of type 'closure'

警告:rep中的错误:尝试复制'closure'类型的对象堆栈跟踪(最里面的第一个):39:$ < - 。data.frame 38:$ < - [C:\ Users \ lrichards \ Documents \ RShiny \ ACSEduAttain \ ACSEduAttain / app.R#128] 37:服务器[C:\ Users \ lrichards \ Documents \ RShiny \ ACSEduAttain \ ACSEduAttain / app.R#128] 1:runApp在rep中出错(value,length.out = nrows):尝试复制'closure'类型的对象

How can I use selectInput selection to "pick" a column to use in a calculation?

如何使用selectInput选择“选择”要在计算中使用的列?

Here is my current code. This does require a Census API key to use.

这是我目前的代码。这需要使用Census API密钥。

# Load packages -----------------------------------------------------
library(rgdal)
library(sp)
library(leaflet)
library(dplyr)
library(ggplot2)
library(tigris)
library(acs)
library(stringr)

# Load data ---------------------------------------------------------
api.key.install(key="YourCensusKey");
counties <- c(103);
tracts <- tracts(state = 'FL', county = counties, cb=TRUE);
geo<-geo.make(state=c("FL"), county=counties, tract="*");

EduAtt<-acs.fetch(endyear = 2015, span = 5, geography = geo, table.number = "B15003", col.names = "pretty");

EduAtt_df <- data.frame(
    paste0(
        str_pad(EduAtt@geography$state, 2, "left", pad="0"),
        str_pad(EduAtt@geography$county, 3, "left", pad="0"),
        str_pad(EduAtt@geography$tract, 6, "left", pad="0")),
    EduAtt@estimate[,c(
        "Educational Attainment for the Population 25 Years and Over: Total:",
        "Educational Attainment for the Population 25 Years and Over: No schooling completed",
        "Educational Attainment for the Population 25 Years and Over: Nursery school",
        "Educational Attainment for the Population 25 Years and Over: Kindergarten",
        "Educational Attainment for the Population 25 Years and Over: 1st grade",
        "Educational Attainment for the Population 25 Years and Over: 2nd grade",
        "Educational Attainment for the Population 25 Years and Over: 3rd grade",
        "Educational Attainment for the Population 25 Years and Over: 4th grade",
        "Educational Attainment for the Population 25 Years and Over: 5th grade",
        "Educational Attainment for the Population 25 Years and Over: 6th grade",
        "Educational Attainment for the Population 25 Years and Over: 7th grade",
        "Educational Attainment for the Population 25 Years and Over: 8th grade",
        "Educational Attainment for the Population 25 Years and Over: 9th grade",
        "Educational Attainment for the Population 25 Years and Over: 10th grade",
        "Educational Attainment for the Population 25 Years and Over: 11th grade",
        "Educational Attainment for the Population 25 Years and Over: 12th grade, no diploma",
        "Educational Attainment for the Population 25 Years and Over: Regular high school diploma",
        "Educational Attainment for the Population 25 Years and Over: GED or alternative credential",
        "Educational Attainment for the Population 25 Years and Over: Some college, less than 1 year",
        "Educational Attainment for the Population 25 Years and Over: Some college, 1 or more years, no degree",
        "Educational Attainment for the Population 25 Years and Over: Associate's degree",
        "Educational Attainment for the Population 25 Years and Over: Bachelor's degree",
        "Educational Attainment for the Population 25 Years and Over: Master's degree",
        "Educational Attainment for the Population 25 Years and Over: Professional school degree",
        "Educational Attainment for the Population 25 Years and Over: Doctorate degree")
        ],
    stringsAsFactors = FALSE);

rownames(EduAtt_df) <- 1:nrow(EduAtt_df);
names(EduAtt_df)<-c("GEOID", "total", "no_school","Nursery", "Kindergarten", "g1st", "g2nd", "g3rd", "g4th", "g5th", "g6th", "g7th", "g8th", "g9th", "g10th", "g11th", "g12th", "HS", "GED", "col_less1", "col_1nodegree", "AS", "BA", "MA", "Prof", "PHd");

# Initial page load calculation
EduAtt_df$percent <- 100*(EduAtt_df$g12th/EduAtt_df$total);

EduAtt_merged<- geo_join(tracts, EduAtt_df, "GEOID", "GEOID");
EduAtt_merged <- EduAtt_merged[EduAtt_merged$ALAND>0,];

popup <- paste0("GEOID: ", EduAtt_merged$GEOID, "<br>", "Percent of Population With AS: ", round(EduAtt_merged$percent,2));
pal <- colorNumeric(palette = "RdPu", domain = EduAtt_merged$percent);
map3<-leaflet() %>%
    addProviderTiles("CartoDB.Positron") %>%
    addPolygons(data = EduAtt_merged, fillColor = ~pal(percent), color = "#b2aeae", fillOpacity = 0.7, weight = 1, smoothFactor = 0.2, popup = popup) %>%
    addLegend(pal = pal, values = EduAtt_merged$percent, position = "bottomright", title = "Percent of Population<br>With AS", labFormat = labelFormat(suffix = "%"));



# UI ----------------------------------------------------------------
ui <- fluidPage(

  # App title -------------------------------------------------------
  titlePanel("Educational Attainment By Population"),

  # Sidebar layout with a input and output definitions --------------
  sidebarLayout(

    # Inputs --------------------------------------------------------    
    sidebarPanel(
      selectInput('x', 'X', names(EduAtt_df))
    ),

    # Output --------------------------------------------------------    
    mainPanel(
      textOutput("testvar"),
      leafletOutput("map", height = "600px", width = "700px")
    )

  )
)


# SERVER ------------------------------------------------------------
server <- function(input, output) {
  output$testvar = renderText(input$x);
  EduAtt_df$percent <- reactive({100*(EduAtt_df[input$x]/EduAtt_df$total)});

  # Map -------------------------------------------------------
  output$map <- renderLeaflet({
    map3
    });
}

# Run app -----------------------------------------------------------
shinyApp(ui = ui, server = server);

1 个解决方案

#1

You are trying to assign a reactive function to a column of a data frame, that does not work. A long explanation can be found on the Shiny website. A minimal reproducible example for your case would be:

您正在尝试将反应函数分配给数据框的列,但这不起作用。可以在Shiny网站上找到一个很长的解释。您的案例的最小可重复示例将是:

library(shiny)

ui <- fluidPage(
   sidebarLayout(
      sidebarPanel(selectInput("x", "Pick a column", choices = names(mtcars))),
      mainPanel(tableOutput("result")))
)

mtcars$new_column <- reactive(100 * mtcars[[input$x]])

server <- function(input, output) {
   output$result <- renderTable({
     return(mtcars)
   })
}

shinyApp(ui = ui, server = server)

You can move the calculation into a reactive context and remove the call to reactive. In your case probably the renderLeaflet function, in the example above like this:

您可以将计算移动到反应式上下文中,并删除对被动的调用。在你的情况下可能是renderLeaflet函数,在上面的例子中如下:

library(shiny)

ui <- fluidPage(
   sidebarLayout(
      sidebarPanel(selectInput("x", "Pick a column", choices = names(mtcars))),
      mainPanel(tableOutput("result")))
)

server <- function(input, output) {
   output$result <- renderTable({
     mtcars$new_column <- 100 * mtcars[[input$x]]
     return(mtcars)
   })
}

shinyApp(ui = ui, server = server)