微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

如何在我的项目中添加 ESRI 坡度底图

如何解决如何在我的项目中添加 ESRI 坡度底图

我是新来的,我正在努力学习 R 闪亮。 我正在进行的小项目是创建一个地图,我可以点击它并放置一个带有半径的点。到目前为止,我已经这样做了,但我想从 esri 添加这个带有斜坡 https://www.arcgis.com/home/item.html?id=a1ba14d09df14f42ad6ca3c4bcebf3b4 的底图。我该怎么做??? 这是到目前为止的代码

library(shiny)
library(shinythemes)
library(leaflet)
df <- data.frame(longitude = 26,latitude = 39)
# Define UI for slider demo app ----

ui <- fluidPage(
  #Navbar structure for UI
  navbarPage("SAR Model",theme = shinytheme("united"),tabPanel("Toblers Function",titlePanel("Toblers Function")," This is the toblers function that Calculates the maximum speed of a norlmal person depending on the given slope.",tags$br(),sidebarLayout(
                        sidebarPanel(
                          # Input: Slope interval with step value ----
                          sliderInput("slope","Slope:",min = -0.60,max = 0.50,value = 0.0,step = 0.01),tags$div(class="header",Checked= NA,tags$p("Choose the slope from the slidebar!"))),# Main panel for displaying outputs ----
                        mainPanel( 
                          # Output: Table summarizing the values entered ----
                          tableOutput("Values"),tableOutput("slope")))),tabPanel("Map",titlePanel("SAR MAP"),tags$div(
                        "By clicking on the map the point will show the LKP ( Last KNowing Point) of the missing person.","The circle,according to the refrences will show the 50% of missing Hikers that found on 2.56km radius from the LKP",),mainPanel(leafletoutput("map",width = "100%",height = "700"))),tabPanel("Data",titlePanel("Data Summary"),dataTableOutput("table"))))




server <- function(input,output) {
  
  # Reactive expression to create data frame off input value ----
  sliderValues <- reactive({
    
    data.frame(
      Name = c("Slope"),Value = as.character(c(input$slope)),stringsAsFactors = TRUE)
  })
  
  # Show the values in an HTML table ----
  output$values <- renderTable({
    sliderValues()
  })
  output$slope <- renderText({
    paste0("The speed is ",6*exp(-3.5*abs(input$slope+0.05)),"Km/h")
  })
  
  output$map <- renderLeaflet({
    m <- leaflet() %>% addTiles() %>% setView(lng = 26.5331,lat = 39.1036,zoom = 13)
    m %>% addGraticule(group = "Graticule",interval = 0.05) %>%
      addLayersControl(overlayGroups = c("Graticule"),options = layersControlOptions(collapsed = FALSE))
    
    
  })
  
  df_r <- reactiveValues(new_data = df)
  
  # reactive list with id of added markers
  clicked_markers <- reactiveValues(clickedMarker = NULL)
  
  observeEvent(input$map_click,{
    click <- input$map_click
    click_lat <- click$lat
    click_long <- click$lng
    
    clicked_markers$clickedMarker <- c(clicked_markers$clickedMarker,1)
    id <- length(clicked_markers$clickedMarker)
    
    
    # Add the marker to the map
    leafletProxy('map') %>%  
      addMarkers(lng = click_long,lat = click_lat,group = 'new_circles',options = markerOptions(draggable = TRUE),layerId = id,popup = "Last check point")%>%
      addCircles(lng=click_long,lat=click_lat,radius=(2.56*1000),color='red')
    # add new point to dataframe
    df_r$new_data <- rbind(rep(NA,ncol(df)),df_r$new_data)
    df_r$new_data$longitude[1] <- click_long
    df_r$new_data$latitude[1] <- click_lat
  })
  
  observeEvent(input$map_marker_mouSEOut,{
    click_marker <- input$map_marker_mouSEOut
    id <- input$map_marker_mouSEOut$id
    
    if(click_marker$lng != df_r$new_data$longitude[id] | click_marker$lat != df_r$new_data$latitude[id]){
      df_r$new_data$longitude[id] <- click_marker$lng
      df_r$new_data$latitude[id] <- click_marker$lat
    }
  })
  
  output$table <- renderDataTable({df_r$new_data})
}

shinyApp(ui = ui,server = server)

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。