Skip to content

Commit

Permalink
tmap_style_catalog working (still only with v3 styles and examples)
Browse files Browse the repository at this point in the history
  • Loading branch information
@mtennekes
mtennekes committed Jul 25, 2024
1 parent 8257a83 commit feae681
Show file tree
Hide file tree
Showing 6 changed files with 158 additions and 50 deletions.
1 change: 1 addition & 0 deletions R/tm_legend.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -136,5 +136,6 @@ tm_legend_bivariate = function(xlab,
if (!("xlab" %in% (names(args)))) args$xlab = NA
if (!("ylab" %in% (names(args)))) args$ylab = NA
if (!("z" %in% (names(args)))) args$z = as.integer(NA)
args$orientation = "portrait"
structure(args, class = c("tm_legend", "tm_component", "list"))
}
33 changes: 26 additions & 7 deletions R/tmapGridComp_leg_landscape.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -157,19 +157,20 @@ tmapGridLegPlot.tm_legend_standard_landscape = function(comp, o, fH, fW) {

if (is.na(comp$title.align)) comp$title.align = comp$position$align.h

titleGP = grid::gpar(col = comp$title.color, cex = titleS, fontface = comp$title.fontface, fontfamily = comp$title.fontfamily)

if (comp$title.align == "left") {
grTitle = gridCell(3, 3:(length(comp$wsu)-2), grid::textGrob(comp$title, x = grid::unit(comp$title.padding[2] * titleS * o$lin, units = "inch"), just = "left", gp = grid::gpar(cex = titleS)))
grTitle = gridCell(3, 3:(length(comp$wsu)-2), grid::textGrob(comp$title, x = grid::unit(comp$title.padding[2] * titleS * o$lin, units = "inch"), just = "left", gp = titleGP))
} else if (comp$title.align == "right") {
grTitle = gridCell(3, 3:(length(comp$wsu)-2), grid::textGrob(comp$title, x = grid::unit(1, "npc") - grid::unit(comp$title.padding[4] * titleS * o$lin, units = "inch"), just = "right", gp = grid::gpar(cex = titleS)))
grTitle = gridCell(3, 3:(length(comp$wsu)-2), grid::textGrob(comp$title, x = grid::unit(1, "npc") - grid::unit(comp$title.padding[4] * titleS * o$lin, units = "inch"), just = "right", gp = titleGP))
} else {
grTitle = gridCell(3, 3:(length(comp$wsu)-2), grid::textGrob(comp$title, x = 0.5, just = "center", gp = grid::gpar(cex = titleS)))
grTitle = gridCell(3, 3:(length(comp$wsu)-2), grid::textGrob(comp$title, x = 0.5, just = "center", gp = titleGP))
}

textW = graphics::strwidth(comp$labels, units = "inch", cex = textS, family = comp$text.fontfamily, font = fontface2nr(comp$text.fontface))
scale_labels = max(textW / grid::convertUnit(wsu[comp$item_ids], unitTo = "inch", valueOnly = TRUE), 1)

grText = mapply(function(i, id) gridCell(8, id, grid::textGrob(comp$labels[i], x = 0.5, just = "center", gp = grid::gpar(cex = textS/scale_labels, fontface = comp$text.fontface, fontfamily = comp$text.fontfamily))), 1L:nlev, comp$item_ids, SIMPLIFY = FALSE)
grText = mapply(function(i, id) gridCell(8, id, grid::textGrob(comp$labels[i], x = 0.5, just = "center", gp = grid::gpar(col = comp$text.color, cex = textS/scale_labels, fontface = comp$text.fontface, fontfamily = comp$text.fontfamily))), 1L:nlev, comp$item_ids, SIMPLIFY = FALSE)

ticks = get_legend_option(comp$ticks, comp$type)
ticks.disable.na = get_legend_option(comp$ticks.disable.na, comp$type)
Expand Down Expand Up @@ -390,14 +391,32 @@ tmapGridLegPlot.tm_legend_standard_landscape = function(comp, o, fH, fW) {


} else if (comp$type == "text") {
if (length(gp$size) == 1) gp$size = min(gp$size, min(get_legend_option(comp$item.height, "symbols"),
get_legend_option(comp$item.width, "symbols")) * comp$textS)
gp$text[is.na(gp$text)] = getAesOption("value.const", o, aes = "text", layer = "text")

if (length(gp$cex) == 1) gp$cex = min(gp$cex, min(get_legend_option(comp$item.height, "text"),
get_legend_option(comp$item.width, "text")) * comp$textS)

bgcols = rep(gp$bgcol, length.out = nlev)
bgcols_alpha = rep(gp$bgcol_alpha, length.out = nlev)

# in case size is a continuous scale
if (is.character(gp$cex)) gp$cex = vapply(cont_split(gp$cex), FUN = function(x) {
as.numeric(x[round(length(x)/2)])
}, FUN.VALUE = numeric(1))


gpars = gp_to_gpar(gp, split_to_n = nlev, o = o, type = comp$type)

# scale down (due to facet use)
gpars = lapply(gpars, rescale_gp, scale = o$scale_down)

grItems = mapply(function(id, gpari) gridCell(6, id, grid::textGrob(x=0.5, y=0.5, gp = gpari)), comp$item_ids, gpars, SIMPLIFY = FALSE)
grItems = mapply(function(id, gpari, txt, bgcol, bgcol_alpha, size) {
gridCell(6, id, {
grid::gList(
rndrectGrob(width = grid::unit(grid::convertWidth(grid::stringWidth(txt), "inches")* size, "inches"), height = grid::unit(o$lin* textS, "inches"), gp = grid::gpar(fill = bgcol, alpha = bgcol_alpha, col = NA), r = comp$item.r),
grid::textGrob(x=0.5, y=0.5, label = txt, gp = gpari))
})
}, comp$item_ids, gpars, gp$text, bgcols, bgcols_alpha, gp$cex, SIMPLIFY = FALSE)

}

Expand Down
7 changes: 4 additions & 3 deletions R/tmapGridComp_leg_portrait.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -260,13 +260,14 @@ tmapGridLegPlot.tm_legend_standard_portrait = function(comp, o, fH, fW) {

shiftCol = if (comp$type == "bivariate") 2L else 0L

titleGP = grid::gpar(col = comp$title.color, cex = titleS, fontface = comp$title.fontface, fontfamily = comp$title.fontfamily)

if (comp$title.align == "left") {
grTitle = gridCell(3, (2 + shiftCol):(length(comp$wsu)-1), grid::textGrob(comp$title, x = grid::unit(comp$title.padding[2] * titleS * o$lin, units = "inch"), just = "left", gp = grid::gpar(col = comp$title.color, cex = titleS, fontface = comp$title.fontface, fontfamily = comp$title.fontfamily)))
grTitle = gridCell(3, (2 + shiftCol):(length(comp$wsu)-1), grid::textGrob(comp$title, x = grid::unit(comp$title.padding[2] * titleS * o$lin, units = "inch"), just = "left", gp = titleGP))
} else if (comp$title.align == "right") {
grTitle = gridCell(3, (2 + shiftCol):(length(comp$wsu)-1), grid::textGrob(comp$title, x = grid::unit(1, "npc") - grid::unit(comp$title.padding[4] * titleS * o$lin, units = "inch"), just = "right", gp = grid::gpar(col = comp$title.color, cex = titleS, fontface = comp$title.fontface, fontfamily = comp$title.fontfamily)))
grTitle = gridCell(3, (2 + shiftCol):(length(comp$wsu)-1), grid::textGrob(comp$title, x = grid::unit(1, "npc") - grid::unit(comp$title.padding[4] * titleS * o$lin, units = "inch"), just = "right", gp = titleGP))
} else {
grTitle = gridCell(3, (2 + shiftCol):(length(comp$wsu)-1), grid::textGrob(comp$title, x = 0.5, just = "center", gp = grid::gpar(col = comp$title.color, cex = titleS, fontface = comp$title.fontface, fontfamily = comp$title.fontfamily)))
grTitle = gridCell(3, (2 + shiftCol):(length(comp$wsu)-1), grid::textGrob(comp$title, x = 0.5, just = "center", gp = titleGP))
}


Expand Down
3 changes: 0 additions & 3 deletions R/tmapGridLegend.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -199,9 +199,6 @@ tmapGridCompCorner = function(comp, o, stack, pos.h, pos.v, maxH, maxW, offsetIn
comp = lapply(comp, process_comp_box, sc = sc, o = o)

groupframe = if ((comp[[1]]$frame.lwd!=0) && group.frame) {

#x = switch(group.just[1], "left" = W/2, "right" = grid::unit(1,"npc") - W/2, grid::unit(0.5, "npc"))
#y = switch(group.just[2], "top" = grid::unit(1,"npc") - H/2, "bottom" = H/2, grid::unit(0.5, "npc"))
gridCell(range(Hid), range(Wid), rndrectGrob(gp=grid::gpar(fill = comp[[1]]$bg.color, col = comp[[1]]$frame, lwd = comp[[1]]$frame.lwd), r = comp[[1]]$frame.r))
} else NULL

Expand Down
122 changes: 94 additions & 28 deletions R/tmap_options.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -63,6 +63,7 @@ tmapMode = function(id, name, ...) {
col.polygons = "grey40",
col.symbols = "grey40",
col.raster = "grey40",
col.text = "black",
col = "black",
bgcol.labels_highlighted = "white",
bgcol = "#00000000",
Expand Down Expand Up @@ -713,21 +714,27 @@ styles = list(
),
gray = list(
bg.color = "grey85",
values.var = list(fill = list(seq = "brewer.greys", unord = "brewer.greys", ord = "brewer.greys", cyc = "brewer.greys"),
col = list(seq = "brewer.greys", unord = "brewer.greys", ord = "brewer.greys", cyc = "brewer.greys"))
value.const = list(fill = "grey70",
fill.dots = "black",
fill = "grey50",
col.polygons = "grey20",
col = "black")
),
grey = list(
bg.color = "grey85",
values.var = list(fill = list(seq = "brewer.greys", unord = "brewer.greys", ord = "brewer.greys", cyc = "brewer.greys"),
col = list(seq = "brewer.greys", unord = "brewer.greys", ord = "brewer.greys", cyc = "brewer.greys"))
value.const = list(fill = "grey70",
fill.dots = "black",
fill = "grey50",
col.polygons = "grey20",
col = "black")
),
natural = list(
bg.color = "lightskyblue1",
value.const = list(fill.polygons = "darkolivegreen3",
fill.symbols = "tomato2",
col.polygons = "black",
col.symbols = "black",
fill.dots = "firebrick",
fill = "tomato2",
col.lines = "steelblue",
col.text = "white",
col = "black"),
value.na = list(
fill = "white",
Expand All @@ -744,15 +751,14 @@ styles = list(
legend.frame = TRUE,
legend.bg.color = "grey90",
earth.boundary = TRUE,
basemaps = "Esri.NatGeoWorldMap",
basemaps.alpha = 1),
basemap.server = "Esri.NatGeoWorldMap",
basemap.alpha = 1),
cobalt = list(bg.color = "#002240",
outer.bg.color = "#002240",
value.const = list(fill.polygons = "#0088FF",
fill.symbols = "#FF9D00",
col.polygons = "#002240",
col.symbols = "#002240",
col.lines = "#002240",
fill = "#FF9D00",
col.lines = "#FFEE80",
col.text = "white",
col = "#002240",
bgcol.labels_highlighted = "#002240",
bgcol = "#00000000"),
Expand All @@ -769,14 +775,13 @@ styles = list(
attr.color = "white",
chart.text.color = "white",
chart.title.color = "white",
basemaps = "CartoDB.DarkMatter",
basemaps.alpha = .5),
basemap.server = "CartoDB.DarkMatter",
basemap.alpha = .5),
albatross = list(bg.color = "#00007F",
value.const = list(fill.polygons = "#4C4C88",
fill.symbols = "#BFBFFF",
col.polygons = "#00004C",
col.symbols = "#00004C",
fill = "#BFBFFF",
col.lines = "#BFBFFF",
col.text = "#FFE700",
col = "#00004C",
bgcol.labels_highlighted = "#00007F",
bgcol = "#00000000"),
Expand All @@ -791,13 +796,49 @@ styles = list(
values.var = list(fill = list(seq = "brewer.yl_or_rd", div = "brewer.rd_yl_gn", unord = "brewer.set3", ord = "brewer.yl_or_rd"),
col = list(seq = "brewer.yl_or_rd", div = "brewer.rd_yl_gn", unord = "brewer.set3", ord = "brewer.yl_or_rd")),
attr.color = "#BFBFFF",
basemaps = "CartoDB.DarkMatter",
basemaps.alpha = .5),
basemap.server = "CartoDB.DarkMatter",
basemap.alpha = .5),
beaver = list(bg.color = "#FFFFFF",
value.const = list(fill.polygons = "#FFE200",
fill = "#A30000",
col.lines = "#A30000",
col = "#00004C",
bgcol.labels_highlighted = "#FFFFFF",
bgcol = "#00000000"),
value.na = list(
fill = "grey80",
col = "grey80",
col.raster = "grey80"),
value.null = list(
fill = "grey95",
col = "grey95",
col.polygons = "grey95"),
values.var = list(fill = list(seq = "brewer.yl_or_br", div = "brewer.rd_yl_gn", unord = "brewer.dark2", ord = "brewer.yl_or_br"),
col = list(seq = "brewer.yl_or_br", div = "brewer.rd_yl_gn", unord = "brewer.dark2", ord = "brewer.yl_or_br")),
attr.color = "black"),
bw = list(color.saturation = 0),
classic = list(color.sepia.intensity = .7,
text.fontfamily = "serif",
frame = TRUE,
frame.double.line = TRUE,
compass.type = "rose")
compass.type = "rose"),
watercolor = list(value.const = list(fill = "#D95F02",
fill.dots = "red",
col.lines = "red",
col = "black",
bgcol.labels_highlighted = "white",
bgcol = "#00000000"),
value.na = list(
fill = "grey80",
col = "grey80",
col.raster = "grey80"),
value.null = list(
fill = "#FDCDAC",
col = "#FDCDAC",
col.polygons = "#FDCDAC"),
values.var = list(fill = list(seq = "brewer.greens", div = "brewer.pi_yg", unord = "brewer.pastel1", ord = "brewer.greens"),
col = list(seq = "brewer.greens", div = "brewer.pi_yg", unord = "brewer.pastel1", ord = "brewer.greens")),
basemap.server = "Stadia.StamenWatercolor")
)

.defaultTmapStyles = list(
Expand All @@ -806,14 +847,20 @@ styles = list(
natural = styles$natural,
cobalt = styles$cobalt,
albatross = styles$albatross,
beaver = styles$beaver,
bw = styles$bw,
classic = styles$classic,
watercolor = styles$watercolor,
v3 = styles$v3,
gray_v3 = c(styles$v3, styles$gray),
grey_v3 = c(styles$v3, styles$grey),
natural_v3 = c(styles$v3, styles$natural),
cobalt_v3 = c(styles$v3, styles$cobalt),
albatross_v3 = c(styles$v3, styles$albatross),
classic_v3 = c(styles$v3, styles$classic)
gray_v3 = c(styles$v3[setdiff(names(styles$v3), names(styles$gray))], styles$gray),
grey_v3 = c(styles$v3[setdiff(names(styles$v3), names(styles$grey))], styles$grey),
natural_v3 = c(styles$v3[setdiff(names(styles$v3), names(styles$natural))], styles$natural),
cobalt_v3 = c(styles$v3[setdiff(names(styles$v3), names(styles$cobalt))], styles$cobalt),
albatross_v3 = c(styles$v3[setdiff(names(styles$v3), names(styles$albatross))], styles$albatross),
beaver_v3 = c(styles$v3[setdiff(names(styles$v3), names(styles$beaver))], styles$beaver),
bw_v3 = c(styles$v3[setdiff(names(styles$v3), names(styles$bw))], styles$bw),
classic_v3 = c(styles$v3[setdiff(names(styles$v3), names(styles$classic))], styles$classic),
watercolor_v3 = c(styles$v3[setdiff(names(styles$v3), names(styles$watercolor))], styles$watercolor)
)

.defaultTmapFormats = list(World = list(inner.margins=c(0, 0.05, 0.025, 0.01),
Expand Down Expand Up @@ -843,6 +890,7 @@ styles = list(
attr.position=c("left", "bottom")))


# add/merge options x to the full option set o: x can be style options
complete_options = function(x, o) {
nmx = names(x)
nmo = names(o)
Expand All @@ -853,12 +901,30 @@ complete_options = function(x, o) {
if (length(d)) o = c(o, x[d])
if (length(e)) {
for (i in e) {
o[[i]] = complete_options(x[[i]], o[[i]])
if (i %in% c("value.const", "value.na", "value.null", "value.blank", "values.var")) {
# special case to cover the following issue
# if o = list(value.const = list(fill = "red", fill.polygons = "blue", fill.dots = "black)), and
# x = list(value.const = list(fill = "white", fill.polygons = "grey"))
# the new option set should be x (so dot fill color should be white)
o[[i]] = complete_value_list(x[[i]], o[[i]])
} else {
o[[i]] = complete_options(x[[i]], o[[i]])
}

}
}
o
}

complete_value_list = function(x, o) {
aes_x = gsub("\\..*", "", names(x))
aes_o = gsub("\\..*", "", names(o))

aes_o_not_x = setdiff(aes_o, aes_x)

c(x, o[aes_o %in% aes_o_not_x])
}

#' tmap options
#'
#' tmap options
Expand Down
42 changes: 33 additions & 9 deletions R/tmap_style.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +30,9 @@ tmap_style = function(style) {
show.messages = get("tmapOptions", envir = .TMAP)$show.messages

if (missing(style) && show.messages) {
message("current tmap style is \"", current.style, "\"")
message("other available styles are: ", print_text_vector(get_style_names(current.style)))
message("current tmap style is \"", style_names(current.style))
message("other available styles are: ", print_text_vector(get_style_names(current.style, v3 = "no")))
message("tmap v3 styles: ", print_text_vector(get_style_names(current.style, v3 = "only")))
} else {
.tmapOptions = .defaultTmapOptions
check_style(style)
Expand All @@ -47,35 +48,58 @@ tmap_style = function(style) {
assign("tmapOptions", .tmapOptions, envir = .TMAP)

if (show.messages) {
message("tmap style set to \"", style, "\"")
message("other available styles are: ", print_text_vector(get_style_names(style)))
message("style set to ", style_names(style))
message("other available styles are: ", print_text_vector(get_style_names(style, v3 = "no")))
message("tmap v3 styles: ", print_text_vector(get_style_names(style, v3 = "only")))
}
}
invisible(current.style)
}



print_text_vector = function(x) {
paste0("\"", paste(x, collapse = "\", \""), "\" ")
x2 = style_names(x)

paste(x2, collapse = ", ")
}

get_style_names = function(except_style = NULL, remove_grey = TRUE) {
style_names = function(x) {
x2 = paste0("\"", x, "\"")
x2[x2 == "\"white\""] = "\"white\" (tmap default)"
x2[x2 == "\"v3\""] = "\"v3\" (tmap v3 default)"
x2
}

get_style_names = function(except_style = NULL, remove_grey = TRUE, v3 = "yes") {
styles = c("white", names(get("tmapStyles", envir = .TMAP)))
if (!is.null(except_style)) {
styles = setdiff(styles, except_style)
}

# remove double name gray/grey
if (remove_grey) {
if (!is.null(except_style) && (except_style %in% c("gray", "grey"))) {
styles = setdiff(styles, c("gray", "grey"))
if (!is.null(except_style) && (except_style %in% c("gray", "grey", "gray_v3", "grey_v3"))) {
styles = setdiff(styles, c("gray", "grey", "gray_v3", "grey_v3"))
} else {
styles = setdiff(styles, "grey")
styles = setdiff(styles, c("grey", "grey_v3"))
}
}

is_v3 = substr(styles, nchar(styles) - 1, nchar(styles)) == "v3"

if (v3 == "no") {
styles = styles[!is_v3]
} else if (v3 == "only") {
styles = styles[is_v3]
}

styles
}




check_style = function(style) {
styles = get_style_names(remove_grey = FALSE)
if (!style %in% styles) {
Expand Down

0 comments on commit feae681

Please sign in to comment.