使用套索代替矩形来选择传单中的统治

编程问答 2023-01-24

问题描述

我正在尝试使用 R 显示传单地图（我不能使用 Shiny 包）。我使用“DT”、“串扰”和“传单”包来计算地图中选定数据的列的平均值。在地图中，它仅通过矩形形状选择点。可以通过套索选择吗？

enter image description here

#R code
library(dplyr)
library(leaflet) 
library(DT)
library(crosstalk)

data_2 <- data.frame(ID=c(1:8),Name1 = c("A","A","C","B","B"),Name2 = c("a","b","a","c"),Value1 = c(12,43,54,34,23,77,44,22),Value2 = c(6,5,2,7,6,4,3),Lat = c(51.1,51.6,57.3,52.4,56.3,54.3,60.4,49.2),Lon = c(5,-3,-2,-1,3,-5,0))

data_2<-data_2 %>%
  mutate(
    lab_DB = case_when(
  Name1 == unique(data_2$Name1)[1]  ~ "blue",Name1 == unique(data_2$Name1)[2]  ~ "green",Name1 == unique(data_2$Name1)[3]  ~  "red"
  
    )
  )


sdf <- SharedData$new(data_2,~data_2$ID)
DT1<-datatable(
  sdf,filter = 'top',extensions =  c('Select','Buttons'),selection = 'none',options = list(select = list(style = 'os',items = 'row'),dom = 'Bfrtip',autoWidth = TRUE,buttons =  list('copy',list(extend = 'collection',buttons = c('csv','excel','pdf','print'),text = 'Download'),text = 'Mean',action = DT::JS("function ( e,dt,node,config ) {
                                                                        let columnData = dt.column(4,{search:'applied'}).data().toArray();
                                                                         var amean= Math.round(columnData.reduce((sum,item) => sum+=item)/columnData.length);
                                                                         alert('mean Value1: ' +amean); 
                                                                                       }")),list(extend='collection',buttons=c('selectAll','selectNone','selectRows','selectColumns','selectCells'),text='sel')
                                                                    
                                                                    
                                                                    )))
  ltlf5<- leaflet(sdf) %>% 
  #addProviderTiles(providers$CartoDB.Positron) %>%
  addTiles() %>%
  addCircleMarkers(
               lng = ~Lat,lat = ~Lon,group = ~Name1,popup = ~paste(Name1,'   <br/>  ',Name2,'   <br/>  ' ),color =~lab_DB,radius = 3
               
  )   %>%
  addLayersControl(
        overlayGroups = c('A','B','C'),options = layersControlOptions(collapsed = FALSE)
  ) %>%
  addLegend(
    position = 'bottomleft',labels = c('Group A','Group B','Group C'),colors = c("blue","red","green"),title = "Group color"
  ) 


bscols(ltlf5,DT1)

我找到了 leaflet-lasso(Lasso selection plugin (Demo),Jan Zak Jan Zak ) 但我不知道如何使用它？

leaflet-lasso 是一个 JS 插件。我也找到了 Using arbitrary Leaflet JS plugins with Leaflet for R 但仍然无法解决问题。

解决方法

这是我在串扰中也非常喜欢的一个功能。不幸的是，我认为目前无法完成。也许您可以在串扰 GitHub 页面中添加功能请求。

目前，我尝试了一个非常恶心的变通方法，它可能适合您的需求。它基本上使用以下链接并试图让它们协同工作：

这些是串扰和套索传单的文档页面。以下解决方案的演示可以在下面找到（单击套索按钮绘制套索，单击取消按钮清除当前选择）：

它不像串扰那样工作，但它可能工作得很好。也许其他人可以提出更好的解决方案。以下代码生成了上面的链接，但对于您的代码：

     import React,{ useState } from 'react'
    import io from "socket.io-client"
    
    function socketio() {
        const [hello,setCount] = useState("0")
        const [socket,setSocket] = useState(null)

         useEffect(()=>{
           if(socket === null)
            {
                setSocket(io("https://Wyvern-API.huski3.repl.co/api/chat"))
            }
            if(socket)
            {
            socket.on('connect',() => {
            socket.emit('joined',{ 'serverchannel': 120 })
            console.log("Connected")
            })

             socket.on('message',(data) => {
            setCount(data.content)
            console.log(data.content)
            })
        }
  },[socket])
           
        return (
            <div>
                <h1>{hello}</h1>
            </div>
        )
    }
    
    export default socketio
,

我们可以使用 'plotly' 包而不是使用 'leaflet'。这也不需要闪亮。你有多重选择和套索来选择地图上的点。要重置选定的点，请双击地图。

library(dplyr)
library(plotly) 
library(DT)
library(crosstalk)

data_2 <- data.frame(ID=c(1:8),Name1 = c("A","A","C","B","B"),Name2 = c("a","b","a","c"),Value1 = c(12,43,54,34,23,77,44,22),Value2 = c(6,5,2,7,6,4,3),Lat = c(51.1,51.6,57.3,52.4,56.3,54.3,60.4,49.2),Lon = c(5,-3,-2,-1,3,-5,0))

data_2<-data_2 %>%
  mutate(
lab_DB = case_when(
  Name1 == unique(data_2$Name1)[1]  ~ "blue",Name1 == unique(data_2$Name1)[2]  ~ "green",Name1 == unique(data_2$Name1)[3]  ~  "red"

)
  )


sdf <- SharedData$new(data_2,~data_2$ID)
DT1<-datatable(
  sdf,filter = 'top',extensions =  c('Select','Buttons'),selection = 'none',options =     list(select = list(style = 'os',items = 'row'),dom = 'Bfrtip',autoWidth =     TRUE,buttons =  list('copy',list(extend =     'collection',buttons = c('csv','excel','pdf','print'),text =     'Download'),list(extend = 'collection',text = 'Mean',action =     DT::JS("function ( e,dt,node,config ) {
                                                                    let columnData = dt.column(4,{search:'applied'}).data().toArray();
                                                                     var amean= Math.round(columnData.reduce((sum,item) => sum+=item)/columnData.length);
                                                                     alert('mean Value1: ' +amean); 
                                                                                   }")),list(extend='collection',buttons=c('selectAll','selectNone','selectRows','selectColumns','selectCells'),text='sel')
                                                                
                                                                
                                                                )))


fig <- sdf %>%
  plot_ly(height=900,lat = ~Lat,lon = ~Lon,marker = list(color = ~lab_DB),type = 'scattermapbox'
) 
fig <- fig %>%
  layout(
mapbox = list(
  style = 'open-street-map',zoom =2.5,center = list(lon = -2,lat = 51))) 

fig<-fig %>%  
  highlight("plotly_selected",dynamic = F,color = NULL)

options(persistent = TRUE)
bscols(widths = c(6,4),fig,DT1)
crosstalkjavascriptleafletrr