save_files.r 9.6 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
95
96
97
98
99
100
101
    ###extract only class samples
    for (i in 1:length(ref_samples)) {
      if (length(dim(ref_samples[[i]])) != 0)
      {
        if (is.na(ref_switch[i]) == F) {
          j = j + 1
          collect[[j]] <-
            ref_samples[[i]][which(ref_samples[[i]]@data == 1), ]
102
        } else {
103
104
105
106
107
108
109
110
          j = j + 1
          collect[[j]] <-
            ref_samples[[i]][which(ref_samples[[i]]@data == 2), ]
        }
      }
    }
    
    result <- do.call(rbind, collect)
111
112
113
114
115
116
117
118
    if (!is.null(result)) {
      res <- raster::extract(dummy_raster, 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())
119
    }
120
    raster::crs(result) <- raster::crs(dummy_raster)
121

122
123
    output_format <- match.arg(output_format)
    if (output_format == "geojson") {
124
      file_path <- paste(in_path, "SamplePoints_step_", step, "_", class_name, ".geojson", sep = "")
125
      # Only transform is there points to be saved.
126
127
      if (nrow(result) > 0) {
        result <- sp::spTransform(result, sp::CRS("+init=epsg:4326"))
128
      }
129
130
131
132
133
134
135
136
137
138
139
140
141
142
      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 = ""
            )
          )
        }
      }
143
144
      sf::st_write(
        obj = sf::st_as_sf(x = result, crs = 4326),
145
        layer = paste("SamplePoints_step_", step, "_", class_name, sep = ""),
146
        dsn = file_path,
147
148
        driver = "GeoJSON",
        check_exists = TRUE,
149
        append = FALSE
150
      )
151
    } else {
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
      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 = ""
            )
          )
        }
      }
167
168
      sf::st_write(
        obj = sf::st_as_sf(x = result, crs = 4326),
169
        layer = paste("SamplePoints_step_", step, "_", class_name, sep = ""),
170
        dsn = file_path,
171
172
        driver = "ESRI Shapefile",
        check_exists = TRUE,
173
        append = FALSE
174
175
      )
    }
176
177
178
  }


179
#' Selected Sample Collection for Habitat Types
180
#'
181
182
183
#' 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.
184
185
186
187
#'
#' @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
188
#' @param overwrite overwrite file (default TRUE)
189
190
191
#' @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
192
#' 1) Point Shape/GeoJSON represents the pixels which belong to selected habitat type and can be used as reference for further model building.
193
194
195
196
197
198
#'    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
199
200
201
202
203
204
205
writeOutSamples <-
  function(in_path,
           step,
           class_name,
           overwrite = TRUE,
           output_format = c("shp", "geojson")) {
    
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
  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)
238
239
240
241
242
243
244
245
  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())
246
  }
Johannes Knoch's avatar
Johannes Knoch committed
247
  raster::crs(result) <- raster::crs(dummy_sample)
248
249
  output_format <- match.arg(output_format)
  if (output_format == "geojson") {
250
251
252
253
    # Only transform is there points to be saved.
    if (nrow(result) > 0) {
      result <- sp::spTransform(result, sp::CRS("+init=epsg:4326"))
    }
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
    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 = ""
          )
        )
      }
    }
269
270
    sf::st_write(
      obj = sf::st_as_sf(x = result, crs = 4326),
271
      layer = paste("RefHaSa_", class_name, "_step_", step, sep = ""),
272
      dsn = file_path,
273
274
      driver = "GeoJSON",
      check_exists = TRUE,
275
      append = FALSE
276
277
    ) 
  } else {
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
    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 = ""
          )
        )
      }
    }
293
294
    sf::st_write(
      obj = sf::st_as_sf(x = result, crs = 4326),
295
      layer = paste("RefHaSa_", class_name, "_", step, sep = ""),
296
      dsn = file_path,
297
298
      driver = "ESRI Shapefile",
      check_exists = TRUE,
299
      append = FALSE
300
301
    )
  }
302
}