1
|
|
preprocess_facet_layout <- function(gm, external_legend, dh, dw) {
|
2
|
2
|
between.margin.in <- convertHeight(unit(gm$between.margin, "lines"), "inch", valueOnly=TRUE) * gm$scale
|
3
|
|
|
4
|
2
|
if (external_legend) {
|
5
|
2
|
lnpc <- gm$legend.outside.size
|
6
|
2
|
ext_leg_pos <- gm$legend.outside.position[1]
|
7
|
|
|
8
|
2
|
if (ext_leg_pos == "left") {
|
9
|
0
|
legmar <- c(0, lnpc, 0, 0)
|
10
|
2
|
} else if (ext_leg_pos == "right") {
|
11
|
2
|
legmar <- c(0, 0, 0, lnpc)
|
12
|
2
|
} else if (ext_leg_pos == "top") {
|
13
|
0
|
legmar <- c(0, 0, lnpc, 0)
|
14
|
2
|
} else if (ext_leg_pos == "bottom") {
|
15
|
2
|
legmar <- c(lnpc, 0, 0, 0)
|
16
|
2
|
}
|
17
|
|
|
18
|
2
|
} else {
|
19
|
2
|
legmar <- rep(0, 4)
|
20
|
2
|
}
|
21
|
2
|
legmarx <- sum(legmar[c(2,4)])
|
22
|
2
|
legmary <- sum(legmar[c(1,3)])
|
23
|
2
|
legW <- convertWidth(unit(legmarx, "npc"), "inch", valueOnly=TRUE)
|
24
|
2
|
legH <- convertHeight(unit(legmary, "npc"), "inch", valueOnly=TRUE)
|
25
|
|
|
26
|
2
|
if (gm$xlab.show) {
|
27
|
0
|
nlines <- gm$xlab.nlines + gm$xlab.space
|
28
|
0
|
xlabHin <- convertHeight(unit(gm$xlab.size, "lines")*(nlines*1.25), "inch", valueOnly=TRUE)
|
29
|
2
|
} else {
|
30
|
2
|
xlabHin <- 0
|
31
|
2
|
}
|
32
|
|
|
33
|
2
|
if (gm$ylab.show) {
|
34
|
0
|
nlines <- gm$ylab.nlines + gm$ylab.space
|
35
|
0
|
ylabWin <- convertHeight(unit(gm$ylab.size, "lines")*(nlines*1.25), "inch", valueOnly=TRUE)
|
36
|
2
|
} else {
|
37
|
2
|
ylabWin <- 0
|
38
|
2
|
}
|
39
|
|
|
40
|
2
|
if (gm$attr.outside) {
|
41
|
0
|
anpc <- gm$attr.outside.size
|
42
|
0
|
ext_attr_pos <- tolower(gm$attr.outside.position)
|
43
|
|
|
44
|
0
|
if (ext_attr_pos == "top") {
|
45
|
0
|
attrmar <- c(0, 0, anpc, 0)
|
46
|
0
|
} else {
|
47
|
0
|
attrmar <- c(anpc, 0, 0, 0)
|
48
|
0
|
}
|
49
|
2
|
} else {
|
50
|
2
|
attrmar <- rep(0, 4)
|
51
|
2
|
}
|
52
|
2
|
attrmary <- sum(attrmar[c(1,3)])
|
53
|
2
|
attrH <- convertHeight(unit(attrmary, "npc"), "inch", valueOnly = TRUE)
|
54
|
|
|
55
|
2
|
mainTitleLines <- max(vapply(gm$main.title, function(mt) {
|
56
|
2
|
if (mt==0) 0 else number_text_lines(mt)
|
57
|
2
|
}, numeric(1)))
|
58
|
2
|
mainH <- convertHeight(unit(mainTitleLines, "lines")*1.2*gm$main.title.size, "inch", valueOnly=TRUE)
|
59
|
2
|
mainmary <- convertHeight(unit(mainH, "inch"), "npc", valueOnly = TRUE)
|
60
|
|
|
61
|
2
|
pS <- convertHeight(unit(gm$panel.label.size, "lines"), "inch", valueOnly=TRUE) * gm$panel.label.height
|
62
|
|
|
63
|
2
|
pSH <- if (gm$panel.show) {
|
64
|
2
|
ifelse(gm$panel.label.rot[2]==0, pS, {
|
65
|
0
|
panelnames <- if (is.list(gm$panel.names)) gm$panel.names[[2]] else gm$panel.names
|
66
|
0
|
max(convertWidth(stringWidth(panelnames), "inch", valueOnly=TRUE) * 1.25 * gm$panel.label.size)
|
67
|
2
|
})
|
68
|
2
|
} else 0
|
69
|
|
|
70
|
2
|
pSW <- if (is.list(gm$panel.names) && gm$panel.show) {
|
71
|
0
|
ifelse(gm$panel.label.rot[1]==90, pS, {
|
72
|
0
|
max(convertWidth(stringWidth(gm$panel.names[[1]]), "inch", valueOnly=TRUE) * 1.25 * gm$panel.label.size)
|
73
|
0
|
})
|
74
|
2
|
} else 0
|
75
|
|
|
76
|
|
|
77
|
|
# calculate facet device size
|
78
|
2
|
if (gm$panel.mode=="none") {
|
79
|
2
|
dsw <- (dw - between.margin.in * (gm$ncol-1) - legW) / gm$ncol
|
80
|
2
|
dsh <- (dh - between.margin.in * (gm$nrow-1) - legH - attrH - mainH) / gm$nrow
|
81
|
2
|
} else if (gm$panel.mode=="one") {
|
82
|
2
|
dsw <- (dw - between.margin.in * (gm$ncol-1) - legW) / gm$ncol
|
83
|
2
|
dsh <- ((dh - between.margin.in * (gm$nrow-1) - legH - attrH - mainH) / gm$nrow) - pSH
|
84
|
2
|
} else {
|
85
|
0
|
dsw <- (dw - between.margin.in * (gm$ncol-1)-pSW - legW) / gm$ncol
|
86
|
0
|
dsh <- ((dh - between.margin.in * (gm$nrow-1)-pSH - legH - attrH - mainH) / gm$nrow)
|
87
|
2
|
}
|
88
|
|
|
89
|
|
|
90
|
|
|
91
|
2
|
return(list(legH=legH, legW=legW, attrH=attrH, mainH=mainH, pSH=pSH, pSW=pSW, legmar=legmar, legmarx=legmarx, legmary=legmary, attrmar=attrmar, attrmary=attrmary, mainmary=mainmary, xlabHin=xlabHin, ylabWin=ylabWin, between.margin.in=between.margin.in, dsh=dsh, dsw=dsw))
|
92
|
|
}
|