如何调整分面 tmap 图中的分面行标签高度？
How do you adjust facet row label height in faceted tmap plots?
我正在使用带有行和列的“tmap”包绘制分面图。我无法调整行的分面标签的高度，这导致分面标签在大于特定尺寸或旋转时被裁剪。
我已经尝试调整面板的所有 tm_layout() 参数，包括 panel.label.height、panel.label.size 和 panel.label.rot.（使用 R 3.5.3、tmap_2。 3 和 tmaptools_2.0-2)。 Panel.label.height 似乎只影响列的面板高度。我觉得我需要像 panel.label.width 这样的东西来对标签行做同样的事情。
library(tmap);library(dplyr)
data(metro)
metro_edited <- metro %>%
mutate(pop1950cat = cut(pop1950, breaks=c(5, 10, 40)*1e6),
pop2020cat = cut(pop2020, breaks=c(5, 10, 40)*1e6))
tm_shape(metro_edited) +
tm_dots("red", size = .5) +
tm_facets(c("pop1950cat", "pop2020cat"),
free.coords = FALSE)+
tm_layout(panel.label.height=5, panel.label.size = 1, panel.label.rot = c(0,0))
我希望行面的面板标签高度也增加到 5，以便我可以阅读面板中的标签，但它们似乎是固定的，并且如图输出所示被裁剪。
tmap 的 process_facet_layout 函数中存在错误。
我对其进行了修改，现在行面的宽度与列面的宽度一样得到了正确计算。
library(tmap)
library(dplyr)
library(grid)
process_facet_layout <- function(gm) {
panel.mode <- outer.margins <- attr.outside.position <- legend.outside.position <- NULL
fpi <- gm$shape.fpi
if (gm$panel.mode=="none") {
dh2 <- gm$shape.dh - fpi$legH - fpi$attrH - fpi$mainH - (gm$nrow - 1) * fpi$between.margin.in - fpi$xlabHin - gm$nrow * fpi$xgridHin
dw2 <- gm$shape.dw - fpi$legW - (gm$ncol - 1) * fpi$between.margin.in - fpi$ylabWin - gm$ncol * fpi$ygridWin
} else if (gm$panel.mode=="one") {
dh2 <- gm$shape.dh - fpi$legH - fpi$attrH - fpi$mainH - gm$nrow * fpi$pSH - (gm$nrow - 1) * fpi$between.margin.in - fpi$xlabHin - gm$nrow * fpi$xgridHin
dw2 <- gm$shape.dw - fpi$legW - (gm$ncol - 1) * fpi$between.margin.in - fpi$ylabWin - gm$ncol * fpi$ygridWin
} else {
dh2 <- gm$shape.dh - fpi$legH - fpi$attrH - fpi$mainH - fpi$pSH - fpi$between.margin.in * gm$nrow - fpi$xlabHin - gm$nrow * fpi$xgridHin
dw2 <- gm$shape.dw - fpi$legW - fpi$pSW - fpi$between.margin.in * gm$ncol - fpi$ylabWin - gm$ncol * fpi$ygridWin+1
}
dasp2 <- dw2/dh2
hasp <- gm$shape.sasp * gm$ncol / gm$nrow
if (hasp>dasp2) {
fW <- dw2
fH <- dw2 / hasp
} else {
fH <- dh2
fW <- dh2 * hasp
}
gasp <- fW/fH
if (gasp>dasp2) {
xs <- 0
ys <- convertHeight(unit(dh2-(dw2 / gasp), "inch"), "npc", valueOnly=TRUE)
} else {
xs <- convertWidth(unit(dw2-(gasp * dh2), "inch"), "npc", valueOnly=TRUE)
ys <- 0
}
outerx <- sum(gm$outer.margins[c(2,4)])
outery <- sum(gm$outer.margins[c(1,3)])
spc <- 1e-5
gm <- within(gm, {
between.margin.y <- convertHeight(unit(fpi$between.margin.in, "inch"), "npc", valueOnly=TRUE)
between.margin.x <- convertWidth(unit(fpi$between.margin.in, "inch"), "npc", valueOnly=TRUE)
panelh <- convertHeight(unit(fpi$pSH, "inch"), "npc", valueOnly=TRUE)
panelw <- convertWidth(unit(fpi$pSW, "inch"), "npc", valueOnly=TRUE)
ylabWnpc <- convertWidth(unit(fpi$ylabWin, "inch"), "npc", valueOnly=TRUE)
xlabHnpc <- convertHeight(unit(fpi$xlabHin, "inch"), "npc", valueOnly=TRUE)
ygridWnpc <- convertWidth(unit(fpi$ygridWin, "inch"), "npc", valueOnly=TRUE)
xgridHnpc <- convertHeight(unit(fpi$xgridHin, "inch"), "npc", valueOnly=TRUE)
attr.between.legend.and.map <- attr.outside.position %in% c("top", "bottom")
if (panel.mode=="none") {
colrange <- (1:ncol)*3 + 3
rowrange <- (1:nrow)*3 + 3
facetw <- ((1-spc-outerx)-xs-fpi$legmarx-ylabWnpc-between.margin.x*(ncol-1))/ncol-ygridWnpc
faceth <- ((1-spc-outery)-ys-fpi$legmary-fpi$attrmary-fpi$mainmary-xlabHnpc-between.margin.y*(nrow-1))/nrow-xgridHnpc
colws <- c(outer.margins[2], xs/2, fpi$legmar[2], ylabWnpc, rep(c(ygridWnpc, facetw, between.margin.x), ncol-1), ygridWnpc, facetw, fpi$legmar[4], xs/2, outer.margins[4])
if (attr.between.legend.and.map) {
rowhs <- c(outer.margins[3], ys/2, fpi$mainmary, fpi$legmar[3], fpi$attrmar[3], rep(c(faceth, xgridHnpc, between.margin.y), nrow-1), faceth, xgridHnpc, xlabHnpc, fpi$attrmar[1], fpi$legmar[1], ys/2, outer.margins[1])
} else {
rowhs <- c(outer.margins[3], ys/2, fpi$mainmary, fpi$attrmar[3], fpi$legmar[3], rep(c(faceth, xgridHnpc, between.margin.y), nrow-1), faceth, xgridHnpc, xlabHnpc, fpi$legmar[1], fpi$attrmar[1], ys/2, outer.margins[1])
}
} else if (panel.mode=="one") {
colrange <- (1:ncol)*3 + 3
rowrange <- (1:nrow)*4 + 3
facetw <- ((1-spc-outerx)-xs-fpi$legmarx-ylabWnpc-between.margin.x*(ncol-1))/ncol-ygridWnpc
faceth <- ((1-spc-outery)-ys-fpi$legmary-fpi$attrmary-fpi$mainmary-xlabHnpc-between.margin.y*(nrow-1))/nrow - panelh-xgridHnpc
colws <- c(outer.margins[2], xs/2, fpi$legmar[2], ylabWnpc, ygridWnpc, rep(c(facetw, between.margin.x, ygridWnpc), ncol-1), facetw, fpi$legmar[4], xs/2, outer.margins[4])
if (attr.between.legend.and.map) {
rowhs <- c(outer.margins[3], ys/2, fpi$mainmary, fpi$legmar[3], fpi$attrmar[3], rep(c(panelh, faceth, xgridHnpc, between.margin.y), nrow-1), panelh, faceth, xgridHnpc, xlabHnpc, fpi$attrmar[1], fpi$legmar[1], ys/2, outer.margins[1])
} else {
rowhs <- c(outer.margins[3], ys/2, fpi$mainmary, fpi$attrmar[3], fpi$legmar[3], rep(c(panelh, faceth, xgridHnpc, between.margin.y), nrow-1), panelh, faceth, xgridHnpc, xlabHnpc, fpi$legmar[1], fpi$attrmar[1], ys/2, outer.margins[1])
}
} else {
colrange <- (1:ncol)*3 + 5
rowrange <- (1:nrow)*3 + 5
colpanelrow <- 6
rowpanelcol <- 6 #5
facetw <- ((1-spc-outerx)-xs-fpi$legmarx-ylabWnpc-between.margin.x*ncol-panelw)/ncol-ygridWnpc
faceth <- ((1-spc-outery)-ys-fpi$legmary-fpi$attrmary-fpi$mainmary-xlabHnpc-between.margin.y*nrow-panelh)/nrow-xgridHnpc
# Here is the modified code
colws <- c(outer.margins[2], xs/2, fpi$legmar[2], ylabWnpc, panelw, c(panelw, ygridWnpc, facetw), rep(c(between.margin.x, ygridWnpc, facetw), ncol-1), fpi$legmar[4], xs/2, outer.margins[4])
if (attr.between.legend.and.map) {
rowhs <- c(outer.margins[3], ys/2, fpi$mainmary, fpi$legmar[3], fpi$attrmar[3], panelh, rep(c(between.margin.y, faceth, xgridHnpc), nrow), xlabHnpc, fpi$attrmar[1],fpi$legmar[1], ys/2, outer.margins[1])
} else {
rowhs <- c(outer.margins[3], ys/2, fpi$mainmary, fpi$attrmar[3], fpi$legmar[3], panelh, rep(c(between.margin.y, faceth, xgridHnpc), nrow), xgridHnpc, xlabHnpc, fpi$legmar[1], fpi$attrmar[1], ys/2, outer.margins[1])
}
}
if (legend.outside.position[1] == "left") {
legx <- 3
legy <- 5:(length(rowhs)-5)
} else if (legend.outside.position[1] == "right") {
legx <- length(colws)-2
legy <- 5:(length(rowhs)-5)
} else if (legend.outside.position[1] == "top") {
legy <- 4- attr.between.legend.and.map
legx <- 5:(length(colws)-3)
} else if (legend.outside.position[1] == "bottom") {
legy <- length(rowhs)-3 + attr.between.legend.and.map
legx <- 5:(length(colws)-3)
}
if (tolower(attr.outside.position[1]) == "top") {
attry <- 3 + attr.between.legend.and.map
attrx <- 5:(length(colws)-3)
} else {
attry <- length(rowhs)-2 - attr.between.legend.and.map
attrx <- 5:(length(colws)-3)
}
xlaby <- length(rowhs)-4
xlabx <- 5:(length(colws)-3)
ylaby <- 5:(length(rowhs)-5)
ylabx <- 4
})
gm$gasp <- unname(gasp)
gm
}
assignInNamespace(x="process_facet_layout", value=process_facet_layout, ns="tmap")
data(metro)
metro_edited <- metro %>%
mutate(pop1950cat = cut(pop1950, breaks=c(5, 10, 40)*1e6),
pop2020cat = cut(pop2020, breaks=c(5, 10, 40)*1e6))
tm_shape(metro_edited) +
tm_dots("red", size = .5) +
tm_facets(c("pop1950cat", "pop2020cat"), free.coords=FALSE)+
tm_layout(panel.label.height=1, panel.label.size=3, panel.label.rot = c(90,0))
我正在使用带有行和列的“tmap”包绘制分面图。我无法调整行的分面标签的高度，这导致分面标签在大于特定尺寸或旋转时被裁剪。
我已经尝试调整面板的所有 tm_layout() 参数，包括 panel.label.height、panel.label.size 和 panel.label.rot.（使用 R 3.5.3、tmap_2。 3 和 tmaptools_2.0-2)。 Panel.label.height 似乎只影响列的面板高度。我觉得我需要像 panel.label.width 这样的东西来对标签行做同样的事情。
library(tmap);library(dplyr)
data(metro)
metro_edited <- metro %>%
mutate(pop1950cat = cut(pop1950, breaks=c(5, 10, 40)*1e6),
pop2020cat = cut(pop2020, breaks=c(5, 10, 40)*1e6))
tm_shape(metro_edited) +
tm_dots("red", size = .5) +
tm_facets(c("pop1950cat", "pop2020cat"),
free.coords = FALSE)+
tm_layout(panel.label.height=5, panel.label.size = 1, panel.label.rot = c(0,0))
我希望行面的面板标签高度也增加到 5，以便我可以阅读面板中的标签，但它们似乎是固定的，并且如图输出所示被裁剪。
tmap 的 process_facet_layout 函数中存在错误。
我对其进行了修改，现在行面的宽度与列面的宽度一样得到了正确计算。
library(tmap)
library(dplyr)
library(grid)
process_facet_layout <- function(gm) {
panel.mode <- outer.margins <- attr.outside.position <- legend.outside.position <- NULL
fpi <- gm$shape.fpi
if (gm$panel.mode=="none") {
dh2 <- gm$shape.dh - fpi$legH - fpi$attrH - fpi$mainH - (gm$nrow - 1) * fpi$between.margin.in - fpi$xlabHin - gm$nrow * fpi$xgridHin
dw2 <- gm$shape.dw - fpi$legW - (gm$ncol - 1) * fpi$between.margin.in - fpi$ylabWin - gm$ncol * fpi$ygridWin
} else if (gm$panel.mode=="one") {
dh2 <- gm$shape.dh - fpi$legH - fpi$attrH - fpi$mainH - gm$nrow * fpi$pSH - (gm$nrow - 1) * fpi$between.margin.in - fpi$xlabHin - gm$nrow * fpi$xgridHin
dw2 <- gm$shape.dw - fpi$legW - (gm$ncol - 1) * fpi$between.margin.in - fpi$ylabWin - gm$ncol * fpi$ygridWin
} else {
dh2 <- gm$shape.dh - fpi$legH - fpi$attrH - fpi$mainH - fpi$pSH - fpi$between.margin.in * gm$nrow - fpi$xlabHin - gm$nrow * fpi$xgridHin
dw2 <- gm$shape.dw - fpi$legW - fpi$pSW - fpi$between.margin.in * gm$ncol - fpi$ylabWin - gm$ncol * fpi$ygridWin+1
}
dasp2 <- dw2/dh2
hasp <- gm$shape.sasp * gm$ncol / gm$nrow
if (hasp>dasp2) {
fW <- dw2
fH <- dw2 / hasp
} else {
fH <- dh2
fW <- dh2 * hasp
}
gasp <- fW/fH
if (gasp>dasp2) {
xs <- 0
ys <- convertHeight(unit(dh2-(dw2 / gasp), "inch"), "npc", valueOnly=TRUE)
} else {
xs <- convertWidth(unit(dw2-(gasp * dh2), "inch"), "npc", valueOnly=TRUE)
ys <- 0
}
outerx <- sum(gm$outer.margins[c(2,4)])
outery <- sum(gm$outer.margins[c(1,3)])
spc <- 1e-5
gm <- within(gm, {
between.margin.y <- convertHeight(unit(fpi$between.margin.in, "inch"), "npc", valueOnly=TRUE)
between.margin.x <- convertWidth(unit(fpi$between.margin.in, "inch"), "npc", valueOnly=TRUE)
panelh <- convertHeight(unit(fpi$pSH, "inch"), "npc", valueOnly=TRUE)
panelw <- convertWidth(unit(fpi$pSW, "inch"), "npc", valueOnly=TRUE)
ylabWnpc <- convertWidth(unit(fpi$ylabWin, "inch"), "npc", valueOnly=TRUE)
xlabHnpc <- convertHeight(unit(fpi$xlabHin, "inch"), "npc", valueOnly=TRUE)
ygridWnpc <- convertWidth(unit(fpi$ygridWin, "inch"), "npc", valueOnly=TRUE)
xgridHnpc <- convertHeight(unit(fpi$xgridHin, "inch"), "npc", valueOnly=TRUE)
attr.between.legend.and.map <- attr.outside.position %in% c("top", "bottom")
if (panel.mode=="none") {
colrange <- (1:ncol)*3 + 3
rowrange <- (1:nrow)*3 + 3
facetw <- ((1-spc-outerx)-xs-fpi$legmarx-ylabWnpc-between.margin.x*(ncol-1))/ncol-ygridWnpc
faceth <- ((1-spc-outery)-ys-fpi$legmary-fpi$attrmary-fpi$mainmary-xlabHnpc-between.margin.y*(nrow-1))/nrow-xgridHnpc
colws <- c(outer.margins[2], xs/2, fpi$legmar[2], ylabWnpc, rep(c(ygridWnpc, facetw, between.margin.x), ncol-1), ygridWnpc, facetw, fpi$legmar[4], xs/2, outer.margins[4])
if (attr.between.legend.and.map) {
rowhs <- c(outer.margins[3], ys/2, fpi$mainmary, fpi$legmar[3], fpi$attrmar[3], rep(c(faceth, xgridHnpc, between.margin.y), nrow-1), faceth, xgridHnpc, xlabHnpc, fpi$attrmar[1], fpi$legmar[1], ys/2, outer.margins[1])
} else {
rowhs <- c(outer.margins[3], ys/2, fpi$mainmary, fpi$attrmar[3], fpi$legmar[3], rep(c(faceth, xgridHnpc, between.margin.y), nrow-1), faceth, xgridHnpc, xlabHnpc, fpi$legmar[1], fpi$attrmar[1], ys/2, outer.margins[1])
}
} else if (panel.mode=="one") {
colrange <- (1:ncol)*3 + 3
rowrange <- (1:nrow)*4 + 3
facetw <- ((1-spc-outerx)-xs-fpi$legmarx-ylabWnpc-between.margin.x*(ncol-1))/ncol-ygridWnpc
faceth <- ((1-spc-outery)-ys-fpi$legmary-fpi$attrmary-fpi$mainmary-xlabHnpc-between.margin.y*(nrow-1))/nrow - panelh-xgridHnpc
colws <- c(outer.margins[2], xs/2, fpi$legmar[2], ylabWnpc, ygridWnpc, rep(c(facetw, between.margin.x, ygridWnpc), ncol-1), facetw, fpi$legmar[4], xs/2, outer.margins[4])
if (attr.between.legend.and.map) {
rowhs <- c(outer.margins[3], ys/2, fpi$mainmary, fpi$legmar[3], fpi$attrmar[3], rep(c(panelh, faceth, xgridHnpc, between.margin.y), nrow-1), panelh, faceth, xgridHnpc, xlabHnpc, fpi$attrmar[1], fpi$legmar[1], ys/2, outer.margins[1])
} else {
rowhs <- c(outer.margins[3], ys/2, fpi$mainmary, fpi$attrmar[3], fpi$legmar[3], rep(c(panelh, faceth, xgridHnpc, between.margin.y), nrow-1), panelh, faceth, xgridHnpc, xlabHnpc, fpi$legmar[1], fpi$attrmar[1], ys/2, outer.margins[1])
}
} else {
colrange <- (1:ncol)*3 + 5
rowrange <- (1:nrow)*3 + 5
colpanelrow <- 6
rowpanelcol <- 6 #5
facetw <- ((1-spc-outerx)-xs-fpi$legmarx-ylabWnpc-between.margin.x*ncol-panelw)/ncol-ygridWnpc
faceth <- ((1-spc-outery)-ys-fpi$legmary-fpi$attrmary-fpi$mainmary-xlabHnpc-between.margin.y*nrow-panelh)/nrow-xgridHnpc
# Here is the modified code
colws <- c(outer.margins[2], xs/2, fpi$legmar[2], ylabWnpc, panelw, c(panelw, ygridWnpc, facetw), rep(c(between.margin.x, ygridWnpc, facetw), ncol-1), fpi$legmar[4], xs/2, outer.margins[4])
if (attr.between.legend.and.map) {
rowhs <- c(outer.margins[3], ys/2, fpi$mainmary, fpi$legmar[3], fpi$attrmar[3], panelh, rep(c(between.margin.y, faceth, xgridHnpc), nrow), xlabHnpc, fpi$attrmar[1],fpi$legmar[1], ys/2, outer.margins[1])
} else {
rowhs <- c(outer.margins[3], ys/2, fpi$mainmary, fpi$attrmar[3], fpi$legmar[3], panelh, rep(c(between.margin.y, faceth, xgridHnpc), nrow), xgridHnpc, xlabHnpc, fpi$legmar[1], fpi$attrmar[1], ys/2, outer.margins[1])
}
}
if (legend.outside.position[1] == "left") {
legx <- 3
legy <- 5:(length(rowhs)-5)
} else if (legend.outside.position[1] == "right") {
legx <- length(colws)-2
legy <- 5:(length(rowhs)-5)
} else if (legend.outside.position[1] == "top") {
legy <- 4- attr.between.legend.and.map
legx <- 5:(length(colws)-3)
} else if (legend.outside.position[1] == "bottom") {
legy <- length(rowhs)-3 + attr.between.legend.and.map
legx <- 5:(length(colws)-3)
}
if (tolower(attr.outside.position[1]) == "top") {
attry <- 3 + attr.between.legend.and.map
attrx <- 5:(length(colws)-3)
} else {
attry <- length(rowhs)-2 - attr.between.legend.and.map
attrx <- 5:(length(colws)-3)
}
xlaby <- length(rowhs)-4
xlabx <- 5:(length(colws)-3)
ylaby <- 5:(length(rowhs)-5)
ylabx <- 4
})
gm$gasp <- unname(gasp)
gm
}
assignInNamespace(x="process_facet_layout", value=process_facet_layout, ns="tmap")
data(metro)
metro_edited <- metro %>%
mutate(pop1950cat = cut(pop1950, breaks=c(5, 10, 40)*1e6),
pop2020cat = cut(pop2020, breaks=c(5, 10, 40)*1e6))
tm_shape(metro_edited) +
tm_dots("red", size = .5) +
tm_facets(c("pop1950cat", "pop2020cat"), free.coords=FALSE)+
tm_layout(panel.label.height=1, panel.label.size=3, panel.label.rot = c(90,0))