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
}

Read our documentation on viewing source code .

Loading