为观察分配多个文本标志

Question

我有一些温度数据。我想编写一个简单的 QA/QC 脚本来查看它并标记（在 QA/QC 意义上）需要 verification/manual 检查的数据。我希望它基本上将标志附加到现有列，而不是为每个单独的标志创建一个全新的列。我有办法做到这一点，但它并不优雅。有没有更简洁的方法来执行此操作？

d<-data.frame(time=1:20, temp=c(1:5,-60,7:10,NA,12:15,160,17:20))

time 仅仅是顺序观察，temp 是一些虚构的温度数据。

d$Flag[is.na(d$temp)]<-"MISSING" #flag the missing data
d$Flag[d$temp>120&!is.na(d$temp)]<-paste(d$Flag[d$temp>120&!is.na(d$temp)],"High",sep="_") #flag data beyond a threshold
d$Flag[d$temp<(-40)&!is.na(d$temp)]<-paste(d$Flag[d$temp<(-40)&!is.na(d$temp)],"Low",sep="_") #flag data below a threshold
dtIdx<-which(abs(diff(d$temp,lag=1))>10) #set an index vector of changes >10 based on first derivative
d$Flag[dtIdx]<-paste(d$Flag[dtIdx],"D10",sep="_") #select data and paste in new codes 
d$Flag<-gsub("NA_","",d$Flag) #strip NA that is introduced to flags

这将创建变量 Flag，然后用自身 + 来自每个新条件的新信息顺序覆盖它。它有效，但感觉很乱。我也不喜欢必须清理引入的 NA - 我能以某种方式从一开始就忽略它们吗？

Answer 1

这是一个使用 tidyverse 的选项。对于 dtIdx，我临时用该信息创建了一个新列，然后用其他名称（即 MISSING、High 和 [=18] 创建了 Flag 列=]) 使用 case_when。然后，我 unite 两列忽略 NA 并删除 dtIdx.

library(tidyverse)

df %>%
  mutate(
    dtIdx = ifelse(c(abs(diff(temp, lag = 1)) > 10, FALSE), "D10", NA),
    Flag = case_when(is.na(temp) ~ "MISSING",
                     temp > 120 ~ "High",
                     temp < -40 ~ "Low")) %>%
  unite(
    "Flag",
    c(dtIdx, Flag),
    sep = "_",
    remove = TRUE,
    na.rm = TRUE
  )

输出

   time temp     Flag
1     1    1         
2     2    2         
3     3    3         
4     4    4         
5     5    5      D10
6     6  -60  D10_Low
7     7    7         
8     8    8         
9     9    9         
10   10   10         
11   11   NA  MISSING
12   12   12         
13   13   13         
14   14   14         
15   15   15      D10
16   16  160 D10_High
17   17   17         
18   18   18         
19   19   19         
20   20   20

数据

df <- structure(list(
  time = 1:20,
  temp = c(1, 2, 3, 4, 5,-60, 7, 8,
           9, 10, NA, 12, 13, 14, 15, 160, 17, 18, 19, 20)
),
class = "data.frame",
row.names = c(NA,-20L))

Answer 2

你可以从你使用的过程中抽象出一个函数。像这样

flag <- function(..., init, sep = "_") {
  trimws(Reduce(
    \(x, y) replace(x, y[[1L]], paste(x[y[[1L]]], y[[2L]], sep = sep)), 
    list(...), init = init
  ), "left", sep)
}

然后像这样应用它

d$Flag <- flag(
  list(is.na(d$temp), "MISSING"), 
  list(which(d$temp > 120), "High"), 
  list(which(d$temp < -40), "Low"), 
  list(which(abs(diff(d$temp, lag = 1)) > 10), "D10"), 
  init = character(nrow(d))
)

输出

   time temp     Flag
1     1    1         
2     2    2         
3     3    3         
4     4    4         
5     5    5      D10
6     6  -60  Low_D10
7     7    7         
8     8    8         
9     9    9         
10   10   10         
11   11   NA  MISSING
12   12   12         
13   13   13         
14   14   14         
15   15   15      D10
16   16  160 High_D10
17   17   17         
18   18   18         
19   19   19         
20   20   20

或使用 factor 和 interaction。

na_as <- forcats::fct_explicit_na
DEFAULT <- ""
d$Flag <- trimws(whitespace = "_", interaction(sep = "_", 
  factor(is.na(d$temp), labels = c(DEFAULT, "MISSING")), 
  na_as(factor(findInterval(d$temp, c(-40, 120)), labels = c("Low", DEFAULT, "High")), DEFAULT), 
  na_as(factor(abs(c(diff(d$temp, lag = 1), NA)) > 10, labels = c(DEFAULT, "D10")), DEFAULT)
))

你得到与上面相同的输出。

为观察分配多个文本标志

Assigning multiple text flags to an observation

validation

r

dplyr