lty legend fixed

Author: mtennekes

R/tmapLeafletComp.R

@@ -21,7 +21,7 @@ gp_to_lpar = function(gp, mfun, shape = 20, pick_middle = TRUE, size_factor = 20
  fill_alpha = {if (!all(is.na(gp$fill_alpha))) gp$fill_alpha else 0},
  col_alpha = {if (!all(is.na(gp$col_alpha))) gp$col_alpha else 0},
  lwd = {if (!all(is.na(gp$lwd))) gp$lwd else 0},
- lty = {if (!all(is.na(gp$lty))) lty2dash(gp$lty) else "none"},
+ lty = {if (!all(is.na(gp$lty))) lty2dash(gp$lty, gp$lwd) else "none"},
  size = {if (!all(is.na(gp$size))) gp$size else 1},
  shape = {if (!all(is.na(gp$shape))) gp$shape else shape}))
 
@@ -290,6 +290,7 @@ tmapLeaflet_legend = function(cmp, lf, o, orientation) {
 }
 
 names(gp2)[names(gp2) == 'stroke-width'] = "strokeWidth"
+names(gp2)[names(gp2) == 'stroke-dash'] = "dashArray"
 gp2$baseSize = 20
 #symbols = do.call(leaflegend::makeSymbolIcons, gp2)#$iconUrl
 

R/tmapLeafletDataPlot_lines.R

@@ -53,7 +53,7 @@ tmapLeafletDataPlot.tm_data_lines = function(a, shpTM, dt, pdt, popup.format, hd
 } else {
 
 lf %>%
-leaflet::addPolylines(data = shp, layerId = idt, label = hdt, color = gp$col, opacity = gp$col_alpha, weight = gp$lwd, group = group, options = opt, dashArray = lty2dash(gp$lty), popup = popups) %>%
+leaflet::addPolylines(data = shp, layerId = idt, label = hdt, color = gp$col, opacity = gp$col_alpha, weight = gp$lwd, group = group, options = opt, dashArray = lty2dash(gp$lty, gp$lwd), popup = popups) %>%
 assign_lf(facet_row, facet_col, facet_page)
 
 }

R/tmapLeaflet_layers.R

@@ -119,11 +119,20 @@ tmapLeafletDataPlot.default = function(a, shpTM, dt, pdt, popup.format, hdt, idt
 NULL
 }
 
+#preset = lapply(list(dashed = c(4, 4), dotted = c(1,3), dotdash = c(1, 3, 4, 3), longdash = c(7, 3), twodash = c(2, 2, 6, 2)), function(x) {
+#x * scale
+#})
+lty2dash = function(lty, lwd) {
+po(lty,lwd)
+k = max(length(lty), length(lwd))
+lty = rep(lty, length.out = k)
+lwd = rep(lwd, length.out = k)
+
+
 
-lty2dash = function(lty) {
 tab = c(solid = "", dashed = "4 4", dotted = "1 3", dotdash = "1 3 4 3", longdash = "7 3", twodash = "2 2 6 2")
 are_words = (lty %in% names(tab))
-if (all(are_words)) {
+x = if (all(are_words)) {
 unname(tab[lty])
 } else {
 are_letters = (suppressWarnings(!is.na(as.numeric(lty))))
@@ -137,14 +146,25 @@ lty2dash = function(lty) {
 lty
 }
 
+# multiply by lwd
+split_x <- strsplit(x, " ")
+
+z = mapply(
+function(vals, mult) paste(as.numeric(vals) * mult, collapse = " "),
+split_x, lwd, USE.NAMES = FALSE
+)
+
+z[x == ""] = "" # restore empties if needed
+z
 }
 
 makeSymbolIcons2 = function (shape, color, fillColor = color, opacity, fillOpacity = opacity,
- strokeWidth = 1, width, height = width, ...)
+ strokeWidth = 1, dashArray = "none", width, height = width, ...)
 {
 symbols <- Map(leaflegend::makeSymbol, shape = shape, width = width,
  height = height, color = color, fillColor = fillColor,
  opacity = opacity, fillOpacity = fillOpacity, `stroke-width` = strokeWidth,
+ `stroke-dasharray` = dashArray,
  ...)
 leaflet::icons(iconUrl = unname(symbols), iconAnchorX = width/2 + strokeWidth,
  iconAnchorY = height/2 + strokeWidth)

R/tmapScaleAsIs.R

@@ -32,7 +32,10 @@ tmapScaleAsIs = function(x1, scale, legend, chart, o, aes, layer, layer_args, so
 values = do.call(cfun, list(x = x2, pc = o$pc))
 
 vneutral = if (is.na(scale$value.neutral)) {
-getAesOption("value.neutral", o, aes, layer)
+vna = getAesOption("value.neutral", o, aes, layer)
+if (is.na(vna)) {
+x1[1]
+} else vna
 } else {
 scale$value.neutral
 }