在尝试使用数据框和过滤器创建这样的one映射时,我发现传单无法反映任何冗长的内容。或拉特因此没有弹出窗口显示。dataset&css
代码
library(shiny)
library(dplyr)
library(leaflet)
library(readr)
CBdata <- read_csv("/cloud/project/TESTLEAF/www/cblnglt.csv")
df0<- data.frame("cho"=c("No schooling completed","vocational","Bachelor","Post Graduate ","Single","Married","Divorced","others","male","female","under_20","21_30","31_39","31_40","41_50","51_59","over_60","Retired","Public_Employee","Private_Employee","Self_employeed","Unemployed","Others"),
"cat"=c("educ.","educ.","educ.","educ.","Relationship.Status","Relationship.Status","Relationship.Status","Relationship.Status","by_gender","by_gender","By_age","By_age","By_age","By_age","By_age","By_age","By_age","profession","profession","profession","profession","profession","profession"))
CBdata2<-as.data.frame(CBdata)
ui<-
navbarPage("Mapping Dashboard",
theme = "bootstrap.css",
tabPanel("tbd",
div(class="outer",
leafletOutput("mymap", width = "100%", height = "100%"), #
absolutePanel(id = "controls", class = "panel panel-default",
fixed = TRUE,draggable = TRUE, top = "10%", left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto", cursor = "move",br(),
selectInput("region", "Which governorate?", unique(CBdata$by_gov), selected = "Mumbai"),
selectInput("variable", "Filter by?", unique(df0$cat), selected = "by_gender"),
selectInput("sndvariable","sub filter",choices =NULL),
selectInput("indicator","select Indicator",c("xyz","abc"),
selected = "abc"),
plotOutput("bar", height = "250px"),
))),
tabPanel("By Product"))
server<-function(input,output,session){
observe({
TX<-df0%>%filter(cat==input$variable)%>%select(cho)
updateSelectInput(session,"sndvariable","sub filter",choices = unique(TX))
})
CBD1<-reactive({
#browser
CBdata2%>%
filter(input$variable==input$sndvariable,by_gov==input$region)%>%
group_by(lng,lat,input$variable,by_gov,input$indicator)%>%
arrange(desc(input$indicator)) %>%
select(lng,lat,input$variable,by_gov,input$indicator)
})
CBD2<-reactive({
#browser
summarize(CBD1(),summation=sum(as.integer(input$indicator)))
})
CBD3<-reactive({as.data.frame(CBD2())
})
output$mymap<-renderLeaflet({
CBD3()%>%leaflet()%>%
addProviderTiles(provider = "CartoDB.DarkMatter")%>%
addCircleMarkers(lng=~lng,lat=~lat)
})
}
shinyApp(ui,server)
附加了我在应用程序中使用过的CSS,并需要所有data。如果我删除了
lng=~lng
并插入了实际值,它可以正常工作,但是当我们使用数据框时会出现问题。提前致谢
最佳答案
您的问题是您的输入,例如。 input$variable
返回文本。但是,您希望像dplyr
这样的filter
函数使用这些输入,就像它们是数据集中的变量一样,而不是文本。
举个例子:
# this fails because input_filter is a character vector and not a variable
my_filt_wrong <- function(data, input_filter, cond){
data %>%
filter(input_filter == cond)
}
my_filt_wrong(iris, 'Species', 'setosa')
#[1] Sepal.Length Sepal.Width Petal.Length Petal.Width Species
#<0 rows> (or 0-length row.names)
# this works because we tell r to evaluate the input text as a variable
my_filt <- function(data, input_filter, cond){
data %>%
filter(!!sym(input_filter) == cond)
}
my_filt(iris, 'Species', 'setosa')
## A tibble: 50 x 5
# Sepal.Length Sepal.Width Petal.Length Petal.Width Species
# <dbl> <dbl> <dbl> <dbl> <fct>
# 1 5.1 3.5 1.4 0.2 setosa
# 2 4.9 3 1.4 0.2 setosa
# 3 4.7 3.2 1.3 0.2 setosa
# 4 4.6 3.1 1.5 0.2 setosa
# 5 5 3.6 1.4 0.2 setosa
如果我们在要引用数据集中的变量的地方用
input$...
替换!!sym(input$...)
,则地图现在应该可以工作了。library(shiny)
library(dplyr)
library(leaflet)
library(readr)
CBdata <- read_csv("~/downloads/cblnglt.csv")
df0<- data.frame("cho"=c("No schooling completed","vocational","Bachelor","Post Graduate ","Single","Married","Divorced","others","male","female","under_20","21_30","31_39","31_40","41_50","51_59","over_60","Retired","Public_Employee","Private_Employee","Self_employeed","Unemployed","Others"),
"cat"=c("educ.","educ.","educ.","educ.","Relationship.Status","Relationship.Status","Relationship.Status","Relationship.Status","by_gender","by_gender","By_age","By_age","By_age","By_age","By_age","By_age","By_age","profession","profession","profession","profession","profession","profession"))
CBdata2<-as.data.frame(CBdata)
ui<-
navbarPage("Mapping Dashboard",
theme = "bootstrap.css",
tabPanel("tbd",
div( class= 'outer',
leafletOutput("mymap", width = "100%", height = "100%"),
absolutePanel(id = "controls", class = "panel panel-default",
fixed = TRUE,draggable = TRUE, top = "10%", left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto", cursor = "move",br(),
selectInput("region", "Which governorate?", unique(CBdata$by_gov), selected = "Mumbai"),
selectInput("variable", "Filter by?", unique(df0$cat), selected = "by_gender"),
selectInput("sndvariable","sub filter",choices =NULL),
selectInput("indicator","select Indicator",c("xyz","abc"),
selected = "abc"),
plotOutput("bar", height = "250px")
)
)),
tabPanel("By Product",
tableOutput('mytable'))
)
server<-function(input,output,session){
observe({
TX<-df0 %>% filter(cat==input$variable)%>%select(cho)
updateSelectInput(session,"sndvariable","sub filter",choices = unique(TX))
})
CBD1<-reactive({
#browser
CBdata2 %>%
filter(!!sym(input$variable)==input$sndvariable,by_gov==input$region) %>%
group_by(lng,lat,!!sym(input$variable),by_gov,!!sym(input$indicator))%>%
arrange(desc(!!sym(input$indicator)))
})
CBD2<-reactive({
#browser
summarize(CBD1(), summation = sum(as.integer(!!sym(input$indicator))))
})
output$mytable <- renderTable(
CBD2()
)
output$mymap<-renderLeaflet({
CBD2() %>%
leaflet()%>%
addProviderTiles(provider = "CartoDB.DarkMatter")%>%
addCircleMarkers(lng=~lng, lat=~lat)
})
}
shinyApp(ui,server)
关于r - 在R中,传单不反射(reflect)纬度或经度吗?,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/59474422/