的更新

Question

我想搜索一个变量placement的内容，并根据所寻找的模式创建一个新变量term。一个最小的例子......

首先我创建一个搜索模式函数：

calcterm <- function(x){    # calcterm takes a column argument to read
    print(x)
    if (x %in% '_fa_') {
            return ('fall')
    } else if (x %in% '_wi_') {
            return('winter')
    } else if (x %in% '_sp_') {
            return('spring')
    } else {return('summer')
    }
}

我会创建一个小数据框，然后我会将其传递给dplyr＆＃39; tbl_df：

placement <- c('pn_ds_ms_fa_th_hrs','pn_ds_ms_wi_th_hrs' ,'pn_ds_ms_wi_th_hrs')
hours <- c(1230, NA, 34)

d <- data.frame(placement, hours)

library(dplyr)

d <- tbl_df(d)

表d现在显示为：

>d
    Source: local data frame [3 x 2]

       placement hours
          (fctr) (dbl)
1 pn_ds_ms_fa_th_hrs  1230
2 pn_ds_ms_wi_th_hrs    NA
3 pn_ds_ms_wi_th_hrs    34

接下来，我使用mutate来实现我的功能。目标是阅读placement的内容，并创建一个新变量，其值将为fall，winter，spring或{{1取决于summer列中找到的模式。

placement

输出给我留下了

d %>% mutate(term=calcterm(placement))

所以，显然我在一开始就写错了...也许[1] pn_ds_ms_fa_th_hrs pn_ds_ms_wi_th_hrs pn_ds_ms_wi_th_hrs Levels: pn_ds_ms_fa_th_hrs pn_ds_ms_wi_th_hrs Source: local data frame [3 x 3] placement hours term (fctr) (dbl) (chr) 1 pn_ds_ms_fa_th_hrs 1230 summer 2 pn_ds_ms_wi_th_hrs NA summer 3 pn_ds_ms_wi_th_hrs 34 summer Warning messages: 1: In if (x %in% "_fa_") { : the condition has length > 1 and only the first element will be used 2: In if (x %in% "_wi_") { : the condition has length > 1 and only the first element will be used 3: In if (x %in% "_sp_") { : the condition has length > 1 and only the first element will be used可以换成grep模式？我不知道如何处理。

感谢。

的更新

根据下面的回复，我用我的全系列管道更新了这个，以显示我是如何实现这一点的。我正在使用的数据是＆＃34;宽＆＃34;我开始只是翻转它的轴，并从组合名中提取有用的信息。这个例子有效 - 但是在我自己的数据中，当我进入mutate（）步骤时，我收到了消息：%in%

值得注意的是，在总结（）之后我收到了警告：

Error: invalid subscript type 'list'

也许这与下一步失败有关？由于警告没有出现在我的例子中？

Warning message:
attributes are not identical across measure variables; they will be dropped

Answer 1

一种简单而有效的方法可能是创建一个简单的查找/模式向量，然后将（非常有效的）stringi::stri_detect_fixed和data.table结合起来。即使对于大型数据集，此解决方案也应该非常好地扩展

library(stringi)
library(data.table)
Lookup <- c("fall", "winter", "spring")
Patterns <- c("fa", "wi", "sp")
setDT(d)[, term := Lookup[stri_detect_fixed(placement, Patterns)], by = placement]
d[is.na(term), term := "summer"]
d
#             placement hours   term
# 1: pn_ds_ms_fa_th_hrs  1230   fall
# 2: pn_ds_ms_wi_th_hrs    NA winter
# 3: pn_ds_ms_wi_th_hrs    34 winter

如果我们坚持dplyr，我们需要创建一个辅助函数来处理未找到匹配的情况（data.table自动处理的事情）

f <- function(x, Lookup, Patterns) {
  temp <- Lookup[stri_detect_fixed(x[1L], Patterns)]
  if(!length(temp)) return("summer")
  temp
}

d %>%
  group_by(placement) %>%
  mutate(term = f(placement, Lookup, Patterns))

# Source: local data frame [3 x 3]
# Groups: placement [2]
# 
#           placement hours   term
#               (fctr) (dbl)  (chr)
# 1 pn_ds_ms_fa_th_hrs  1230   fall
# 2 pn_ds_ms_wi_th_hrs    NA winter
# 3 pn_ds_ms_wi_th_hrs    34 winter

Answer 2

问题是你不能在if语句中放置逻辑向量。 R的响应是仅使用逻辑向量中的第一个元素，并抛出你得到的警告信息。

要解决此问题，我将使用grepl。首先，让我们创建一些示例数据：

s = c('bla_wi', 'spam_sp', 'egg_sp', 'ham_fa')

接下来，我们需要意识到您无法将多种搜索模式传递给grepl。幸运的是，我们可以通过在grepl参数中向量化pattern来解决这个问题：

grepl_vec_pattern = Vectorize(grepl, 'pattern')
grepped_patterns = grepl_vec_pattern(s, pattern = c('_sp', '_su', '_fa', '_wi'))
grepped_patterns
#        _sp   _su   _fa   _wi
# [1,] FALSE FALSE FALSE  TRUE
# [2,]  TRUE FALSE FALSE FALSE
# [3,]  TRUE FALSE FALSE FALSE
# [4,] FALSE FALSE  TRUE FALSE

grepped_patterns中的每一列都表示模式是否匹配。

接下来我们要将其减少为一个向量，该向量列出了与该元素匹配的模式（假设只有一个模式明显匹配）：

library(pryr)
reduce_to_colname_with_true = apply(grepped_patterns, 1, compose(names, which))
reduce_to_colname_with_true
# [1] "_wi" "_sp" "_sp" "_fa"

请注意compose(A, B)等于A(B())，即调用嵌套函数。我选择使用compose来阻止使用匿名函数，例如：function(x) names(which(x))。

现在我们有了这些信息，我们需要将_sp翻译为spring等等：

lut_table = c('_sp' = 'spring', '_su' = 'summer', '_fa' = 'fall', '_wi' = 'winter')
lut_table[reduce_to_colname_with_true]
#      _wi      _sp      _sp      _fa 
# "winter" "spring" "spring"   "fall"

我们有所需的结果。要在mutate中使用它，我们可以将这一切包装在一个函数中：

calcterm = function(s) {
    require(pryr)
    s = as.character(s)
    grepped_patterns = grepl_vec_pattern(s, pattern = c('_sp', '_su', '_fa', '_wi'))
    stopifnot(any(rowSums(grepped_patterns) == 1))   # Ensure that there is exactly one match
    reduce_to_colname_with_true = apply(grepped_patterns, 1, compose(names, which))
    lut_table = c('_sp' = 'spring', '_su' = 'summer', '_fa' = 'fall', '_wi' = 'winter')
    lut_table[reduce_to_colname_with_true]
}
library(dplyr)
df = data.frame(s = s) %>% mutate(term = calcterm(s))
df
        s   term
1  bla_wi winter
2 spam_sp spring
3  egg_sp spring
4  ham_fa   fall

在R中，使用dplyr的mutate（）创建一个以另一个的内容为条件的新变量

的更新

2 个答案: