查找当前行与值与当前行不同的第一行之间的列内的行距离

thu*_*tel 5 r dplyr

假设我有以下数据框:

data = data.frame(values = c(1,1,1,2,2,2,2,1,1,4))
Run Code Online (Sandbox Code Playgroud)

然后我想使用 dplyr::mutate() 中的函数来创建一个新列,该列将为我提供当前行和具有与当前行不同的值的第一行之间的距离。

我期望以下内容:

   values target
1       1      3
2       1      2
3       1      1
4       2      4
5       2      3
6       2      2
7       2      1
8       1      2
9       1      1
10      4     NA
Run Code Online (Sandbox Code Playgroud)

我知道使用该函数dplyr::lead()我们可以检索当前行开头的第 n 行的值。所以我正在寻找一种反向函数,它不会返回第 n 行的值,而是返回具有不同值的第一行的第 n 行。

我考虑编写一个函数并迭代参数n并将dplyr::lead()返回值的结果与当前行值进行比较,如果返回值不同则中断循环。

dplyr::mutate()但是我该如何编写这样一个函数,以便它可以在数据框上下文中使用呢?

ste*_*fan 5

一种选择是使用purrr::imap_dbl自定义函数来计算最小距离:

library(dplyr, warn = FALSE)
library(purrr)

min_lead_distance <- function(values) {
  purrr::imap_dbl(
    values, \(x, y) {
      # Absolute difference
      diff <- abs(values - x)
      # Set non-leading values to NA
      diff[seq_len(y)] <- NA
      # Check if any non NA and non zero value, if not return NA
      if (all(is.na(diff) | !diff > 0)) {
        return(NA)
      }
      # Return distance to first non-NA non-zero value
      min(which(diff > 0)) - y
    }
  )
}

data = data.frame(values = c(1,1,1,2,2,2,2,1,1,4))

data |>
  mutate(target = min_lead_distance(values))
#>    values target
#> 1       1      3
#> 2       1      2
#> 3       1      1
#> 4       2      4
#> 5       2      3
#> 6       2      2
#> 7       2      1
#> 8       1      2
#> 9       1      1
#> 10      4     NA

data <- data.frame(values = c(1,1,1,4,4,4,4,1,1,2))

data |>
  mutate(target = min_lead_distance(values))
#>    values target
#> 1       1      3
#> 2       1      2
#> 3       1      1
#> 4       4      4
#> 5       4      3
#> 6       4      2
#> 7       4      1
#> 8       1      2
#> 9       1      1
#> 10      2     NA

data <- data.frame(values = c(1,1,1,1,1))

data |>
  mutate(target = min_lead_distance(values))
#>   values target
#> 1      1     NA
#> 2      1     NA
#> 3      1     NA
#> 4      1     NA
#> 5      1     NA
Run Code Online (Sandbox Code Playgroud)

原始代码有bug

library(dplyr, warn=FALSE)
library(purrr)

data |>
  mutate(target = purrr::imap_dbl(
    values, \(x, y) {
      diff <- abs(values - x)
      diff[seq_len(y - 1)] <- Inf
      diff[!diff > 0] <- Inf
      if (all(is.infinite(diff))) return(NA)
      
      min(which(!is.infinite(diff))) - y
    }
  ))
Run Code Online (Sandbox Code Playgroud)