R Shiny with Leaflet - 单击后更改标记的颜色

2024-01-11

我正在开发一个闪亮的应用程序,它显示带有标记的传单地图。 标记是可点击的,我收集被点击标记的 ID。

但我还想更改单击标记的颜色。当标记为蓝色时,它应更改为红色标记,反之亦然。

到目前为止,我已经有了跟踪单击的标记的代码,并且可以将 ID 存储在表中。

output$mymap <- renderLeaflet({
            leaflet() %>%
                addProviderTiles("OpenStreetMap", group = "OSM",
                         options = providerTileOptions(minZoom = 4, maxZoom = 20)) %>%
                addMarkers(data = points, lng = ~X, lat = ~Y, layerId = ~id, popup = ~paste(id))
        })
        
        
        d <- c()
        values <- reactiveValues(df = data.frame(photo_ids=d))

        newEntry <- observeEvent(input$mymap_marker_click,{
            clicked_id <- input$mymap_marker_click$id
            selected_photos <- values$df$photo_ids
            if( clicked_id %in% selected_photos ){
                selected_photos <- selected_photos[!selected_photos %in% clicked_id]
            } else {
                selected_photos <- c(selected_photos, clicked_id)
            }
            #d_new <- c(values$df$photo_ids,as.numeric(clicked_id))
            values$df <- data.frame(photo_ids=selected_photos)
            updateTextInput(inputId = "selected_photos", value = paste(unlist(values$df), collapse = ",") )
        })

但是如何在点击事件中设置标记的样式呢?

edit:

可重现的示例(跟踪单击的标记,但其样式不会更改):

    library("shiny")
    library("sf")
    library("leaflet")
    library("rgeos")
    
    
    selected_photos <- c()
    
    
  getData <- function(){
    sf_poly <- "POLYGON ((7.207031 46.97463, 7.182312 46.89868, 7.267456 46.86864, 7.392426 46.85831, 7.529755 46.86864, 7.67807 46.90618, 7.683563 46.97557, 7.592926 47.03082, 7.371826 47.01584, 7.207031 46.97463))"
  
    sf_poly <- st_as_sf(readWKT(sf_poly))
  
    points <- st_as_sf(st_sample(sf_poly, 20))
    points$id <- 1:nrow(points)
    coords <- st_coordinates(points)
  
    df <- data.frame(st_drop_geometry(points), coords)
    return(df)
  }
    
    
    
    ui <- fluidPage(
      
      titlePanel("Leaflet Map"),
      
      sidebarLayout(
        
        sidebarPanel(
          textInput(inputId="selected_photos", label="Selected images", value = "", placeholder = NULL)
        ),
        
        mainPanel(
          leafletOutput("mymap")
        )
      )
    )
    
    
    server <- function(input, output, session) {
      #https://groups.google.com/g/shiny-discuss/c/LWk4ZYNhsSc
      points <- getData()
      
      output$mymap <- renderLeaflet({
        leaflet() %>%
          addProviderTiles("OpenStreetMap", group = "OSM") %>%
          addMarkers(data = points, lng = ~X, lat = ~Y, layerId = ~id)
      })
      
      
      d <- c()
      values <- reactiveValues(df = data.frame(photo_ids=d))
      
      newEntry <- observeEvent(input$mymap_marker_click,{
        clicked_id <- input$mymap_marker_click$id
        selected_photos <- values$df$photo_ids
        if( clicked_id %in% selected_photos ){
          selected_photos <- selected_photos[!selected_photos %in% clicked_id]
        } else {
          selected_photos <- c(selected_photos, clicked_id)
        }
        values$df <- data.frame(photo_ids=selected_photos)
        updateTextInput(inputId = "selected_photos", session = session, value = paste(unlist(values$df), collapse = ",") )
      })
      
      
      
    }
    
    
    shinyApp(ui, server)

我们可以用addAwesomeMarkers按照建议自定义图标颜色docs https://rstudio.github.io/leaflet/markers.html并使用leafletProxy单击即可更改它:

library(shiny)
library(sf)
library(leaflet)
library(geojsonsf)

getData <- function(){
  poly <- '{"type":"FeatureCollection","features":[{"type":"Feature","properties":{},"geometry":{"type":"Polygon","coordinates":[[[7.207031249999999,46.97463048970666],[7.18231201171875,46.89867745059795],[7.267456054687499,46.86864162233212],[7.392425537109376,46.85831292242506],[7.529754638671874,46.86864162233212],[7.678070068359375,46.9061837801476],[7.683563232421874,46.97556750833867],[7.592926025390624,47.03082254778662],[7.371826171874999,47.01584377790821],[7.207031249999999,46.97463048970666]]]}}]}'
  
  sf_poly <- geojson_sf(poly)
  points <- st_as_sf(st_sample(sf_poly, 20))
  points$id <- 1:nrow(points)
  coords <- st_coordinates(points)
  
  df <- data.frame(st_drop_geometry(points), coords)
  return(df)
}

ui <- fluidPage(
  titlePanel("Leaflet Map"),
  sidebarLayout(
    sidebarPanel(
      textInput(inputId="selected_photos", label="Selected images", value = "", placeholder = NULL)
    ),
    mainPanel(
      leafletOutput("mymap")
    )
  )
)

server <- function(input, output, session) {
  #https://groups.google.com/g/shiny-discuss/c/LWk4ZYNhsSc
  points <- getData()
  points$clicked <- FALSE
  RV <- reactiveValues(points = points)
  
  icons <- awesomeIcons(
    icon = 'ios-close',
    iconColor = 'white',
    library = 'ion',
    markerColor = "blue"
  )
  
  output$mymap <- renderLeaflet({
    leaflet() %>%
      #addTiles() %>%
      addProviderTiles("OpenStreetMap", group = "OSM") %>%
      addAwesomeMarkers(data = points, lng = ~X, lat = ~Y, layerId = ~id, icon = icons)
  })
  
  myLeafletProxy <- leafletProxy(mapId = "mymap", session)
  
  observeEvent(input$mymap_marker_click,{
    clicked_point <- input$mymap_marker_click
    RV$points[points$id==clicked_point$id,]$clicked <- !(RV$points[points$id==clicked_point$id,]$clicked)
    
    updateTextInput(inputId = "selected_photos", value = paste(unlist(RV$points$id[which(RV$points$clicked)]), collapse = ", "))
    
    removeMarker(map = myLeafletProxy, layerId = clicked_point$id)
    addAwesomeMarkers(map = myLeafletProxy,
                      lng = clicked_point$lng,
                      lat = clicked_point$lat,
                      layerId = clicked_point$id,
                      icon = awesomeIcons(
                        icon = 'ios-close',
                        iconColor = 'white',
                        library = 'ion',
                        markerColor = ifelse(RV$points[clicked_point$id,]$clicked, yes = "red", no = "blue")
                      ))
  })
}

shinyApp(ui, server)
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

R Shiny with Leaflet - 单击后更改标记的颜色 的相关文章

  • case_when 与部分字符串匹配和 contains()

    我正在使用一个数据集 其中有许多名为 status1 status2 等的列 在这些列中 它表示某人是否豁免 完整 注册等 不幸的是 豁免投入并不一致 这是一个示例 library dplyr problem lt tibble perso
  • 如何在 R 中的 dygraph 标题中使用 UTF-8 字符

    使用 Rstudio Windows8 当我使用 dygraph 函数绘制时间序列时 在尝试在主标题中使用 UTF 8 字符时遇到问题 library dygraphs dygraph AirPassengers main T tulo 这
  • 将维基百科中的表格加载到 R 中

    我正在尝试从以下 URL 将最高法院法官表加载到 R 中 https en wikipedia org wiki List of Justices of the Supreme Court of the United States http
  • 在 R 上安装 TDA 包时出错:目标“diag.o”的配方失败

    使用 Ubuntu 16 04 和 R 3 4 1 安装 R 包 TDA 时收到错误消息 它似乎与制作 CGAL diag cpp 和 或 diag o 最后的完整错误打印输出 有关 我仔细看了这个 在 R 上安装 TDA 包时出错 htt
  • 条件和分组 mutate dplyr

    假设我有以下每个抽屉库存增加的数据 gt socks year drawer nbr sock total 1990 1 2 1991 1 2 1990 2 3 1991 2 4 1990 3 2 1991 3 1 我想要一个二进制变量来标
  • 在闪亮的数据表中为每个单元格显示工具提示或弹出窗口?

    有没有什么方法可以为 r闪亮数据表中的每个单元格获取工具提示 有很多方法可以获取悬停行或列 但我找不到一种方法来获取行和列索引并为每个单元格显示不同的悬停工具提示 任何人都可以修改以下代码吗 library shiny library DT
  • 无需重新绘制传单地图即可进行闪亮的 UI 调整

    问题 我正在创建一个闪亮的仪表板来帮助客户探索一些空间数据 我想要实现的 UI 设计允许用户轻松地在两种布局之间切换 Map Only 地图 数据表 我在实现这种设计时遇到了麻烦 因为每次用户在布局之间切换时都会出现两个问题 地图已重新绘制
  • 如何使用 dplyr 管道将额外参数传递给 purrr::map

    我有以下数据框和功能 param df lt data frame x 1 3 0 1 y 3 1 0 2 param df gt x y gt 1 1 1 2 8 gt 2 2 1 1 8 gt 3 3 1 0 8 my function
  • R 颜色 - 许多独特的颜色仍然很漂亮

    我很好奇你是否有一些关于 R 中颜色酿造的技巧 对于许多独特的颜色 在某种程度上图形仍然好看 我需要相当数量的独特颜色 至少 24 种 可能需要更多 50 种 用于堆叠区域图 所以不是热图 渐变颜色不起作用 我发现了 viridis 它的调
  • 识别包含字符串的行的最快方法[重复]

    这个问题在这里已经有答案了 我有一个字符串数据框 尺寸为 30 列 x 500 万行 我想识别包含任何预定义字符串列表的行 有没有比下面我的 apply any 方法更快的方法 这是一个可重现的示例 请注意 此示例中的字符串是随机数 但在我
  • rpart 决策树中的 rel 误差和 x 误差有什么区别? [关闭]

    Closed 这个问题不符合堆栈溢出指南 help closed questions 目前不接受答案 我有一个来自 UCI 机器学习数据库的纯分类数据框https archive ics uci edu ml datasets Diabet
  • 类型“typeof Control”上不存在属性“Draw”

    我正在尝试使用传单和其他传单插件实现地图组件 问题是其他插件由于某种原因无法在 TypeScript 上运行 例如 我无法使用 leaflet draw 插件编译代码并收到错误 类型 typeof Control 上不存在属性 Draw 地
  • 将文件名附加到 R 中的数据框

    我想将文件名附加到我的表中 但它似乎并没有真正起作用 我正在做的是迭代文件名列表 打开它们 将所有数据附加到一个数据帧 对于每个附加文件 我想添加其文件名 我希望将其附加到每一行 以便稍后当我查看数据时 我会知道给定行源自哪个文件 但似乎并
  • rPlot 工具提示问题

    我有一个使用 rCharts 工具提示的简单示例 但似乎不起作用 set seed 1 test lt data frame x rnorm 100 y rnorm 100 rPlot y x data test type point to
  • 文件错误(文件,“rt”):complete.cases 程序中的“描述”参数无效

    我正在编写一个 R 函数 该函数读取充满文件的目录并报告每个数据文件中完全观察到的案例的数量 该函数返回一个数据框 其中第一列是文件名称 第二列是完整案例数 such as id nobs 1 108 2 345 etc 这是我写的函数 c
  • 导入 .sav 时出现警告/错误

    我工作中有两个版本的 SPSS SPSS 11 在 Windows XP 上运行 SPSS 20 在 Linux 上运行 SPSS 的两个副本都工作正常 使用任一版本的 SPSS 创建的文件在其他版本的 SPSS 上打开时不会出现任何问题
  • 使用 dplyr 对连续变量进行分类[重复]

    这个问题在这里已经有答案了 我想基于连续数据创建一个具有 3 个任意类别的新变量 set seed 123 df lt data frame a rnorm 100 使用基地我会 df category df a lt 0 5 lt low
  • 函数速度测试的奇怪结果

    我编写了一个使用递归来查找最大公因数 分母 的函数 gt gcd function a b if length a length b gt 1 warning Only scalars allowed using first element
  • Linux 中的 R 有哪些可用的 IDE? [关闭]

    Closed 这个问题不符合堆栈溢出指南 help closed questions 目前不接受答案 Linux 中的 R 有哪些好的 IDE 我尝试过 Rcmdr 和 Eclipse 但似乎都不具有与 Windows 中的 Tinn R
  • ggplot2 的 fortify 函数出错

    我在 ggplot2 中使用 fortify 方法时收到此错误 Error in function classes fdef mtable unable to find an inherited method for function pr

随机推荐