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