0

我有以下使用传单可视化的交互式叶绿素图。我想在地图的右上角添加一个文字，上面写着“点击状态以获取更多信息”。我可以使用 css 将文本定位在那里，但想知道是否有更好的方法来定位相对于地图的文本。

在此处输入图像描述

以下是用于在闪亮仪表板中重现地图的代码

library(shiny)
library(shinydashboard)
library(tidyverse)
library(tidycovid19)
library(leaflet)
library(sf)


aus_states_data <- download_jhu_csse_covid19_data(type = "country_region", cached = TRUE) %>%
  filter(iso3c == "AUS") %>%
  rename("Date" = date,
         "Confirmed" = confirmed,
         "Deaths" = deaths,
         "Recovered" = recovered) %>%
  mutate(lat = case_when(
    region == "Australian Capital Territory"~ -35.48835,
    region == "New South Wales"~ -31.87598,
    region == "Northern Territory"~ -19.85161,
    region == "Queensland"~ -22.16468,
    region == "South Australia" ~ -30.53437,
    region == "Tasmania" ~ -42.14221,
    region == "Victoria" ~ -36.59861,
    region == "Western Australia" ~ -25.2303,
  ),lon = case_when(
    region == "Australian Capital Territory" ~ 149.00269,
    region == "New South Wales" ~ 147.28695,
    region == "Northern Territory" ~ 133.23034,
    region == "Queensland" ~ 144.58449,
    region == "South Australia" ~ 135.63012,
    region == "Tasmania" ~ 146.67235,
    region == "Victoria" ~ 144.67801,
    region == "Western Australia" ~ 121.0187,
  ))




ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    tags$style(type = "text/css", "#ausmap {height: calc(100vh - 340px) !important;}"),
              fluidPage(
                box(width = NULL,
                    fluidRow(align = "center",tags$h1("Australia COVID-19 Cases, Deaths and Recoveries by State")),
                    fluidRow(column(12, align = "right", tags$h3(paste0("Updated : ", max(aus_states_data$Date))))),
                    column(6,
                           leafletOutput("ausmap"),
                           absolutePanel(top = 50, left = 60,
                                         radioGroupButtons(inputId = "casetype", label = NULL, choices = c("Confirmed", "Deaths", "Recovered"), selected = "Confirmed"))),
                    column(6)
                    )
                )))

server <- function(input, output) {
  
  output$ausmap <- renderLeaflet({
    
    selected_col <- switch(input$casetype,
                           "Confirmed"="Blues",
                           "Deaths"="Reds",
                           "Recovered"="Greens")
    
    states_data <-  read_sf("https://raw.githubusercontent.com/rowanhogan/australian-states/master/states.geojson") %>%
      left_join(latest_vals %>%
                  select(region,selected=input$casetype),
                by=c("STATE_NAME" = "region"))
    
    pal <- colorQuantile(selected_col, domain = states_data$selected)
    
    leaflet(states_data, options = leafletOptions(minZoom = 3)) %>%
      addTiles() %>%
      addPolygons(fillColor=~pal(selected),
                  fillOpacity=0.8,
                  color="white",
                  weight=2,
                  highlight = highlightOptions(weight = 3, bringToFront = TRUE),
                  layerId = ~STATE_NAME,
                  label = ~STATE_NAME)%>%
      addLegend(pal = pal, values = ~selected, opacity = 0.7, title = "Number of cases", position = "bottomright") %>%
      fitBounds(110.246193, -50.322817, 155.226126, -9.088012)
    
    
  })
}


shinyApp(ui = ui, server = server)
4

1 回答 1

2

也许MLavoie在这里解释的内容会有所帮助。

您可以向地图添加标题并定义位置，如下所示：

 library(leaflet)
 library(htmlwidgets)
 library(htmltools)

 rr <- tags$div(
   HTML('<a href="https://cran.r-project.org/"> <img border="0" alt="ImageTitle" src="/PathToImage/ImageR.jpeg" width="300" height="100"> </a>')
 )  

 map_leaflet <- leaflet() %>%
   addTiles() %>%
   addMarkers(50, 50) %>%
   addControl(rr, position = "bottomleft")

 saveWidget(map_leaflet, file="testing.html")
于 2020-10-07T01:47:42.350 回答