R：使用Leaflet绘制多个解码折线

Question

我有一个包含数千条折线的矢量，我已使用Google Directions API检索到这些折线。我正在尝试使用传单包绘制所有折线。我想知道是否有更简洁的方法来绘制所有折线而不使用数千个addPolylines()函数？

以下是四条折线的示例：

polylines <- c(
"ksktDdp|dQJmB|@uEp@eDr@_D`@yB`@uBRm@LUtAkCZu@Pk@Nu@Hs@DwABoB@u@Gg@WDkCh@_@TaLfDiD~@yUfF{GvAqAX]NkBb@_A\\q@RiAZgAZe@Pu@^g@^o@n@o@z@_AdBqB`EwBrDiDfFIZ_@f@kHzJWZoBzCaCbEi@bAsHfNmGbLqA~B{HjNqEhIiFnJaB~CGf@Sh@iArC]pAQlACh@AjAFbARrAV~@f@fA^h@l@n@`@\\fClBRPFPr@f@hHhFdFtDzCzBzIrGNNNNb@^nD`DtEdEZ`@xAvBZl@r@fB^nA\\dB`@`FDfCF|AXhIJpERlHXzJh@|KL~DDpD?fIBrGbAzYxAbc@VlSVxMRdOJlTF~KH~CX|IDjKAxGDxDHbXR|FZpEpAvO~@rJh@vGRtFL|G^`SZvQ@hEQ`HM`Cg@xFm@tEe@bDi@dF[xEQlFCjED~P@zCKl@?|AFtBPtDZdEANAt@MbAa@fAU^k@j@IF_AZ_ADo@BGBy@A]AM?{BOeEc@g@QmCg@kDs@EEcGaAmFs@aD_@o@CeHs@yB[P|JLjFLxDHpEPxGNrGLbEFl@PhAvBbJnA`Ff@tB_A?mDBsC@?gAi@BEAEECwA@KFGHCP@", 
"ksktDdp|dQJmB|@uEdBeI`@yB`@uBRm@LUtAkCl@aBNu@Hs@HgE@u@Gg@WDkCh@_@TkQfFyUfF{GvAqAX]NkBb@qBp@iAZmBl@u@^g@^o@n@o@z@qDfHwBrDiDfFIZ_@f@kHzJgCvDaCbEi@bAsHfNmGbL_Rt\\kInOmBjE}A~EeB~Fy@nC}@rCcAtC{BjFkA|B}D~HaIpO{EhJYb@oA~AcA`AoBlAcBl@uB`@uCRq@@cSBaBAe@C}@MoAYmHaC{DoAaAe@uAaAoAwAcAkBs@eBe@aBoAkDkCeHk@gAa@m@uAyAcAs@eAm@s@WkDmAgC{@}I{CiCs@}AQqBDwBd@mEtB}At@oE`C_FhCwBz@sA\\aBXyCRaJFkFHkIJcEJoDb@u@ToCfAsC~AcEfCyErCcClAeA\\{@RoALyAHC?wDB{FEq@CuGIsZBY?cCBuEF{AHuFf@kLrAq@HgMxAyGt@sGbAqBd@uD~@[PoErAoF`B}HdC{Bn@_LdD_ARyH~CWJGBwEhBgMtEuFxAuF|@eNhBcCf@uBl@}Bx@gB~@{A`AqHvFcHbFwHzF}EdDyI`FcUlMkIvEiO~I}L`Iym@``@aQvKiFbCkMlFiOfGuc@rQ_FzBaDfBaGdDkD~AkD~@cDl@}FrAeCd@{Cj@mDZgBDmTPmWFkIFeB@eI@c`@T{HFcA@qyAt@{MF}JBoDAwHO}e@uAuWk@kFAgCB{@@{A@gA?a@WEAsG?sCNcCZgP|BcA`@cAn@}@v@_BlBm@bAg@fAc@zAg@bCQhCAtGBfMCnA^tFR|Aj@|CTfAHLJHvA|IfIdf@b@jDTzDHtEI|F}@tRGlCArDVtr@J|K\\zMDjLJr[@|CBpGO|PJlf@^`hA?fDJlWX|{@@pCH~OPhi@@zMOlHMlJ?lMMjBW`A[v@o@bA_LfPmFbI_@t@kLzPwCbEqK~NKd@aGpIwNdT}DdG_EfGeE`HUf@s@lAo@nAu@`@gDxEi@x@}A`CsBpCqDhFgChD}DrEqCnCWPM@}ChDaDzDW\\aJzL{CtEW@MAQIo@_@}Ag@WIWK]O[Q}@}@g@q@g@_A]oAUoA]cEOcA_@cBcAsB[c@o@s@wAkBiAkBkBiEGWUHoCzAKNc@LqAZ_Ad@a@ZOPs@eAa@`@o@[[M_AUk@GUAN_AHIr@Y", 
"ksktDdp|dQJmB|@uEp@eDr@_D`@yB`@uBRm@LUtAkCZu@Pk@Nu@Hs@DwABoB@u@Gg@WDkCh@_@TaLfDiD~@yUfF{GvAqAX]NkBb@_A\\q@RiAZgAZe@Pu@^g@^o@n@o@z@_AdBqB`EwBrDiDfFIZ_@f@kHzJWZoBzCaCbEi@bAsHfNmGbLqA~B{HjNqEhIiFnJaB~CGf@Sh@iArC]pAQlACh@AjAFbARrAV~@f@fA^h@l@n@`@\\fClBRPFPr@f@hHhFdFtDzCzBzIrGNNNNb@^nD`DtEdEZ`@xAvBZl@r@fB^nA\\dB`@`FDfCF|AXhIJpERlHXzJh@|KL~DDpD?fIBrGbAzYxAbc@VlSVxMRdOJlTF~KH~CX|IDjKAxGDxDHbXR|FZpEpAvO~@rJh@vGRtFL|G^`SZvQ@hEQ`HM`Cg@xFm@tEe@bDi@dF[xEQlFCjED~P@zCP|FVxD\\bCv@nELd@Pp@f@hBf@hBnHxVdAdEPvAl@zBZ~Al@dE^hERtFRzLNnPDdQNdu@FtCNzBXfBx@zCn@bBZt@dAhBZd@@VFTlA~Bt@~BR~@PhALtAJpDj@bOLrCD\\JhDl@tNBr@HxA^pKbAxY`AbWn@hRvA|_@VbHfC|r@jCdw@D~Aj@nTH~CDRZhIRtFb@rLFbBp@fRj@fOR|FRbGd@bMr@lSNnF\\vId@~H\\jH`@dLD|@zBbm@j@rPlA~[TtH@~AEVErE@hAX`HNbEbC?BjGD|Bl@vOp@vRfAjZVjFr@`RHb@d@tIzA?lMI?XBzFBjF?N`AAf@CnASp@KvAErFC~AA^?@_@v@?", 
"ksktDdp|dQJmB|@uEp@eDr@_D`@yB`@uBRm@LUtAkCZu@Pk@Nu@Hs@DwABoB@u@Gg@WDkCh@_@TaLfDiD~@yUfF{GvAqAX]NkBb@_A\\q@RiAZgAZe@Pu@^g@^o@n@o@z@_AdBqB`EwBrDiDfFIZ_@f@kHzJWZoBzCaCbEi@bAsHfNmGbLqA~B{HjNqEhIEHmBhDKFMLu@hAeBtCoAbCgC~Eo@lAa@h@e@b@UNq@Ve@Ho@D}@Gw@UcAi@eAw@yD{CsIsHiEqDO]u@i@gNeKaIaGoMsJ_HgF]Uk@SaB}@cBq@_Cg@sEg@c@GmJoAuCgA_BcAcBiAmAwAoAgBk@cAi@mAg@{Aq@}C_C_Jy@{Cq@uBu@gB{AqB_A{@w@i@mCeAsBYoBQiCMsLGoAAeEGuACoDQ}FOuLScNG}D@uD@iKAiOOyEIoP?wA@s@@wULoSLwAD_@?}@AcBKeBQoASqA[cA[gBs@uAu@gCaBqEeDyFkEkBmAcBy@{@]kBe@eB[qCU_GG_G@sNAeIFuE@[D{G?yI@}@?aEDuKFsHDiC?}BIuBOeAGcBUeH{@iHcAiV}CuCWyCSoEIoBB}B@sA@aB?eIB{C?uGBeHBoJHcODeWHmEAkSU_PUeCG_EQuFq@_@E_@GOCgGkB{Ak@{Am@yHyDuGmDsAm@{YoN{MwGgLsFqAm@i@YmDcBsE}BoLuFqUaLgFkCmHmDaBu@_@QcAg@wGaDkYeNgP_IgD{AwI}CqA[u@QgGsAsf@oHaDg@iMcB}IsA{Be@mBm@wB_AmBgAwCgBu@a@eMaIiDuB{D}BsGcEqEkCmCkAiCcAcEsAkHaC_GmBcDaAqIcCiBk@GY?AA?_N}F_GeCiBo@_@YmB{A{AeBsAcCc@gA]sAQu@KeAGe@MgAEeLOuDe@mE?GEaDYcJk@oKIuB]wJI{D?yBNoGd@iHh@}GTaD^mDX}Bd@yCbAyEdC{Kn@wCnGsYpBkJ`AcE|BeKlAiGp@_Fb@mEV{EJmCDuCAkGEcMEyOEsGCwIBqFJkDb@gIx@yNV}FD_FEePSsh@?kAOcc@I}NIe[FeDBs@H_AXmCXqB`@iBt@iC`AiC~@oBlAoBpBoCrDiFb@k@|@oA^Qj@m@hAsAzCmDxAaBlCaCpA}@zB_AbC{@VEX@jBe@|AWjAMy@_MMuDBiFDw@?YJmATyBRqAZ}BR{BL_D@gDEuBMcC_@sEWiDG_D?Ce@?cDAcCUTeCME[GkAY{Ak@UOEQ@WJa@R}@Fo@?i@Cg@Mi@GQOBODO@e@Au@OGC"
)

我通常使用gepaf包解码它们：

> gepaf::decodePolyline(polylines[1]) %>% head()

       lat       lon
1 29.71974 -95.34227
2 29.71968 -95.34172
3 29.71937 -95.34065
4 29.71912 -95.33982
5 29.71886 -95.33902
6 29.71869 -95.33841

绘制单个折线时，我使用以下内容：

gepaf::decodePolyline(polylines[1]) -> SOF_sample

leaflet(SOF_sample) %>% 
    addProviderTiles("CartoDB.DarkMatter") %>% 
    addPolylines(lng = SOF_sample$lon, lat = SOF_sample$lat)

以下是结果的屏幕截图：SOF_sample

我想弄清楚的是如何绘制所有折线而不添加多个addPolylines()函数，如下所示：

leaflet(SOF_sample) %>% 
    addProviderTiles("CartoDB.DarkMatter") %>% 

    #first polyline
    addPolylines(lng = SOF_sample$lon, lat = SOF_sample$lat) %>% 

    #second polyline
    addPolylines(lng = gepaf::decodePolyline(polylines[2])$lon, 
             lat = gepaf::decodePolyline(polylines[2])$lat) %>% 

    #third polyline
    addPolylines(lng = gepaf::decodePolyline(polylines[3])$lon, 
             lat = gepaf::decodePolyline(polylines[3])$lat) %>% 

    #fourth polyline
    addPolylines(lng = gepaf::decodePolyline(polylines[4])$lon, 
             lat = gepaf::decodePolyline(polylines[4])$lat) 

添加数千addPolylines()会给我the result i want。我想知道是否有一种更有效/更清洁的方式，因为我有一种感觉，我上面编写的内容不可能是最好的方法。

谢谢！

Answer 1

一种方法是将折线转换为SpatialLines对象，然后绘制。如果您不熟悉空间物体，我建议您查看它们，因为它们对绘图非常有用。

library(leaflet)
library(sp)
library(data.table)
library(googleway)      ## disclosure: this is my package 
                        ## (and you can also access the google directions API 
                        ## through the google_directions() function)

lst <- lapply(polylines, function(x) googleway::decode_pl(x))

## I like working with data.tables
dt <- rbindlist(lst, idcol = "id")

lst_lines <- lapply(unique(dt$id), function(x){
    ## the order of the 'lon' and 'lat' fields is important
    Lines(Line(dt[id == x, .(lon, lat)]), ID = x)
})

## spatial lines object
spl_lst <- SpatialLines(lst_lines)

## can now plot the spatial lines
leaflet(spl_lst) %>%
    addProviderTiles("CartoDB.DarkMatterNoLabels") %>%
    addPolylines(opacity = 0.4, weight = 3, color = "#ffff00")

更新14-12-2017

截至googleway的第2版，编码折线可以使用我的googleway软件包直接绘制

library(googleway)

## You need a Google API key to use their maps
mapKey <- 'your_api_key'

## the lines need to be in a data.frame
df <- data.frame(polylines = polylines)

google_map(key = mapKey) %>%
    add_polylines(data = df, polyline = "polylines")