R: Calculate distance between consecutive points per group and group them

Question

i am having hard time with this one...So i am trying to find points per group that are close to each other and furthermore group them. Let me explain You on base of the example data below:

  Group    X   Y  Z
1   110 3762 431 10
2   112 4950 880 10
3   113 5062 873 20
4   113 5225 874 30
5   113 5262 875 10
6   113 5300 874 20

structure(list(Group = c(110, 112, 113, 113, 113, 113), X = c(3762, 
4950, 5062, 5225, 5262, 5300), Y = c(431, 880, 873, 874, 875, 
874), Z = c(10, 10, 20, 30, 10, 20)), row.names = c(NA, -6L), class = "data.frame")

As we can see we have grouping column Group , X & Y Columns are our coordinates and Z Column should be further summarised when points are defined as "Close" (Euclidean distance < 100).

What i have tried:

I have calculated sucesfully Euclidean distance between points using this function:

for(i in 1:nrow(test)) {
  if(i > 1 && test$Group[i] == test$Group[i-1]) {
    test$Distance[i] <- sqrt(((test$X[i] - test$X[i-1]) ^ 2) + ((test$Y[i] - test$Y[i-1]) ^ 2))
  } else {
    test$Distance[i] <- NA
  }
}

Which gives me this:

   Group    X   Y  Z  Distance
1   110 3762 431 10        NA
2   112 4950 880 10        NA
3   113 5062 873 20        NA
4   113 5225 874 30 163.00307
5   113 5262 875 10  37.01351
6   113 5300 874 20  38.01316

And here everything complicates as there are NA´s for the first row for each Group etc....

What i wanna achieve:

I would like to find points per goup that their distance is not greater then 100 ( Distance < 100), and on base of that summarise it (simple sum of Z column). So manually done:

 Group    Z  Grouped
1   110  10   no     
2   112  10   no     
3   113  20   no     
4   113  60   yes

Thanks for help!

Answer 1

That was difficult. I'm not sure I have figured it out completely.

#get data and libraries

library(tidyverse)

df <- read.table(text = "
Group    X   Y  Z  Distance
1   110 3762 431 10        NA
2   112 4950 880 10        NA
3   113 5062 873 20        NA
4   113 5225 874 30 163.00307
5   113 5262 875 10  37.01351
6   113 5300 874 20  38.01316", header = T, stringsAsFactors = F)

df %>%
  group_by(Group) %>%
  do(melt(outer(.$Distance, .$Distance, `-`))) %>%
  filter(between(value, -100, 0) | between(value, 0, 100)) %>% 
  distinct(Var1) %>%
  mutate(grouped = 1) %>%
  rename(row = Var1) -> rows

  df %>% 
    group_by(Group) %>% 
    mutate(row = row_number()) %>%
  left_join(rows, by = c("row", "Group")) %>%
    mutate(grouped = ifelse(is.na(grouped), "no", "yes")) %>%
    group_by(Group, grouped) %>%
    mutate(Z = ifelse(!is.na(grouped), sum(Z), Z)) %>%
    distinct(Group, Z, grouped)


# A tibble: 4 x 3
# Groups:   Group, grouped [4]
  Group     Z grouped
  <int> <int> <chr>  
1   110    10 no     
2   112    10 no     
3   113    20 no     
4   113    60 yes 

Hope it's what you were looking for, if not maybe it gave you some new ideas.

UPDATE : And now what I hope will really help you:

df %>%
  group_by(Group) %>%
  mutate(int1 = lead(Distance) < 100 | Distance < 100,
         int1 = replace(int1, is.na(int1), FALSE),
         int2 = rleid(int1),
         int2 = replace(int2, !int1 | is.na(int1), NA)) -> df2

  df2 %>%
  filter(int1) %>% 
    group_by(Group, int2) %>%
    summarise(Z = sum(Z),
              Grouped = "yes") %>% 
    select(Group, Z, Grouped) %>%
    bind_rows(df2 %>%
                filter(!int1) %>%
                mutate(Grouped = "no") %>%
                select(Group, Z, Grouped)) %>%
    arrange(Group)

# A tibble: 4 x 3
# Groups:   Group [3]
  Group     Z Grouped
  <int> <int> <chr>  
1   110    10 no     
2   112    10 no     
3   113    60 yes    
4   113    20 no 

Answer 2

I worked out a little use case that can get you started. It is a base approach using a for loop and aggregation based on vector of columns to which you could apply a paired vector of functions by which to aggregate.

df <- read.table(text = "
Group    X   Y  Z  Distance
1   110 3762 431 10        NA
2   112 4950 880 10        NA
3   113 5062 873 20        NA
4   113 5225 874 30 163.00307
5   113 5262 875 10  37.01351
6   113 5300 874 20  38.01316
7   114 5300 874 30  NA
8   114 5300 874 20  38.01316", header = T, stringsAsFactors = F)

aggregateIt <- function(df = data, #data.frame
                        returnRaw = F, #to get the raw unaggregted df (only first case from column `grouped` by `subgroup` usable in this application)
                        colsToAgg = c("Z1", "Z2", "Z3"), #cols to aggregate
                        how = c("sum", "sum", "max")) #how to aggregate the columns, `Z1` by sum, `Z2` by sum and `Z3` by max
  {
  count <- 1L
  result <- vector("integer", nrow(df))
  grouped <- vector("character", nrow(df))
  for(i in seq_len(length(result)-1L)){
    if(df$Group[i] != df$Group[i+1L]) {
      result[i] <- count
      grouped[i] <- "no"
      count <- count + 1L
      if((i+1L) == length(result)) {
        result[i+1L] <- count
        grouped[i+1L] <- "no"
      }
    } else {
        if(df$Distance[i+1L] > 100L) {
          result[i] <- count
          grouped[i] <- "no"
          count <- count + 1L
          if((i+1L) == length(result)) {
            result[i+1L] <- count
            grouped[i+1L] <- "no"
          }
        } else {
          result[i] <- count
          grouped[i] <- "yes"
          if((i+1L) == length(result)) {
            result[i+1L] <- count
            grouped[i+1L] <- "yes"
          }
        }
    }
  }
  df <- within(df, {subgroup <- result; grouped <- grouped})
  if(returnRaw) return(df)
  A <- Reduce(function(a, b) merge(a, b, by = "subgroup"), 
         lapply(seq_along(how), function(x) aggregate(.~subgroup, df[, c(colsToAgg[x], "subgroup")], how[x])))
  B <- df[!duplicated(df$subgroup, fromLast = F), c("Group", "subgroup", "grouped")]
  out <- merge(A, B, by = "subgroup")
  return(out[, c("Group", colsToAgg, "grouped")])
}

aggregateIt(df = df, colsToAgg = "Z", how = "sum")
#  Group  Z grouped
#1   110 10      no
#2   112 10      no
#3   113 20      no
#4   113 60     yes
#5   114 50     yes

Not claiming this is most efficient solution but it points out the solution. Hope this helps!