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
}

Read our documentation on viewing source code .

Loading