|
1
|
|
process_dtlwd <- function(dtlwd, g, gt, nx, npol, varylwd, col.neutral) {
|
|
2
|
2
|
reverse <- g$legend.lwd.reverse
|
|
3
|
2
|
is.constant <- FALSE
|
|
4
|
2
|
if (is.list(dtlwd)) {
|
|
5
|
|
# multiple variables for lwd are defined
|
|
6
|
2
|
gsl <- split_g(g, n=nx)
|
|
7
|
|
#if (!all(sapply(dtlwd, is.numeric))) stop("lwd argument of tm_lines contains a non-numeric variable", call. = FALSE)
|
|
8
|
|
# only get title_append from columns
|
|
9
|
2
|
title_append <- vapply(mapply(check_num_col, dtlwd, gsl, SIMPLIFY = FALSE), "[[", character(1), "title_append")
|
|
10
|
|
|
|
11
|
|
|
|
12
|
2
|
res <- mapply(process_line_lwd_vector, dtlwd, gsl, MoreArgs = list(rescale=varylwd, reverse=reverse), SIMPLIFY = FALSE)
|
|
13
|
2
|
line.lwd <- sapply(res, function(r)r$line.lwd)
|
|
14
|
2
|
line.legend.lwds <- lapply(res, function(r)r$line.legend.lwds)
|
|
15
|
2
|
line.lwd.legend.labels <- lapply(res, function(r)r$line.lwd.legend.labels)
|
|
16
|
2
|
line.lwd.legend.values <- lapply(res, function(r)r$line.lwd.legend.values)
|
|
17
|
2
|
} else {
|
|
18
|
2
|
if (!is.numeric(dtlwd)) stop("lwd argument of tm_lines is not a numeric variable", call. = FALSE)
|
|
19
|
|
|
|
20
|
2
|
title_append <- check_num_col(dtlwd, g)$title_append
|
|
21
|
|
|
|
22
|
|
|
|
23
|
2
|
res <- process_line_lwd_vector(dtlwd, g, rescale=varylwd, reverse=reverse)
|
|
24
|
2
|
line.lwd <- matrix(res$line.lwd, nrow=npol)
|
|
25
|
2
|
if (varylwd) {
|
|
26
|
2
|
line.legend.lwds <- res$line.legend.lwds
|
|
27
|
2
|
line.lwd.legend.labels <- res$line.lwd.legend.labels
|
|
28
|
2
|
line.lwd.legend.values <- res$line.lwd.legend.values
|
|
29
|
2
|
} else {
|
|
30
|
2
|
line.legend.lwds <- NA
|
|
31
|
2
|
line.lwd.legend.labels <- NA
|
|
32
|
2
|
line.lwd.legend.values <- NA
|
|
33
|
2
|
is.constant <- TRUE
|
|
34
|
2
|
}
|
|
35
|
2
|
}
|
|
36
|
2
|
lwd.nonemptyFacets <- if (is.constant) NULL else apply(line.lwd, MARGIN = 2, function(v) !all(is.na(v)))
|
|
37
|
|
|
|
38
|
|
#
|
|
39
|
|
# list(is.constant=is.constant,
|
|
40
|
|
# col=col,
|
|
41
|
|
# legend.labels=legend.labels,
|
|
42
|
|
# legend.values=legend.values,
|
|
43
|
|
# legend.palette=legend.palette,
|
|
44
|
|
# col.neutral=col.neutral,
|
|
45
|
|
# legend.misc = legend.misc,
|
|
46
|
|
# legend.hist.misc=list(values=values, breaks=breaks, densities=g$convert2density),
|
|
47
|
|
# nonemptyFacets=nonemptyFacets,
|
|
48
|
|
# title_append=title_append)
|
|
49
|
|
|
|
50
|
2
|
list(is.constant=is.constant,
|
|
51
|
2
|
lwd=line.lwd,
|
|
52
|
2
|
legend.labels=line.lwd.legend.labels,
|
|
53
|
2
|
legend.values=line.lwd.legend.values,
|
|
54
|
2
|
legend.palette=col.neutral,
|
|
55
|
2
|
legend.misc=list(legend.lwds=line.legend.lwds,
|
|
56
|
2
|
line.legend.lty=g$lty,
|
|
57
|
2
|
line.legend.alpha=g$alpha),
|
|
58
|
2
|
nonemptyFacets = lwd.nonemptyFacets,
|
|
59
|
2
|
title_append = title_append)
|
|
60
|
|
}
|
|
61
|
|
|
|
62
|
|
|
|
63
|
|
|
|
64
|
|
process_line_lwd_vector <- function(x, g, rescale, reverse) {
|
|
65
|
2
|
check_aes_args(g)
|
|
66
|
|
|
|
67
|
|
|
|
68
|
2
|
if (all(is.na(x))) {
|
|
69
|
2
|
return(list(
|
|
70
|
2
|
line.lwd=rep(NA, length.out=length(x)),
|
|
71
|
2
|
line.legend.lwds=NA,
|
|
72
|
2
|
line.lwd.legend.labels=NA,
|
|
73
|
2
|
line.lwd.legend.values=NA))
|
|
74
|
2
|
}
|
|
75
|
|
|
|
76
|
2
|
if (!is.numeric(x)) stop("lwd argument of tm_lines contains a non-numeric variable", call. = FALSE)
|
|
77
|
|
|
|
78
|
2
|
if (is.null(g$lwd.legend)) {
|
|
79
|
2
|
w_legend <- pretty(x, 7)
|
|
80
|
2
|
w_legend <- w_legend[w_legend!=0]
|
|
81
|
2
|
w_legend <- w_legend[-c(length(w_legend)-3,length(w_legend)-1)]
|
|
82
|
2
|
} else {
|
|
83
|
0
|
w_legend <- g$lwd.legend
|
|
84
|
2
|
}
|
|
85
|
|
|
|
86
|
|
|
|
87
|
|
|
|
88
|
2
|
maxW <- ifelse(rescale, max(x, na.rm=TRUE), 1)
|
|
89
|
2
|
line.legend.lwds <- g$scale * (w_legend/maxW)
|
|
90
|
2
|
line.lwd.legend.values <- w_legend
|
|
91
|
2
|
line.lwd.legend.labels <- format(w_legend, trim=TRUE)
|
|
92
|
|
|
|
93
|
2
|
if (is.null(g$line.lwd.legend.labels)) {
|
|
94
|
2
|
line.lwd.legend.labels <- do.call("fancy_breaks", c(list(vec=w_legend, intervals=FALSE), g$legend.format))
|
|
95
|
2
|
} else {
|
|
96
|
0
|
if (length(g$line.lwd.legend.labels) != length(w_legend)) stop("length of sizes.legend.labels is not equal to the number of lines in the legend", call. = FALSE)
|
|
97
|
0
|
line.lwd.legend.labels <- g$line.lwd.legend.labels
|
|
98
|
0
|
attr(line.lwd.legend.labels, "align") <- g$legend.format$text.align
|
|
99
|
2
|
}
|
|
100
|
|
|
|
101
|
2
|
line.lwd <- g$scale * (x/maxW)
|
|
102
|
2
|
if (reverse) {
|
|
103
|
0
|
line.legend.lwds <- rev(line.legend.lwds)
|
|
104
|
0
|
line.lwd.legend.labels <- rev(line.lwd.legend.labels)
|
|
105
|
2
|
}
|
|
106
|
|
|
|
107
|
2
|
list(line.lwd=line.lwd,
|
|
108
|
2
|
line.legend.lwds=line.legend.lwds,
|
|
109
|
2
|
line.lwd.legend.labels=line.lwd.legend.labels,
|
|
110
|
2
|
line.lwd.legend.values=line.lwd.legend.values)
|
|
111
|
|
}
|
mtennekes