Potential Error in kml_layer_sfc_LINESTRING

[bertcarnell]

I ran into this error and produced the smallest reproducible example that I could. I also have a fix that works for this case, but I am unsure if it would break other examples:

Reproducible Example

require(plotKML)
require(sf)
require(magrittr)

x <- c(sf::st_linestring(matrix(1:6,3)), sf::st_linestring(matrix(11:16,3))) %>%
  sf::st_sfc() %>%
  sf::st_set_crs(4326)

y <- sf::st_cast(x, "LINESTRING")

plotKML::kml_open("kmltest.kml")
plotKML::kml_layer(y)
# Error:
# Error in `[.default`(obj, i.line, ) : incorrect number of dimensions
plotKML::kml_close("kmltest.kml")

Potential Fix

The fixed line is highlighted with a comment below

my_kml_layer_sfc_LINESTRING <- function(
  obj,
  subfolder.name = paste(class(obj)),
  extrude = FALSE,
  z.scale = 1,
  metadata = NULL,
  html.table = NULL,
  TimeSpan.begin = "",
  TimeSpan.end = "",
  ...
) {
  kml.out <- get("kml.out", envir = plotKML.fileIO)
  
  if (is.na(sf::st_crs(obj)) || is.null(sf::st_crs(obj))) {
    stop("CRS of obj is missing")
  }
  if (!sf::st_is_longlat(obj) || st_crs(obj) != st_crs(4326)) {
    obj <- sf::st_transform(obj, crs = 4326)
    message("Reprojecting to ", get("ref_CRS", envir = plotKML.opts))
  }
  
  aes <- kml_aes(obj, ...)
  
  lines_names <- aes[["labels"]]
  colours <- aes[["colour"]]
  widths <- aes[["width"]]
  altitude <- aes[["altitude"]]
  altitudeMode <- aes[["altitudeMode"]]
  balloon <- aes[["balloon"]]
  
  if (
    balloon & 
    (inherits(obj, "sf") ||  (isS4(obj) && "data" %in% slotNames(obj)))
  ) {
    html.table <- .df2htmltable(obj)
  }
  
  message("Writing to KML...")
  pl1 = newXMLNode("Folder", parent = kml.out[["Document"]])
  pl2 <- newXMLNode("name", subfolder.name, parent = pl1)
  
  if (!is.null(metadata)) {
    md.txt <- kml_metadata(metadata, asText = TRUE)
    txtm <- sprintf('<description><![CDATA[%s]]></description>', md.txt)
    parseXMLAndAdd(txtm, parent=pl1)
  }
  
  lv <- length(sf::st_geometry(obj)) 
  coords <- NULL
  for (i.line in seq_len(lv)) {
    ##############################################################
    # Change From
    # xyz <- matrix(sf::st_coordinates(obj[i.line, ])[, 1:2], ncol = 2)
    # To:
    xyz <- matrix(sf::st_coordinates(obj[i.line])[, 1:2], ncol = 2)
    ###############################################################
    xyz <- cbind(xyz, rep(altitude[i.line], nrow(xyz)))
    coords[[i.line]] <- paste(xyz[, 1], ',', xyz[, 2], ',', xyz[, 3], collapse='\n ', sep = "")
  }
  
  txts <- sprintf(
    '<Style id="line%s"><LineStyle><color>%s</color><width>%.0f</width></LineStyle><BalloonStyle><text>$[description]</text></BalloonStyle></Style>', 
    seq_len(lv), 
    colours, 
    widths
  )
  parseXMLAndAdd(txts, parent=pl1)
  
  if (length(html.table) > 0) {
    if (nzchar(TimeSpan.begin[1]) & nzchar(TimeSpan.end[1])) {
      if (identical(TimeSpan.begin, TimeSpan.end)) {
        when = TimeSpan.begin
        if (length(when) == 1L){
          when = rep(when, lv) 
        }
        txt <- sprintf(
          '<Placemark><name>%s</name><styleUrl>#line%s</styleUrl><TimeStamp><when>%s</when></TimeStamp><description><![CDATA[%s]]></description><LineString><extrude>%.0f</extrude><altitudeMode>%s</altitudeMode><coordinates>%s</coordinates></LineString></Placemark>', 
          lines_names, 
          seq_len(lv), 
          when, 
          html.table, 
          rep(as.numeric(extrude), lv), 
          rep(altitudeMode, lv), 
          paste(unlist(coords))
        )
      } else {
        if (length(TimeSpan.begin) == 1L) {
          TimeSpan.begin = rep(TimeSpan.begin, lv) 
        }
        if (length(TimeSpan.end) == 1L) {
          TimeSpan.end = rep(TimeSpan.end, lv) 
        }
        txt <- sprintf(
          '<Placemark><name>%s</name><styleUrl>#line%s</styleUrl><TimeSpan><begin>%s</begin><end>%s</end></TimeSpan><description><![CDATA[%s]]></description><LineString><extrude>%.0f</extrude><altitudeMode>%s</altitudeMode><coordinates>%s</coordinates></LineString></Placemark>', 
          lines_names, 
          seq_len(lv), 
          TimeSpan.begin, 
          TimeSpan.end, 
          html.table, 
          rep(as.numeric(extrude), lv), 
          rep(altitudeMode, lv), 
          paste(unlist(coords))
        )    
      }
    } else {      
      txt <- sprintf(
        '<Placemark><name>%s</name><styleUrl>#line%s</styleUrl><description><![CDATA[%s]]></description><LineString><extrude>%.0f</extrude><altitudeMode>%s</altitudeMode><coordinates>%s</coordinates></LineString></Placemark>', 
        lines_names, 
        seq_len(lv), 
        html.table, 
        rep(as.numeric(extrude), lv), 
        rep(altitudeMode, lv), 
        paste(unlist(coords))
      )
    }
  } else {
    if (nzchar(TimeSpan.begin[1]) & nzchar(TimeSpan.end[1])) {
      if (identical(TimeSpan.begin, TimeSpan.end)) {
        when = TimeSpan.begin
        if (length(when) == 1L) {
          when = rep(when, lv) 
        }
        txt <- sprintf(
          '<Placemark><name>%s</name><styleUrl>#line%s</styleUrl><TimeStamp><when>%s</when></TimeStamp><LineString><extrude>%.0f</extrude><altitudeMode>%s</altitudeMode><coordinates>%s</coordinates></LineString></Placemark>', 
          lines_names, 
          seq_len(lv), 
          when, 
          rep(as.numeric(extrude), lv), 
          rep(altitudeMode, lv), 
          paste(unlist(coords))
        )
      } else {
        if (length(TimeSpan.begin) == 1L){
          TimeSpan.begin = rep(TimeSpan.begin, lv)
        }
        if (length(TimeSpan.end) == 1L){
          TimeSpan.end = rep(TimeSpan.end, lv)
        }   
        txt <- sprintf(
          '<Placemark><name>%s</name><styleUrl>#line%s</styleUrl><TimeSpan><begin>%s</begin><end>%s</end></TimeSpan><LineString><extrude>%.0f</extrude><altitudeMode>%s</altitudeMode><coordinates>%s</coordinates></LineString></Placemark>', 
          lines_names, 
          seq_len(lv), 
          TimeSpan.begin, 
          TimeSpan.end, 
          rep(as.numeric(extrude), lv), 
          rep(altitudeMode, lv), 
          paste(unlist(coords))
        )
      }     
    } else {
      txt <- sprintf(
        '<Placemark><name>%s</name><styleUrl>#line%s</styleUrl><LineString><extrude>%.0f</extrude><altitudeMode>%s</altitudeMode><coordinates>%s</coordinates></LineString></Placemark>', 
        lines_names, 
        seq_len(lv), 
        rep(as.numeric(extrude), lv), 
        rep(altitudeMode, lv), 
        paste(unlist(coords))
      ) 
    }
  }
  
  parseXMLAndAdd(txt, parent=pl1)
  
  assign('kml.out', kml.out, envir=plotKML.fileIO)
}

Show that the fix works

plotKML::kml_open("kmltest.kml")
my_kml_layer_sfc_LINESTRING(y)
# No Error:
plotKML::kml_close("kmltest.kml")