在尝试使用数据框和过滤器创建这样的one映射时,我发现传单无法反映任何冗长的内容。或拉特因此没有弹出窗口显示。datasetcss

代码


  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/

10-12 23:34