WriteOutSamples.r 3.05 KB
Newer Older
carstennh's avatar
carstennh committed
1
2
#' Sample Collection for Habitat Types
#'
3
#'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.
4
#'
carstennh's avatar
carstennh committed
5
#' @param inPath file path (character) for results of habitat type sampling and probability mapping (same as outPath from function multi_Class_Sampling)
6
#' @param step step number (numeric)
carstennh's avatar
carstennh committed
7
#' @param className name (character) of habitat type for which samples should be selected
8
#' @param output_format format (character) of output; whether shp (default) or geojson
carstennh's avatar
carstennh committed
9
#'
10
#' @return ESRI shapefiles/GeoJSON with name: RefHaSa_step_classname.shp/RefHaSa_step_classname.geojson
11
#' 1) Point Shape represents pixel that belong to selected habitat type and can be used as reference for further model building
carstennh's avatar
carstennh committed
12
13
14
15
#'
#'
#' @export

16
###write out selected samples
17
write_Out_Samples <- function (inPath, step, className, output_format = c("shp", "geojson")) {
18

19
20
21
  paste(inPath, "step_", step, "_", className, ".tif", sep = "")
  run1 <- get(load(paste(inPath, "Run", step, sep = "")))
  load(paste(inPath, "threshold_step_", step, sep = ""))
22
  dummy_sample <-
23
24
    raster::raster(paste(inPath, "step_", step, "_", className, ".tif", sep =
                           ""))
25

26
27
28
29
  length_threshold <- length(threshold)
  thres <- threshold[length_threshold]
  dummy_sample[dummy_sample < thres] <- NA
  dummy_sample[dummy_sample >= thres] <- 1
30
31
32

  collect <- list()
  j <- 0
carstennh's avatar
carstennh committed
33

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
  ###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), ]
      }
    }
  }
50
  
51
  result <- do.call(rbind, collect)
carstennh's avatar
carstennh committed
52

53
  res <- raster::extract(dummy_sample, result)
54
55
56
  if (length(which(is.na(res))) > 0) {
    res <- result[-which(is.na(res)), ]
  }
57
  
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
  output_format <- match.arg(output_format)
  
  if (output_format == "geojson") {
    crs_dummy <- sp::proj4string(dummy_sample)
    crs(res) <- crs_dummy
    res <- sp::spTransform(res, CRS("+proj=longlat +datum=WGS84 +init=epsg:4326"))
    
    rgdal::writeOGR(
      res,
      layer = paste("RefHaSa_step_", step, "_", className, sep = ""),
      dsn = paste(inPath, "RefHaSa_step_", step, "_", className, ".geojson", sep = ""),
      driver = "GeoJSON",
      check_exists = TRUE,
      overwrite_layer = TRUE
    ) 
   } else {
      crs_dummy <- sp::proj4string(dummy_sample)
      crs(res) <- crs_dummy
      res <- sp::spTransform(res, CRS("+proj=longlat +datum=WGS84 +init=epsg:4326"))
77

78
79
80
81
82
83
84
85
86
      rgdal::writeOGR(
        res,
        layer = paste("RefHaSa_step_", step, "_", className, sep = ""),
        dsn = paste(inPath, "RefHaSa_", className, "_", step, ".shp", sep = ""),
        driver = "ESRI Shapefile",
        check_exists = TRUE,
        overwrite_layer = TRUE
      )
     }
carstennh's avatar
carstennh committed
87
}