-
Notifications
You must be signed in to change notification settings - Fork 21
/
Copy pathgl.map.interactive.r
227 lines (204 loc) · 9.22 KB
/
gl.map.interactive.r
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
#' Creates an interactive map (based on latlon) from a genlight object
#'
#' @param x A genlight object (including coordinates within the latlon slot)
#' [required].
#' @param matrix A distance matrix between populations or individuals. The
#' matrix is visualised as lines between individuals/populations. If matrix is
#' asymmetric two lines with arrows are plotted [default NULL].
#' @param standard If a matrix is provided line width will be standardised to be
#' between 1 to 10, if set to true, otherwise taken as given [default TRUE].
#' @param symmetric If a symmetric matrix is provided only one line is drawn
#' based on the lower triangle of the matrix. If set to false arrows indicating
#' the direction are used instead [default TRUE].
#' @param pop.labels Population labels at the center of the individuals of
#' populations [default TRUE].
#' @param pop.labels.cex Size of population labels [default 12].
#' @param ind.circles Should individuals plotted as circles [default TRUE].
#' @param ind.circle.cols colors off circles. Colors can be provided as usual by names (e.g. "black") and are re-cycled. So a color c("blue","red") colors individuals alternatively between blue and red using the genlight object order of inidividuals. For transparency see parameter ind.circle.transparency. Defaults to rainbow colors by population if not provided. If you want to have your own colors for each population, check the platypus.gl example below.
#' @param ind.circle.cex (size or circles in pixels ). Defaults to 10.
#' @param ind.circle.transparency Transparency of circles between 0=invisible and 1=no transparency. Defaults to 0.8.
#' @param provider Passed to leaflet [default "Esri.NatGeoWorldMap"].
#' @param verbose Verbosity: 0, silent or fatal errors; 1, begin and end; 2,
#' progress log; 3, progress and results summary; 5, full report
#' [default 2, unless specified using gl.set.verbosity].
#' @return plots a map
#' @importFrom methods is
#' @export
#' @details
#' A wrapper around the \pkg{leaflet} package. For possible background
#' maps check as specified via the provider:
#' \url{http://leaflet-extras.github.io/leaflet-providers/preview/index.html}
#' @author Bernd Gruber -- Post to \url{https://groups.google.com/d/forum/dartr}
#' @examples
#' gl.map.interactive(bandicoot.gl)
#' cols <- c("red","blue","yellow")[as.numeric(pop(platypus.gl))]
#' gl.map.interactive(platypus.gl, ind.circle.cols=cols, ind.circle.cex=10, ind.circle.transparency=0.5)
gl.map.interactive <- function(x,
matrix = NULL,
standard = TRUE,
symmetric = TRUE,
pop.labels = TRUE,
pop.labels.cex = 12,
ind.circles = TRUE,
ind.circle.cols = NULL,
ind.circle.cex=10,
ind.circle.transparency=0.8,
provider = "Esri.NatGeoWorldMap",
verbose = NULL) {
# SET VERBOSITY
verbose <- gl.check.verbosity(verbose)
# FLAG SCRIPT START
funname <- match.call()[[1]]
utils.flag.start(func = funname,
build = "Jody",
verbosity = verbose)
# CHECK DATATYPE
datatype <- utils.check.datatype(x, verbose = verbose)
# FUNCTION SPECIFIC ERROR CHECKING
# CHECK IF PACKAGES ARE INSTALLED
pkg <- "leaflet"
if (!(requireNamespace(pkg, quietly = TRUE))) {
stop(error("Package",
pkg,
" needed for this function to work. Please install it."))
}
pkg <- "leaflet.minicharts"
if (!(requireNamespace(pkg, quietly = TRUE))) {
stop(error("Package",
pkg,
" needed for this function to work. Please install it."))
} else {
if (is.null(x@other$latlon)) {
stop(error(
"No valid coordinates are supplied at gl@other$latlon"
))
}
if (sum(colnames(x@other$latlon) %in% c("lat", "lon")) != 2) {
stop(error(
"Coordinates under gl@other$latlon are not named 'lat' and 'lon'."
))
}
if (!is.null(matrix)) {
if (nrow(matrix) != nInd(x) & nrow(matrix) != nPop(x)) {
stop(
error(
"The dimension of the provided matrix does neither match the number of individuals nor the number of populations."
)
)
}
}
if (is.null(ind.circle.cols))
{
cols <- rainbow(nPop(x))
cols <- substr(cols, 1, 7)
ic <- cols[as.numeric(pop(x))]
} else ic <- ind.circle.cols
df <- x@other$latlon
centers <-
apply(df, 2, function(xx)
tapply(xx, pop(x), mean, na.rm = TRUE))
# when there is just one population the output of centers is a vector
#the following lines fix this error
if (nPop(x) == 1) {
centers <- data.frame(lon = centers[1], lat = centers[2])
row.names(centers) <- popNames(x)
}
# Add default OpenStreetMap map tiles
m <- leaflet::leaflet() %>%
leaflet::addTiles()
if (ind.circles) {
m <- m %>%
leaflet::addCircles(
lng = df$lon,
lat = df$lat,
popup = indNames(x),
color = ic,
opacity = ind.circle.transparency,
weight = ind.circle.cex
)
}
if (pop.labels) {
m <- m %>%
leaflet::addLabelOnlyMarkers(
lng = centers[, "lon"],
lat = centers[, "lat"],
label = popNames(x),
labelOptions = leaflet::labelOptions(
noHide = T,
direction = "top",
textOnly = T,
textsize = paste0(pop.labels.cex, "px")
)
)
}
if (!is.null(matrix)) {
# standardize
if (standard) {
matrix[, ] <-
((matrix[, ] - min(matrix, na.rm = T)) / (max(matrix, na.rm = T) - min(matrix, na.rm = T))) * 9 + 1
}
if (nrow(matrix) == nPop(x)) {
xys <- centers
} else {
xys <- df
}
if (symmetric) {
for (ii in 1:nrow(matrix)) {
for (i in ii:nrow(matrix)) {
if (!is.null(matrix[i, ii]))
m <- m %>%
leaflet::addPolylines(
lng = c(xys[i, "lon"], xys[ii, "lon"]),
lat = c(xys[i, "lat"], xys[ii, "lat"]),
weight = matrix[i,
ii],
color = "#0000FF",
opacity = 1
)
}
}
}
if (!symmetric) {
for (i in 1:nrow(matrix)) {
for (ii in 1:nrow(matrix)) {
if (abs((i - ii)) != 0) {
from <- xys[i, ]
to <- xys[ii, ]
if (!is.null(matrix[i, ii]) &
!is.null(matrix[ii, i])) {
if (matrix[i, ii] > matrix[ii, i])
lcols = "#FFAA00"
else
lcols = "#00AAFF"
if (matrix[i, ii] == matrix[ii, i])
lcols = "#00AA00"
} else
lcols = "#333333"
m <- m %>%
leaflet.minicharts::addFlows(
lng0 = as.numeric(from["lon"]),
lng1 = as.numeric(to["lon"]),
lat0 = as.numeric(from["lat"]),
lat1 = as.numeric(to["lat"]),
flow = matrix[i, ii],
color = lcols,
maxThickness = 10,
minThickness = 1,
maxFlow = max(matrix,
na.rm = T),
opacity = 0.8
)
}
}
}
}
}
# FLAG SCRIPT END
if (verbose >= 1) {
cat(report("Completed:", funname, "\n"))
}
# RETURN
m %>%
leaflet::addProviderTiles(provider)
}
}