0

I have a spatial point data frame with categorical variable as a column named "type", I would like to draw a random sample from these points (let's say 100 points) with maximum and minimum distance constraints but also grouped by type (i.e 20 points for each type supposing "type" has 5 unique values)

my data

class(my_data)
[1] "SpatialPointsDataFrame"
attr(,"package")
[1] "sp"

I can get a sample with distance constraints using spatialEco package like this

library(spatialEco)
sample <- subsample.distance(my_data, size = 100, d = 0.5, d.max = 3)

or grouped sample using sample_n from dplyr after converting to data.frame like this:

library(dplyr)
my_data_df <- as.data.frame(my_data)
sample <- my_data %>%
                      group_by(type) %>%
                      sample_n(20)

I'm looking for a way that do both at the same time!

Edit/workaround solution:

Note for clarification: The objective is to draw random and equal samples by groups, but also to apply the distance constraints on ALL the sampled observations. A loop/iteration by group would not work without a twist as it would respect the distance constraints within the groups not between them (as in the example here, constraint d.max= 1000; it’s applied within groups only, not between them)

enter image description here

Note 2/workaround solution:'

I have already found a tedious workaround to solve this at the time, but It would be interesting to see the actual solution; One can simply try to draw a reasonably large sample based on the distance constraints and including all types, then try to sample by group from it and iterate till success as per the full example code here:

library(sp)
library(spatialEco)
library(mapview)
library(dplyr)

# Checking data

#Example Input #Data: a spatial point data frame: my_data
               #total population: 100
               #number of types: 4
               #Intended sample size: 3 per type = 12
               #distance constraints: min = 1, max = 1000

#Function to get reasonably large sample meet the distance constraints 
Large_smp_f <- function(x) {
  
  repeat {
    # sample based on the distance constraints ; sample size = total population-1
    possible_max_samp <- subsample.distance(x, size = 99, d = 1, d.max = 1000)
    # check size
    nsamp <- nrow(possible_max_samp)
    # Check the groups/types we get in the sample
    n2 <- length(unique(possible_max_samp$Type))
    #Exit when two conditions are met
    # first: reasonable sample size (depending on total population; maybe > 70%)
    # second: the sample contain all the types (groups)
    if(nsamp > 70 & n2 == n_type) return(possible_max_samp)
  }
}
#execute the function to get large sample
Large_smp <- Large_smp_f(my_data)

#data frame to work with dplyr by group n random sample
df <- as.data.frame(Large_smp)


#Function to get the subsample based on the types from the large sample
sub_samp <- function(x){
  #In case the large sample didn't met the requirement try
  tryCatch({
   All_samp <- x %>%
    group_by(Type) %>%
      sample_n(4)
  },
  error = function(e){  #if not, make a new large sample and repeate
    Large_smp <- Large_smp_f(my_data)
    
    df <- as.data.frame(Large_smp)
  })
}


#Execute the function for getting the sub-samples we need
samp <- sub_samp(df)


# go back to spatial point data frame: get coordinates' columns, specify projection & plot
xy <- samp[,c(4,5)]   #get coordinates' columns
Final_samp <- SpatialPointsDataFrame(coords = xy, data = samp,
                                proj4string = CRS("+proj=longlat +datum=WGS84 +no_defs"))
                                
mapview(Final_samp, zcol = "Type")

enter image description here

2 Answers 2

0

One could specify a for loop to subset by "type" and then run a distance constrained subsample but, this could also be done in lapply. In this example, I am using "soil" as a substitute for "type". The result is a list, with each element representing a subsample of the stratifying variable. You can then use do.call to combine the subsamples into a single feature class. If this is not what you are after please provide some additional clarification (this is exactly what your tidy example would produce).

Add libraries and example data

library(sp)
library(spatialEco)

data(meuse)
  coordinates(meuse) <- ~x+y

Create subsample based on nominal variable

samp <- lapply(unique(meuse$soil), function(x){
  subsample.distance(meuse[meuse$soil == x,], 
                     size = 5, d = 100, d.max = 1000)
  })
samp <- do.call(rbind, samp)

Plot results

cols <- ifelse(meuse$soil == 1, "black",
          ifelse(meuse$soil == 2, "green",
            ifelse(meuse$soil == 3, "cyan", NA))) 
plot(meuse, col=cols, pch=20, cex=0.75) 
  points(samp, col="red", pch=20, cex=1.5)
    legend("topleft", legend=c("subsamples"),
           pch=20, col="red")
1
  • This doesn't work. It will give a constraints within groups not between them, I just edited for more clarification and also added the work around which I followed at the time, this was a while ago!
    – Es_a
    Feb 23 at 21:05
-1

I would divide the SpatialPolygonsDataFrame into five different objects, one for each type, and then subsample the new objects. Something like this:

unique_types <- unique(as.data.frame(my_data)$type)

for(i in unique_types){

selected <- subset(my_data, type == i)
samples <- subsample.distance(selected, size = 100, d = 0.5, d.max = 3)
assign(paste0("type_", i), samples)

}

#merge your outputs
output <- bind(type_a, type_b, type_c, type_d, type_e) 

2
  • Actually, that doesn't answer my question as generating samples in subset data would apply the distance constraint on the sub-sample in each type, but not on the parent sample (between the sub-samples). thank you for the comment anyway
    – Es_a
    May 24, 2021 at 20:50
  • Use assign with great caution as it can have unexpected results and besides, it is not always efficient throwing a bunch of results into the active namespace. What if you have 100 outputs, then you have to wrangle all of those separate objects? It is better practice to preallocate an object and then populate it from the loop. In this case creating a list x <- vector("list", length = length(unique_types)), then, if not using a numeric index in the loop names(x) <- unique_values and finally assigning from the loop eg., x[[i]] <- .... Results can be combined using do.call. Nov 4, 2021 at 0:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.