2017-08-15 79 views
1

我正在尝试使用有光泽的小册子构建地图,但是我的代码并未根据所选输入更改传单地图。有谁知道如何使下面的代码做出选择输入的反应?我试图用get函数来做,但不能成功。任何帮助将非常感激!在Shiny中选择输入信息

这里是我的数据:

> datamap 
     Country.code EVENTONE EVENTTWO EVENTTHREE 
1 Bosnia and Herzegovina  11  1   5 
2    South Korea  1  4   4 
3    Philippines  1  5   6 
4    Indonesia  1  6   8 
5    Thailand  1  0   9 
6    Mongolia  1  0   3 
7  Russian Federation  1  0   4 
8     Ukraine  1  0   8 
9    Slovenia  1  0   5 
10    Mongolia  1  0   0 
11    Pakistan  1  0   0 
12    Bangladesh  1  0   0 

这里是我的代码:

library(shiny) 
library(rworldmap) 
library(ggplot2) 



shinyUI(fluidPage( 
    fluidRow(h1("Events in the World", align = "center")), 
    fluidRow(
    column(2, 

     selectInput("var", "Choose the Type Event:", 
        choices=c("Event One" = "EVENTONE", 
          "Event Two" = "EVETNTWO", 
          "Event Three" = "EVENTTHREE")) 

), 

column(10, 

     tabsetPanel(
     tabPanel("Map View", leafletOutput("TheMap", width = "100%") 
     ) 

     ) #end tabset panel 
    ) 
) 
)) 

shinyServer(function(input, output) { 

    datamap <- read.csv(".../Documents/R Directory/App-4/mapexcel4CSV.csv",    
        stringsAsFactors=FALSE, header=TRUE) 
    sPDF <- joinCountryData2Map(datamap, joinCode='NAME',  
          nameJoinColumn='Country.code') 
    sPDF <- sPDF[sPDF$ADMIN!='Antarctica',] 

    output$TheMap <- renderLeaflet({ 
    mapselect <- get(input$var) 
    pal <- colorBin("YlOrRd", domain = mapselect) 
    labels <- sprintf(
    "<strong>%s</strong><br/>Number of events: %g</sup>", 
    sPDF$NAME, sPDF$mapselect 
) %>% lapply(htmltools::HTML) 

    TheMap<- leaflet(data = sPDF) %>% addTiles() %>% addPolygons(stroke = FALSE) %>% addPolygons(
    fillColor = ~pal(mapselect), 
    weight = 2, 
    opacity = 1, 
    color = "white", 
    dashArray = "3", 
    fillOpacity = 0.7, 
    highlight = highlightOptions(
    weight = 5, 
    color = "#666", 
    dashArray = "", 
    fillOpacity = 0.7, 
    bringToFront = TRUE), 
    label = labels, 
    labelOptions = labelOptions(
    style = list("font-weight" = "normal", padding = "3px 8px"), 
    textsize = "15px", 
    direction = "auto")) 
    } 
) 
}) 
shinyApp(ui = ui, server = server) 

任何帮助,不胜感激!

回答

0

我想这是你的目标为:

library(shiny) 
    library(rworldmap) 
    library(ggplot2) 
    library(leaflet) 



ui <- shinyUI(fluidPage( 
    fluidRow(h1("Events in the World", align = "center")), 
    fluidRow(
     column(2, 

      selectInput("var", "Choose the Type Event:", 
         choices=c("Event One" = "EVENTONE", 
            "Event Two" = "EVENTTWO", 
            "Event Three" = "EVENTTHREE")) 

    ), 

     column(10, 

      tabsetPanel(
       tabPanel("Map View", leafletOutput("TheMap", width = "100%") 
       ) 

      ) #end tabset panel 
    ) 
    ) 
)) 

    server <- shinyServer(function(input, output) { 

    datamap <- read.csv("E:/test.csv",    
         stringsAsFactors=FALSE, header=TRUE) 
    sPDF <- joinCountryData2Map(datamap, joinCode='NAME',  
           nameJoinColumn='Country.code') 
    sPDF <- sPDF[sPDF$ADMIN!='Antarctica',] 
    legVal <- c(min(datamap[,-1]), max(datamap[,-1])) 
    output$TheMap <- renderLeaflet({ 
     mapselect <- input$var 
     pal <- colorBin("YlOrRd", domain = as.numeric(sPDF[[mapselect]])) 
     labels <- sprintf(
     "<strong>%s</strong><br/>Number of events: %g</sup>", 
     sPDF$NAME, sPDF[[mapselect]] 
    ) %>% lapply(htmltools::HTML) 

     TheMap<- leaflet(data = sPDF) %>% addTiles() %>% addPolygons(stroke = FALSE) %>% addPolygons(
     fillColor = ~pal(as.numeric(sPDF[[mapselect]])), 
     weight = 2, 
     opacity = 1, 
     color = "white", 
     dashArray = "3", 
     fillOpacity = 0.7, 
     highlight = highlightOptions(
      weight = 5, 
      color = "#666", 
      dashArray = "", 
      fillOpacity = 0.7, 
      bringToFront = TRUE), 
     label = labels, 
     labelOptions = labelOptions(
      style = list("font-weight" = "normal", padding = "3px 8px"), 
      textsize = "15px", 
      direction = "auto"))%>% addLegend("bottomleft", pal = pal, value = legVal) 
    } 
    ) 
    }) 
    shinyApp(ui = ui, server = server) 

希望它能帮助!