用户从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);
答案 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)