R: Рассчитать расстояние между последовательными точками на группу и сгруппировать их

Question

Мне тяжело с этим ... Поэтому я пытаюсь найти точки в группе, которые близки друг к другу, и, кроме того, сгруппировать их. Позвольте мне объяснить вам на основе приведенных ниже примеров:

  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")

Как мы видим, у нас есть столбец группировки Группа , X & Y Столбцы - это наши координаты, а Z Столбец должен быть дальше суммируется, когда точки определены как «близкие» (евклидово расстояние <100). </p>

Что я пробовал:

Я успешно вычислил евклидово расстояние между точками, используя эту функцию:

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
  }
}

Что дает мне это:

   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

И здесь все усложняется, поскольку для каждой группы есть NA для первого ряда и т. Д.

Чего я хочу достичь:

Я бы хотел найти баллы для каждой группы, чтобы их расстояние не превышало 100 ( Расстояние <100), и на основании этого суммируйте его (простая сумма <em>Z столбец). Итак, сделано вручную:

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

Спасибо за помощь!

Answer 1

Это было сложно.Я не уверен, что понял это полностью.

#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 

Надеюсь, это то, что вы искали, если нет, возможно, это дало вам новые идеи.

ОБНОВЛЕНИЕ : И теперь то, что я надеюсь, действительно поможет вам:

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

Я разработал небольшой сценарий использования, который поможет вам начать.Это базовый подход, использующий цикл for и агрегирование на основе вектора столбцов, к которому можно применить парный вектор функций для агрегирования.

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

Не утверждая, что это наиболее эффективное решение, но оно указывает на решение.Надеюсь, это поможет!