plot_interactive.r 7.52 KB
Newer Older
1
2
#' Plot Habitat Types
#'
3
#' A quick wrapper to produce an interactive raster map of habitat type probability in a web browser using leaflet
4
#'
5
6
7
8
9
10
11
#' @param x probability image (*rasterObject)
#' @param y RGB image (*rasterObject)
#' @param HaTy name of habitat type (character)
#' @param r red channel (integer)
#' @param g green channel (integer)
#' @param b blue channel (integer)
#' @param acc predictive accuracy (integer)
12
#' @param num_models number of selected models
13
#' @param nb_models number of models (independent classifiers) for the specification in the legend
14
#' @param color color pallet
15
#' @param outPath file path for '.html export (character)
16
#' @param plot_on_browser plot on the browser or inline in a notebook (default TRUE)
17
#' @return a leafLet map
18
19
#'
#' @export
20
21
22
23
24
25
26
27
iplot <- function(x,
                  y,
                  HaTy,
                  r,
                  g,
                  b,
                  acc,
                  num_models,
28
                  nb_models,
29
30
31
32
                  color,
                  outPath,
                  plot_on_browser = TRUE) {
  
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
  #x=layerInfo, y=RGB Image
  ##############################################################################
  if (exists("color") == F) {
    pal <-
      leaflet::colorNumeric(
        c(
          "lightgrey",
          "orange",
          "yellow",
          "limegreen",
          "forestgreen"
        ),
        domain = NULL,
        na.color = "transparent"
      )
  } else {
    pal <-
      leaflet::colorNumeric(color, domain = NULL, na.color = "transparent")
  }
  ##############################################################################
  ###[1] Create RGB Colors (z) and RGB Image Representation (rr) -> code based
  ### on raster::plotRGB
  linStretchVec <- function (x) {
carstennh's avatar
carstennh committed
56
    v <- stats::quantile(x, c(0.02, 0.98), na.rm = TRUE)
57
    temp <- (255 * (x - v[1])) / (v[2] - v[1])
carstennh's avatar
carstennh committed
58
59
60
    temp[temp < 0] <- 0
    temp[temp > 255] <- 255
    return(temp)
61
62
63
64
65
66
67
68
69
70
  }
  palo <- function(y) {
    d <- which(y <= 0)
    if (length(d) > 0) {
      y[d] <- 1
      z[y]
    } else {
      z[y]
    }
  }
carstennh's avatar
carstennh committed
71

72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
  maxpixels = 10000000
  colNA = "#FFFAFA99"
  bgalpha = 0
  alpha = 1
  r <- raster::sampleRegular(raster::raster(y, r),
                             maxpixels,
                             asRaster = TRUE,
                             useGDAL = TRUE)
  g <- raster::sampleRegular(raster::raster(y, g),
                             maxpixels,
                             asRaster = TRUE,
                             useGDAL = TRUE)
  b <- raster::sampleRegular(raster::raster(y, b),
                             maxpixels,
                             asRaster = TRUE,
                             useGDAL = TRUE)
carstennh's avatar
carstennh committed
88

89
90
91
92
93
94
95
96
  RGB <- cbind(raster::getValues(r),
               raster::getValues(g),
               raster::getValues(b))
  naind <- which(is.na(RGB[, 1]))
  RGB <- stats::na.omit(RGB)
  RGB[, 1] <- linStretchVec(RGB[, 1])
  RGB[, 2] <- linStretchVec(RGB[, 2])
  RGB[, 3] <- linStretchVec(RGB[, 3])
carstennh's avatar
carstennh committed
97

98
99
  scale <- 255
  bg <- grDevices::col2rgb(colNA)
100
  bg <- grDevices::rgb(bg[1], bg[2], bg[3], alpha = bgalpha, maxColorValue = 255)
101
  z <- rep(bg, times = raster::ncell(r))
102
103

  res <- grDevices::rgb(RGB[, 1], RGB[, 2], RGB[, 3],  maxColorValue = scale)
104
105
  if (length(naind) > 0) {
    z[-naind] <-
106
      grDevices::rgb(RGB[, 1], RGB[, 2], RGB[, 3],  maxColorValue =  scale)
107
  } else {
108
    z <- grDevices::rgb(RGB[, 1], RGB[, 2], RGB[, 3],  maxColorValue = scale)
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
  }#hier sind die finalen Farbwerte
  ######
  #z <- matrix(z, nrow=nrow(r), ncol=ncol(r), byrow=T)
  #bb <- as.vector(t(bbox(r)))
  #xlim=c(bb[1], bb[2])
  #ylim=c(bb[3], bb[4])
  #plot(
  #  NA,
  #  NA,
  #  xlim = xlim,
  #  ylim = ylim,
  #  type = "n",
  #  xaxs = 'i',
  #  yaxs = 'i',
  #  xlab = "",
  #  ylab = "",
  #  asp = 1,
  #  axes = T
  #)
  #graphics::rasterImage(z, bb[1], bb[3], bb[2], bb[4], interpolate=F)
  ######
  rr <- x
  raster::values(rr) <- 1:raster::ncell(rr)
132
133
134
  x <- raster::calc(
      x,
      fun = function(y)
135
        (y - num_models)
136
    )
137
138
  ##############################################################################
  ##[2] Create Leaflet Html output for Webbrowser
139
  mv <- leaflet::leaflet(options = leaflet::leafletOptions(zoomControl = FALSE))
140
  #addTiles(urlTemplate ='http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png') %>%
141
  mv <- leaflet::addProviderTiles(map = mv, "CartoDB.PositronNoLabels", options = leaflet::providerTileOptions(maxNativeZoom = 19,maxZoom = 100))
carstennh's avatar
carstennh committed
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
  mv <- leaflet::addRasterImage(
    map = mv,
    rr,
    colors = palo,
    opacity = 1,
    project = TRUE,
    method = "ngb",
    group = "RGB Composite",
    layerId = "RGB Composite"
  )

  mv <- leaflet::addRasterImage(
    map = mv,
    x,
    colors = pal,
    opacity = 1,
    project = TRUE,
    method = "ngb",
    group = HaTy,
    layerId = HaTy
  )

  mv <- leafem::addImageQuery(
    map = mv,
    x,
    project = TRUE,
    layerId = HaTy,
    prefix = "Habitat Type"
  )
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
  if (num_models<11) {
    mv <- leaflet::addLegend(
      map = mv,
      "bottomright",
      pal = pal,
      labFormat = leaflet::labelFormat(suffix = " Models",
                                       transform = function(x) seq(0, num_models, 1)),
      values =  c(0, num_models),
      title = paste("Number of models (", num_models," out of ", nb_models,")<br>predicting class ", HaTy, sep = ""),
      opacity = 1
    )
  } else {
    mv <- leaflet::addLegend(
      map = mv,
      "bottomright",
      pal = pal,
      labFormat = leaflet::labelFormat(suffix = " Models"),
      values =  c(0, num_models),
      title = paste("Number of models (", num_models," out of ", nb_models,")<br>predicting class ", HaTy, sep = ""),
      opacity = 1
    )
  }
194
195
196
197
198
199
200
201
202
203
  mv <- leaflet::addLayersControl(map = mv,
                                  overlayGroups = c("RGB Composite", HaTy))

  if (.Platform$OS.type == "unix") {
    htmlwidgets::saveWidget(mv, paste(outPath, 'leaflet.html', sep = ""))
    cat(
      "<style>.leaflet-container {cursor: crosshair !important;}</style>",
      file = paste(outPath, 'leaflet.html', sep = ""),
      append = TRUE
    )
204
205
206
207
208
209
210
211
212
213
    if (plot_on_browser == TRUE) {
      utils::browseURL(paste(outPath, 'leaflet.html', sep = ""),
                       browser = "firefox")
    } else {
      html_code = sprintf(
        '<iframe src="%s" width=1000 height=550></iframe>',
        paste(outPath, 'leaflet.html', sep = "")
      )
      IRdisplay::display_html(html_code)
    }
214
215
216
217
218
219
220
221
222
  } else {
    htmlwidgets::saveWidget(mv,
                            selfcontained = FALSE,
                            paste(outPath, 'leaflet.html', sep = ""))
    cat(
      "<style>.leaflet-container {cursor: crosshair !important;}</style>",
      file = paste(outPath, 'leaflet.html', sep = ""),
      append = TRUE
    )
223
224
225
226
227
228
229
230
    if (plot_on_browser == TRUE) {
      utils::browseURL(paste(outPath, 'leaflet.html', sep = ""))
    } else {
      html_code = sprintf(
        '<iframe src="%s" width=1000 height=550></iframe>',
        paste(outPath, 'leaflet.html', sep = ""))
      IRdisplay::display_html(html_code)
    }
231
232
233
234
  }
  #cat("<style>.leaflet-clickable {cursor: crosshair !important;}</style>",
  #    file = "leaflet.html",
  #    append = TRUE)
235
  return(mv)
carstennh's avatar
carstennh committed
236
237
}

238
################################################################################
carstennh's avatar
carstennh committed
239
240
241
242
243
244
245
246
247
248
249
#str(mv$dependencies)
#mv$dependencies[3] <- list(
#  htmlDependency(
#    name = "test"
#    ,version = "1"
#    # if local file use file instead of href below
#    #  with an absolute path
#    ,src = c("C:/Analysen/Projekte/DBH_Landsat_Change")
#    ,stylesheet = "test.css"
#  )
#)
250
################################################################################