Assign rows to a group based on spatial neighborhood and temporal criteria in R

问题

I have an issue that I just cannot seem to sort out. I have a dataset that was derived from a raster in arcgis. The dataset represents every fire occurrence during a 10-year period. Some raster cells had multiple fires within that time period (and, thus, will have multiple rows in my dataset) and some raster cells will not have had any fire (and, thus, will not be represented in my dataset). So, each row in the dataset has a column number (sequential integer) and a row number assigned to it that corresponds with the row and column ID from the raster. It also has the date of the fire.

I would like to assign a unique ID (fire_ID) to all of the fires that are within 4 days of each other and in adjacent pixels from one another (within the 8-cell neighborhood) and put this into a new column.

To clarify, if there were an observation from row 3, col 3, Jan 1, 2000 and another from row 2, col 4, Jan 4, 2000, those observations would be assigned the same fire_ID.

Below is a sample dataset with "rows", which are the row IDs of the raster, "cols", which are the column IDs of the raster, and "dates" which are the dates the fire was detected.

rows<-sample(seq(1,50,1),600, replace=TRUE)
cols<-sample(seq(1,50,1),600, replace=TRUE)
dates<-sample(seq(from=as.Date("2000/01/01"), to=as.Date("2000/02/01"), by="day"),600, replace=TRUE)
fire_df<-data.frame(rows, cols, dates)

I've tried sorting the data by "row", then "column", then "date" and looping through, to create a new fire_ID if the row and column ID were within one value and the date was within 4 days, but this obviously doesn't work, as fires which should be assigned the same fire_ID are assigned different fire_IDs if there are observations in between them in the list that belong to a different fire_ID.

fire_df2<-fire_df[order(fire_df$rows, fire_df$cols, fire_df$date),]
fire_ID=numeric(length=nrow(fire_df2))
fire_ID[1]=1
for (i in 2:nrow(fire_df2)){
fire_ID[i]=ifelse(
fire_df2$rows[i]-fire_df2$rows[i-1]<=abs(1) & fire_df2$cols[i]-fire_df2$cols[i-1]<=abs(1) & fire_df2$date[i]-fire_df2$date[i-1]<=abs(4),
fire_ID[i-1],
i)
}
length(unique(fire_ID))
fire_df2$fire_ID<-fire_ID

Please let me know if you have any suggestions.

回答1:

I think this task requires something along the lines of hierarchical clustering.

Note, however, that there will be necessarily some degree of arbitrariness in the ids. This is because it is entirely possible that the cluster of fires itself is longer than 4 days yet every fire is less than 4 days away from some other fire in that cluster (and thus should have the same id).

library(dplyr)

# Create the distances
fire_dist <- fire_df %>%
  # Normalize dates
  mutate( norm_dates = as.numeric(dates)/4) %>% 
  # Only keep the three variables of interest
  select( rows, cols, norm_dates ) %>%
  # Compute distance using L-infinite-norm (maximum)
  dist( method="maximum" )

# Do hierarchical clustering with "single" aggl method
fire_clust <- hclust(fire_dist, method="single")

# Cut the tree at height 1 and obtain groups
group_id <- cutree(fire_clust, h=1)

# First attach the group ids back to the data frame
fire_df2 <- cbind( fire_df, group_id ) %>%
  # Then sort the data
  arrange( group_id, dates, rows, cols ) 

# Print the first 20 records
fire_df2[1:10,]

(Make sure you have dplyr library installed. You can run install.packages("dplyr",dep=TRUE) if not installed. It is a really good and very popular library for data manipulations)

A couple of simple tests:

Test #1. The same forest fire moving.

rows<-1:6
cols<-1:6
dates<-seq(from=as.Date("2000/01/01"), to=as.Date("2000/01/06"), by="day")
fire_df<-data.frame(rows, cols, dates)

gives me this:

  rows cols      dates group_id
1    1    1 2000-01-01        1
2    2    2 2000-01-02        1
3    3    3 2000-01-03        1
4    4    4 2000-01-04        1
5    5    5 2000-01-05        1
6    6    6 2000-01-06        1

Test #2. 6 different random forest fires.

set.seed(1234)

rows<-sample(seq(1,50,1),6, replace=TRUE)
cols<-sample(seq(1,50,1),6, replace=TRUE)
dates<-sample(seq(from=as.Date("2000/01/01"), to=as.Date("2000/02/01"), by="day"),6, replace=TRUE)
fire_df<-data.frame(rows, cols, dates)

output:

rows cols      dates group_id
1    6    1 2000-01-10        1
2   32   12 2000-01-30        2
3   31   34 2000-01-10        3
4   32   26 2000-01-27        4
5   44   35 2000-01-10        5
6   33   28 2000-01-09        6

Test #3: one expanding forest fire

dates <- seq(from=as.Date("2000/01/01"), to=as.Date("2000/01/06"), by="day")
rows_start <- 50
cols_start <- 50

fire_df <- data.frame(dates = dates) %>%
    rowwise() %>%
    do({
      diff = as.numeric(.$dates - as.Date("2000/01/01"))
      expand.grid(rows=seq(rows_start-diff,rows_start+diff), 
                  cols=seq(cols_start-diff,cols_start+diff),
                  dates=.$dates) 
    })

gives me:

  rows cols      dates group_id
1    50   50 2000-01-01        1
2    49   49 2000-01-02        1
3    49   50 2000-01-02        1
4    49   51 2000-01-02        1
5    50   49 2000-01-02        1
6    50   50 2000-01-02        1
7    50   51 2000-01-02        1
8    51   49 2000-01-02        1
9    51   50 2000-01-02        1
10   51   51 2000-01-02        1

and so on. (All records identified correctly to belong to the same forest fire.)

来源：https://stackoverflow.com/questions/30361138/assign-rows-to-a-group-based-on-spatial-neighborhood-and-temporal-criteria-in-r

标签

for-loop

grouping

Spatial

temporal-database