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

时间:2017-11-15 18:50:49

标签: r shiny

用户从selectInput中选择一个列名,我希望在一个将在传单地图中显示的计算中使用它。一般的想法是,在选择专栏后,我们会这样做:

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

我试过了:

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

这会产生错误:

  

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

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

这是我目前的代码。这需要使用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 个答案:

答案 0 :(得分:2)

您正尝试将反应函数分配给数据框的列,但不起作用。 A long explanation can be found on the Shiny website.您的案例的最小可重复示例是:

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)

您可以将计算移至反应式上下文并删除reactive的调用。在你的情况下可能是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)