在 R 中使用模式匹配从现有列创建新列

Question

我正在尝试添加一个基于另一个使用模式匹配的新列。 我读过this post，但没有得到想要的输出。

我想基于 GreatGroup 列创建一个新列 (SubOrder)。 我尝试了以下方法：

SubOrder <- rep(NA_character_, length(myData))

SubOrder[grepl("udults", myData, ignore.case = TRUE)] <-  "Udults"
SubOrder[grepl("aquults", myData, ignore.case = TRUE)] <-  "Aquults"
SubOrder[grepl("aqualfs", myData, ignore.case = TRUE)] <-  "aqualfs"
SubOrder[grepl("humods", myData, ignore.case = TRUE)] <-  "humods"
SubOrder[grepl("udalfs", myData, ignore.case = TRUE)] <-  "udalfs"
SubOrder[grepl("orthods", myData, ignore.case = TRUE)] <-  "orthods"
SubOrder[grepl("udalfs", myData, ignore.case = TRUE)] <-  "udalfs"
SubOrder[grepl("psamments", myData, ignore.case = TRUE)] <-  "psamments"
SubOrder[grepl("udepts", myData, ignore.case = TRUE)] <-  "udepts"
SubOrder[grepl("fluvents", myData, ignore.case = TRUE)] <-  "fluvents"
SubOrder[grepl("aquods", myData, ignore.case = TRUE)] <-  "aquods"

例如，我在任何单词中查找“udults”，例如 Hapludults 或 Paleudults，然后只返回“udults”。

编辑：如果有人想看看 alistaire 的评论，这就是我会使用的搜索模式。

 subOrderNames <- c("Udults", "Aquults", "Aqualfs", "Humods", "Udalfs", "Orthods", "Psamments", "Udepts", "fluvents")

下面的示例数据。

myData <- dput(head(test))
structure(list(1:6, SID = c(200502L, 200502L, 200502L, 200502L, 
200502L, 200502L), Groupdepth = c(11L, 12L, 13L, 14L, 21L, 22L
), AWC0to10 = c(0.12, 0.12, 0.12, 0.12, 0.12, 0.12), AWC10to20 = c(0.12, 
0.12, 0.12, 0.12, 0.12, 0.12), AWC20to50 = c(0.12, 0.12, 0.12, 
0.12, 0.12, 0.12), AWC50to100 = c(0.15, 0.15, 0.15, 0.15, 0.15, 
0.15), Db3rdbar0to10 = c(1.43, 1.43, 1.43, 1.43, 1.43, 1.43), 
    Db3rdbar10to20 = c(1.43, 1.43, 1.43, 1.43, 1.43, 1.43), Db3rdbar20to50 = c(1.43, 
    1.43, 1.43, 1.43, 1.43, 1.43), Db3rdbar50to100 = c(1.43, 
    1.43, 1.43, 1.43, 1.43, 1.43), HydrcRatngPP = c(0L, 0L, 0L, 
    0L, 0L, 0L), OrgMatter0to10 = c(1.25, 1.25, 1.25, 1.25, 1.25, 
    1.25), OrgMatter10to20 = c(1.25, 1.25, 1.25, 1.25, 1.25, 
    1.25), OrgMatter20to50 = c(1.02, 1.02, 1.02, 1.02, 1.02, 
    1.02), OrgMatter50to100 = c(0.12, 0.12, 0.12, 0.12, 0.12, 
    0.12), Clay0to10 = c(8, 8, 8, 8, 8, 8), Clay10to20 = c(8, 
    8, 8, 8, 8, 8), Clay20to50 = c(9.4, 9.4, 9.4, 9.4, 9.4, 9.4
    ), Clay50to100 = c(40, 40, 40, 40, 40, 40), Sand0to10 = c(85, 
    85, 85, 85, 85, 85), Sand10to20 = c(85, 85, 85, 85, 85, 85
    ), Sand20to50 = c(83, 83, 83, 83, 83, 83), Sand50to100 = c(45.8, 
    45.8, 45.8, 45.8, 45.8, 45.8), pHwater0to20 = c(6.3, 6.3, 
    6.3, 6.3, 6.3, 6.3), Ksat0to10 = c(23, 23, 23, 23, 23, 23
    ), Ksat10to20 = c(23, 23, 23, 23, 23, 23), Ksat20to50 = c(19.7333, 
    19.7333, 19.7333, 19.7333, 19.7333, 19.7333), Ksat50to100 = c(9, 
    9, 9, 9, 9, 9), TaxClName = c("Fine, mixed, semiactive, mesic Oxyaquic Hapludults", 
    "Fine, mixed, semiactive, mesic Oxyaquic Hapludults", "Fine, mixed, semiactive, mesic Oxyaquic Hapludults", 
    "Fine, mixed, semiactive, mesic Oxyaquic Hapludults", "Fine, mixed, semiactive, mesic Oxyaquic Hapludults", 
    "Fine, mixed, semiactive, mesic Oxyaquic Hapludults"), GreatGroup = c("Hapludults", 
    "Hapludults", "Hapludults", "Hapludults", "Hapludults", "Hapludults"
    )), .Names = c("", "SID", "Groupdepth", "AWC0to10", "AWC10to20", 
"AWC20to50", "AWC50to100", "Db3rdbar0to10", "Db3rdbar10to20", 
"Db3rdbar20to50", "Db3rdbar50to100", "HydrcRatngPP", "OrgMatter0to10", 
"OrgMatter10to20", "OrgMatter20to50", "OrgMatter50to100", "Clay0to10", 
"Clay10to20", "Clay20to50", "Clay50to100", "Sand0to10", "Sand10to20", 
"Sand20to50", "Sand50to100", "pHwater0to20", "Ksat0to10", "Ksat10to20", 
"Ksat20to50", "Ksat50to100", "TaxClName", "GreatGroup"), class = c("tbl_df", 
"data.frame"), row.names = c(NA, -6L))

Answer 1

一些选项，其中一些我在上面的 cmets 中发布。

注意：所有选项都假定替换匹配模式的字符串只是模式。如果您想要其他内容，它们都可以轻松编辑以包含单独的替换值。

选项 1：for + grepl

使用与原始代码相同的代码，但循环以避免重复代码：

# make a list of patterns
pat <- c('udults', 'aquults', 'aqualfs', 'humods', 'udalfs', 'orthods', 'psamments', 'udepts', 'fluvents', 'aquods')

SubOrder <- rep(NA_character_, length(myData))

for(x in 1:length(pat)){
  SubOrder[grepl(pat[x], myData$GreatGroup, ignore.case = TRUE)] <-  pat[x]
}

---

选项 2：for + gsub

通过复制myData$GreatGroup 并使用gsub 更改它来构建新列。粘贴的额外正则表达式包含同一字符串中的字符。

myData$SubOrder <- myData$GreatGroup
for(x in pat){
  myData$SubOrder <- gsub(paste0('.*', x, '.*'), x, myData$SubOrder, ignore.case = TRUE)
}

请注意，与pat 中的字符串之一不匹配的值将具有来自GreatGroup 的值，而不是NA。如果您希望它们成为NA，请使用

修复它们

myData$SubOrder[!(myData$SubOrder %in% pat)] <- NA

---

选项3：命名列表+stringr::str_replace_all

我最喜欢它，因为它不循环，尽管它需要 stringr 包（无论如何，这非常棒）。

从pat创建一个命名列表，其中名称是要替换的正则表达式，项目是要匹配的字符串：

l <- as.list(pat)
names(l) <- paste0('.*', pat, '.*')

看起来像

> l
$`.*udults.*`
[1] "udults"

$`.*aquults.*`
[1] "aquults"

$`.*aqualfs.*`
[1] "aqualfs"
......

然后使用str_replace_all 一次性完成所有操作：

myData$SubOrder <- str_replace_all(myData$GreatGroup, l)

轰隆隆。

注意 1： str_replace_all 没有 ignore.case 选项，但您可以将 myData$GreatGroup 包裹在 tolower 中（简单）或重新配置正则表达式（困难）。

注意 2： 与 选项 2 一样，它将不匹配的条目保留为来自 GreatGroup 的值，因此使用该选项末尾的行返回NAs，如果你愿意的话。

Answer 2

我正在使用 dplyr，但您可能需要创建一个巨大的嵌套 ifelse 语句...

library(dplyr)

myData %>%
  mutate(SubOrder = ifelse(grepl('udults', GreatGroup, ignore.case = T), 'Udults',
                           ifelse(grepl('aquults', GreatGroup, ignore.case = T, 'Aquults',
                                        ###  All of the other ifelse statements
                                        ifelse(grepl('fluvents', GreatGroup, ignore.case = T), 'fluvents', 'aquods')
                           ))))

Answer 3

试试这个：

myData$SubOrder[grepl("udults", myData$TaxClName, ignore.case = TRUE) | grepl("udults", myData$GreatGroup, ignore.case = TRUE)] <-  "Udults"

您可以根据需要向过滤器添加任意数量的列。

Answer 4

您可以使用一个连续替换每个模式的函数来执行此操作，从而避免一遍又一遍地重复您的代码。请注意，使用这种方法，如果给定字符串匹配多个模式，则替换序列中的第一个模式将被使用。

# multi-grepl function adapted from http://stackoverflow.com/a/15254254/496488
mgrepl <- function(pattern, replacement, x, ...) {
  if (length(pattern) != length(replacement)) {
    stop("pattern and replacement do not have the same length.")
  }
  result <- x
  for (i in 1:length(pattern)) {
    result[grepl(pattern[i], result, ...)] = replacement[i]
  }
  result
}

# Patterns and replacements
pat = c("udults","aquults","humods","fluvents")
repl = c("Udults","Aquults","humods","fluvents")

SubOrder =  mgrepl(pat, repl, myData$GreatGroup)

SubOrder

[1] "Udults" "Udults" "Udults" "Udults" "Udults" "Udults"

# Or, if you want to add this as a new column to the data:
myData$SubOrder = mgrepl(pat, repl, myData$GreatGroup)

另外一个说明：问题中的代码的一个问题是您引用了整个数据框，而不是您要替换的列：

SubOrder[grepl("udults", myData, ignore.case = TRUE)] <-  "Udults"

应该改为

SubOrder[grepl("udults", myData$GreatGroup, ignore.case = TRUE)] <-  "Udults"

更新：关于您的评论，请参阅下面的代码。该函数确实将这两个值都替换为“Udults”。

myData$GreatGroup[1] = "Paleudults"

myData$GreatGroup

[1] "Paleudults" "Hapludults" "Hapludults" "Hapludults" "Hapludults" "Hapludults"

mgrepl(pat, repl, myData$GreatGroup)

[1] "Udults" "Udults" "Udults" "Udults" "Udults" "Udults"