Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
757 views
in Technique[技术] by (71.8m points)

shiny - legend issue with colors

I have an issue with the legend colors. there is not the same legend colors with the circle colors after clicking the point on the map. Also i see that the legend change the position of the values that i am giving to be displayed. what is happening with the legend and the colors? what i have to change in order to have the correct result? Thanks a lot in advance!

library(shiny)
library(shinythemes)
library(leaflet)
library(rasterVis)
library(lattice)
library(dplyr)

pal <- colorFactor(c("#ff0000","#ff7c00","#ffd600","#3cff00","#00b0ff","#2500ff","#ac00ff", "#fb00ff","#ff0044"), domain = NULL)
val <- c("0,45 Km","0,91 Km","1,41 Km","1,99 Km","2,56 Km", "3,15 Km","4,31 Km","5,76 Km","15,15 Km")
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(),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.",tags$br(),
                        "The circle, according to the references will show all the categories of missing Hikers that found in a specific radius from the LKP",
                        tags$br(),tags$br(),),
                      mainPanel(leafletOutput("map", width = "1500", height = "600"))),
             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() %>% addProviderTiles(providers$OpenTopoMap) %>% 
      addLegend("bottomright",pal, values = val,
                title = "Legend")%>% 
      addScaleBar(position = c("bottomright"), options= scaleBarOptions(maxWidth = 150, metric = TRUE, imperial = FALSE,updateWhenIdle = TRUE))%>%
      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=(0.45*1000),color='#ff0000',fillOpacity = 0.0)%>%
      addCircles(lng=click_long, lat=click_lat,radius=(0.92*1000),color='#ff7c00',fillOpacity = 0.0)%>%
      addCircles(lng=click_long, lat=click_lat,radius=(1.41*1000),color='#ffd600',fillOpacity = 0.0)%>%
      addCircles(lng=click_long, lat=click_lat,radius=(1.99*1000),color='#3cff00',fillOpacity = 0.0)%>%
      addCircles(lng=click_long, lat=click_lat,radius=(2.56*1000),color='#00b0ff',fillOpacity = 0.0)%>%
      addCircles(lng=click_long, lat=click_lat,radius=(3.15*1000),color='#2500ff',fillOpacity = 0.0)%>%
      addCircles(lng=click_long, lat=click_lat,radius=(4.31*1000),color='#ac00ff',fillOpacity = 0.0)%>%
      addCircles(lng=click_long, lat=click_lat,radius=(5.76*1000),color='#fb00ff',fillOpacity = 0.0)%>%
    addCircles(lng=click_long, lat=click_lat,radius=(15.15*1000),color='#ff0044',fillOpacity = 0.0)
    
     
    # 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)
question from:https://stackoverflow.com/questions/65643030/legend-issue-with-colors

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)
Waitting for answers

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...