Shiny Map - Leaflet:如何动态选择输入矩阵?

时间:2015-07-22 13:23:03

标签: r amazon-ec2 leaflet shiny

我正在尝试创建一个闪亮的应用程序来生成动态地图。我想使用selectInput函数动态选择矩阵。我会将这些地图集成到一个Rmarkdown文件中,其中已经存在多个应用程序。

我使用亚马逊ec2 Ubuntu机器来托管我的闪亮应用程序和rstudio。所有正在运行的应用程序都在/ srv / shiny-server。

我收到以下错误:
错误

  

maptab [,“long”]出错:尺寸数不正确   data.frame中的错误(lng = maptab [,“long”],lat = maptab [,“lat”],category = factor(maptab [,:     找不到对象'maptab'

代码

### Top Doctors Map Leaflet
library(shiny)
library(leaflet)

##```{r, echo=FALSE, warning=FALSE, message=FALSE}
r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()

shinyApp(
  ui =shinyUI(fluidPage(

    # Sidebar with a slider input for number of bins
    sidebarPanel(
      selectInput("var", "1, Select the variables from top doc summary file", 
                  choices =c( "top_docs" = 1, 
                              "docs" = 2,
                              "orgs" = 3, 
                              "phys_summ" = 4, 
                              "pm" = 5), selected= 1 ),
      br(),
      sliderInput("bins", "2, Select the number of BINs for Map", min = 40, max = 100000, value=20),
      br(),
      # radioButtons("color", "3, Select the color of histogram", choices =c("Green", "Red", "Yellow"), selected= "Green")
    ),
    # Show a plot of the generated distribution
    mainPanel(
      tabsetPanel(type = "tabs", 
                  tabPanel('Leaflet Map', leafletOutput("leaflet_map")),
                  tabPanel('Circular Map', leafletOutput("circular_map"))
      )))),
  server = shinyServer(function(input, output) {
    output$leaflet_map <- renderLeaflet({
      maptab <- input$var
      m <- leaflet() %>%
        addTiles() %>%  # Add default OpenStreetMap map tiles
        addMarkers(lng=maptab[,long], lat=maptab[,lat],popup=maptab[,name])
      m  # Print the map
    })
    output$circular_map <- renderLeaflet({
      ### Top Doctors circular map

      m = leaflet() %>% addTiles()
      df = data.frame(
        lng=maptab[,'long'], 
        lat=maptab[,'lat'],
        # size = runif(40, 5, 20),
        category = factor(maptab[,'state']),
        color = sample(colors(), 40)
      )
      m = leaflet(df) %>% addTiles()
      m %>% addCircleMarkers(radius = runif(40, 4, 10), color = c('red','blue','green'))
    })
  }), 
  options = list(height = 480, width = 1050, dpi=200)

)
##

示例数据输入

library(data.table)
top_docs = data.table(long = runif(40, -87, -80), lat = runif(40, 25, 42), name = letters, state= letters) 
docs = data.table(long = runif(9123, -87, -80), lat = runif(40, 25, 42), name = letters, state= letters) 
orgs = data.table(long = runif(722, -87, -80), lat = runif(40, 25, 42), name = letters, state= letters) 
phys_summ = data.table(long = runif(9845, -87, -80), lat = runif(40, 25, 42), name = letters, state= letters) 
pm = data.table(long = runif(99999, -87, -80), lat = runif(40, 25, 42), name = letters, state= letters) 

1 个答案:

答案 0 :(得分:0)

最后,我想通了。感谢@NicE提供您的意见。

错误是由于没有使用get进行字符输入和不正确的selectInpud id赋值。 修订后的工作代码:

{r, echo=FALSE, message=FALSE}
options(warn=-1)
library(shiny)
library(leaflet)
# {r, echo=FALSE, warning=FALSE, message=FALSE}
r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()
var=c("Top Doctors" = "top_docs", 
      "Doctors" = "docs",
      "Provider Orgs." = "orgs", 
      "All Providers" =  "pm" )

shinyApp(
  ui =shinyUI(fluidPage(

    # Sidebar with a slider input for number of bins
    sidebarPanel(
      selectInput("pid", "1. Select the providers ", var, selected= "top_docs", selectize = TRUE ),
      br(),
      sliderInput("bins", "2, Select the number of BINs for Map", min = 40, max = 100000, value=20)
      # radioButtons("color", "3, Select the color of histogram", choices =c("Green", "Red", "Yellow"), selected= "Green")
    ),
    # Show a plot of the generated distribution
    mainPanel(
      tabsetPanel(type = "tabs", 
                  tabPanel('Leaflet Map', leafletOutput("leaflet_map")),
                  tabPanel('Circular Map', leafletOutput("circular_map"))
      )))),
   server = shinyServer(function(input, output) {
output$leaflet_map <- renderLeaflet({
  maptab <- get(input$pid)
  m <- leaflet() %>%
    addTiles() %>%  # Add default OpenStreetMap map tiles
    addMarkers(lng=maptab[,'long'][1:input$bins], lat=maptab[,'lat'][1:input$bins],popup=maptab[,'name'])
  m  # Print the map
})
### Top Doctors circular map
output$circular_map <- renderLeaflet({
 maptab <- get(input$pid)
  m = leaflet() %>% addTiles()
  df = data.frame(
    lng=maptab[,'long'][1:input$bins], 
    lat=maptab[,'lat'][1:input$bins],
    size = runif(input$bins, 5, 20),
    category = factor(maptab[,'state']),
    color = sample(colors(), input$bins)
  )
  m = leaflet(df) %>% addTiles()
  m %>% addCircleMarkers(radius = runif(input$bins, 4, 10), color = c('red','blue','green'))
})

})   #,options = list(height = 480,width = 1050,dpi = 200)