save_files.r 9.78 KB
Newer Older
1
2
3
4
5
6
#' Save a run
#'
#' Saves the run object for a step
#'
#' @param outPath output path
#' @param step step number
7
#' @param run1 the object to be saved
8
9
#'
#' @export
10
11
save_run <- function(outPath, step, run1) {
  save(run1, file = paste(outPath, paste("Run", step, sep = ""), sep = ""))
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
}

#' Save Tif
#'
#' Saves the classification result into a tiff.
#'
#' @param outPath output path
#' @param step step number
#' @param classNames the names of the classes
#' @param index index of the class
#' @param raster the raster values
#' @param overwrite overwrite files or not
#'
#' @export
save_class_tiff <- function(outPath, step, classNames, index, raster, overwrite) {
  raster::writeRaster(
    raster,
    filename = paste(outPath,
                     paste("step_",
                           step,
                           paste("_", classNames[index], sep = ""),
                           ".tif",
                           sep = ""),
                     sep = ""),
    format = "GTiff",
    overwrite = overwrite)
}

#' Save KML
#'
#' Saves the classification result into a KML file.
#'
#' @param outPath output path
#' @param step step number
#' @param raster the raster values
#' @param overwrite overwrite files or not
#'
#' @export
save_kml <- function(outPath, step, raster, overwrite) {
  kml <- raster::projectRaster(raster,
                               crs = "+proj=longlat +datum=WGS84",
                               method = 'ngb')
  
55
  raster::KML(kml, paste(outPath, paste("step_", step, sep = ""), sep = ""), overwrite = overwrite, zip = '')
56
}
57
58
59
60
61
62
63
64
65
66
67
68


#' Save Sample Points
#'
#' Saves the reference sample points
#'
#' @param in_path file path (character) for results of habitat type sampling and probability mapping (same as outPath from function multi_Class_Sampling)
#' @param step step number (numeric)
#' @param class_name name (character) of habitat type for which samples should be selected
#' @param output_format format (character) of output; whether shp (default) or geojson
#' @param ref_samples list of reference sample points
#' @param ref_switch vector with switch values
69
#' @param num_models number of models used for the classification of a habitat
70
#' @param dummy_raster raster with probabilities for each pixel
71
#' @param overwrite overwrite file (default TRUE)
72
73
#'
#' @return ESRI shapefiles/GeoJSON with name: SamplePoints_step_classname.shp/SamplePoints_step_classname.geojson
74
#' 1) Point Shape/GeoJSON represents the pixels which were used to train the models for that habitat.
75
76
77
78
79
80
81
82
83
84
85
#'    ESRI shapefiles have the same CRS as the input raster. GeoJSON files are in the standard CRS of GeoJSON (EPSG:4326).
#'
#'
#' @export
saveSamplePoints <-
  function(in_path,
           step,
           class_name,
           output_format = c("shp", "geojson"),
           ref_samples,
           ref_switch,
86
           num_models,
87
88
           dummy_raster,
           overwrite = TRUE) {
89
90
    collect <- list()
    j <- 0
91
92
93
    dummy_raster[dummy_raster == num_models] <- NA
    dummy_raster[dummy_raster > num_models] <- 1

94
    print("1")
95
96
97
98
    ###extract only class samples
    for (i in 1:length(ref_samples)) {
      if (length(dim(ref_samples[[i]])) != 0)
      {
99
        print("1a")
100
        if (is.na(ref_switch[i]) == F) {
101
          print("1b")
102
103
104
          j = j + 1
          collect[[j]] <-
            ref_samples[[i]][which(ref_samples[[i]]@data == 1), ]
105
106
        } else {
          print("1c")
107
108
109
110
111
112
113
          j = j + 1
          collect[[j]] <-
            ref_samples[[i]][which(ref_samples[[i]]@data == 2), ]
        }
      }
    }
    
114
    print("2")
115
    result <- do.call(rbind, collect)
116
    if (!is.null(result)) {
117
      print("3a")
118
119
      res <- raster::extract(dummy_raster, result)
      if (length(which(is.na(res))) > 0) {
120
        print("3aa")
121
122
123
        result <- result[-which(is.na(res)), ]
      }
    } else {
124
      print("3b")
125
126
      result <-
        sp::SpatialPolygonsDataFrame(Sr = sp::SpatialPolygons(list()), data = data.frame())
127
    }
128
    print("4")
129
    raster::crs(result) <- raster::crs(dummy_raster)
130

131
    print("5")
132
133
    output_format <- match.arg(output_format)
    if (output_format == "geojson") {
134
      file_path <- paste(in_path, "SamplePoints_step_", step, "_", class_name, ".geojson", sep = "")
135
      # Only transform is there points to be saved.
136
137
      if (nrow(result) > 0) {
        result <- sp::spTransform(result, sp::CRS("+init=epsg:4326"))
138
      }
139
140
141
142
143
144
145
146
147
148
149
150
151
152
      if (file.exists(file_path) == TRUE) {
        if (overwrite) {
          unlink(file_path, recursive = TRUE)
        } else {
          stop(
            paste(
              "The file ",
              file_path,
              " already exists. Please delete it or set overwrite = TRUE",
              sep = ""
            )
          )
        }
      }
153
154
      sf::st_write(
        obj = sf::st_as_sf(x = result, crs = 4326),
155
        layer = paste("SamplePoints_step_", step, "_", class_name, sep = ""),
156
        dsn = file_path,
157
158
        driver = "GeoJSON",
        check_exists = TRUE,
159
        append = FALSE
160
      )
161
    } else {
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
      file_path <- paste(in_path, "SamplePoints_step_", step, "_", class_name, ".shp", sep = "")
      if (file.exists(file_path) == TRUE) {
        if (overwrite) {
          unlink(file_path, recursive = TRUE)
        } else {
          stop(
            paste(
              "The file ",
              file_path,
              " already exists. Please delete it or set overwrite = TRUE",
              sep = ""
            )
          )
        }
      }
177
178
      sf::st_write(
        obj = sf::st_as_sf(x = result, crs = 4326),
179
        layer = paste("SamplePoints_step_", step, "_", class_name, sep = ""),
180
        dsn = file_path,
181
182
        driver = "ESRI Shapefile",
        check_exists = TRUE,
183
        append = FALSE
184
185
      )
    }
186
187
188
  }


189
#' Selected Sample Collection for Habitat Types
190
#'
191
192
193
#' Writes out a set of samples (SpatialPointsDataFrame) into ESRI shapefiles or a GeoJSON file for a selected habitat type.
#' Each point represents a valid sample location that identifies the selected habitat type. Only those points are selected
#' which lay in the habitat type selected by the user's input threshold.
194
195
196
197
#'
#' @param in_path file path (character) for results of habitat type sampling and probability mapping (same as outPath from function multi_Class_Sampling)
#' @param step step number (numeric)
#' @param class_name name (character) of habitat type for which samples should be selected
198
#' @param overwrite overwrite file (default TRUE)
199
200
201
#' @param output_format format (character) of output; whether shp (default) or geojson
#'
#' @return ESRI shapefiles/GeoJSON with name: SamplePoints_step_classname.shp/SamplePoints_step_classname.geojson
202
#' 1) Point Shape/GeoJSON represents the pixels which belong to selected habitat type and can be used as reference for further model building.
203
204
205
206
207
208
#'    ESRI shapefiles have the same CRS as the input raster. GeoJSON files are in the standard CRS of GeoJSON (EPSG:4326).
#'
#'
#' @export

###write out selected samples
209
210
211
212
213
214
215
writeOutSamples <-
  function(in_path,
           step,
           class_name,
           overwrite = TRUE,
           output_format = c("shp", "geojson")) {
    
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
  run1 <- get(load(paste(in_path, "Run", step, sep = "")))
  load(paste(in_path, "threshold_step_", step, sep = ""))
  dummy_sample <-
    raster::raster(paste(in_path, "step_", step, "_", class_name, ".tif", sep =
                           ""))
  
  length_threshold <- length(threshold)
  thres <- threshold[length_threshold]
  dummy_sample[dummy_sample < thres] <- NA
  dummy_sample[dummy_sample >= thres] <- 1
  
  collect <- list()
  j <- 0
  
  ###extract only class samples
  for (i in 1:length(run1@ref_samples)) {
    if (length(dim(run1@ref_samples[[i]])) != 0)
    {
      if (is.na(run1@switch[i]) == F) {
        j = j + 1
        collect[[j]] <-
          run1@ref_samples[[i]][which(run1@ref_samples[[i]]@data == 1), ]
      } else
      {
        j = j + 1
        collect[[j]] <-
          run1@ref_samples[[i]][which(run1@ref_samples[[i]]@data == 2), ]
      }
    }
  }
  
  result <- do.call(rbind, collect)
248
249
250
251
252
253
254
255
  if (!is.null(result)) {
    res <- raster::extract(dummy_sample, result)
    if (length(which(is.na(res))) > 0) {
      result <- result[-which(is.na(res)), ]
    }
  } else {
    result <-
      sp::SpatialPolygonsDataFrame(Sr = sp::SpatialPolygons(list()), data = data.frame())
256
  }
Johannes Knoch's avatar
Johannes Knoch committed
257
  raster::crs(result) <- raster::crs(dummy_sample)
258
259
  output_format <- match.arg(output_format)
  if (output_format == "geojson") {
260
261
262
263
    # Only transform is there points to be saved.
    if (nrow(result) > 0) {
      result <- sp::spTransform(result, sp::CRS("+init=epsg:4326"))
    }
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
    file_path <- paste(in_path, "RefHaSa_", class_name, "_", step, ".geojson", sep = "")
    if (file.exists(file_path) == TRUE) {
      if (overwrite) {
        unlink(file_path, recursive = TRUE)
      } else {
        stop(
          paste(
            "The file ",
            file_path,
            " already exists. Please delete it or set overwrite = TRUE",
            sep = ""
          )
        )
      }
    }
279
280
    sf::st_write(
      obj = sf::st_as_sf(x = result, crs = 4326),
281
      layer = paste("RefHaSa_", class_name, "_step_", step, sep = ""),
282
      dsn = file_path,
283
284
      driver = "GeoJSON",
      check_exists = TRUE,
285
      append = FALSE
286
287
    ) 
  } else {
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
    file_path <- paste(in_path, "RefHaSa_", class_name, "_", step, ".shp", sep = "")
    if (file.exists(file_path) == TRUE) {
      if (overwrite) {
        unlink(file_path, recursive = TRUE)
      } else {
        stop(
          paste(
            "The file ",
            file_path,
            " already exists. Please delete it or set overwrite = TRUE",
            sep = ""
          )
        )
      }
    }
303
304
    sf::st_write(
      obj = sf::st_as_sf(x = result, crs = 4326),
305
      layer = paste("RefHaSa_", class_name, "_", step, sep = ""),
306
      dsn = file_path,
307
308
      driver = "ESRI Shapefile",
      check_exists = TRUE,
309
      append = FALSE
310
311
    )
  }
312
}