实施例

Question

我有兴趣构建一个功能，使用apply / sapply或Map来迭代 dta中的可用列并使用来自无名列表的数据框中的数据框中的匹配值替换每列中的值，其中列表项索引对应于 dta 数据框的列号。

实施例

给定对象：

set.seed(1)
size <- 20

# Data set
dta <-
    data.frame(
        unitA = sample(LETTERS[1:4], size = size, replace = TRUE),
        unitB = sample(letters[16:20], size = size, replace = TRUE),
        unitC = sample(month.abb[1:4], size = size, replace = TRUE),
        someValue = sample(1:1e6, size = size, replace = TRUE)
    )

# Meta data
lstMeta <- list(
    # Unit A definitions
    data.frame(
        V1 = c("A", "B", "D"),
        V2 = c("Letter A", "Letter B", "Letter D")
    ),
    # Unit B definitions
    data.frame(
        V1 = c("t", "q"),
        V2 = c("small t", "small q")
    ),
    # Unit C definitions
    data.frame(
        V1 = c("Mar", "Jan"),
        V2 = c("March", "January")
    )
)

期望的结果

在 dta 上应用时，该函数应返回与以下摘录对应的data.frame：

unitA       unitB    unitC      someValue
Letter B    small t  Apr        912876
Letter B    small q  March      293604
       C    s        Apr        459066
Letter D    p        March      332395
Letter A    small q  March      650871
Letter D    small q  Apr        258017
Letter D    p        January    478546
C           small q  Feb        766311
C           small t  March      84247
Letter A    small q  March      875322
Letter A    r        Feb        339073
Letter A    r        Ap         839441
C           r        Feb        346684
Letter B    p        January    333775
Letter D    small t  January    476352
(...)

现有方法

replaceLbls <- function(dataSet, lstDict) {
    sapply(seq_along(dataSet), function(i) {
        # Take corresponding metadata data frame
        dtaDict <- lstDict[[i]]

        # Replace values in selected column
        # Where matches on V1 push corrsponding values from V2
        dataSet[,i][match(dataSet[,i], dtaDict[,1])] <- dtaDict[,2][match(dtaDict[,1], dataSet[,i])]  
    })
}

# Testing -----------------------------------------------------------------

replaceLbls(dataSet = dta, lstDict = lstMeta)

当然，上面提出的方法不起作用，因为它会尝试在作业中使用NA;但它总结了我想要实现的目标：

x[...] <- m中的错误：NAs在订阅的作业中不允许另外：警告消息：在[<-.factor(*tmp*, match(dataSet[, i], dtaDict[, 1]), value = c(NA,：无效因子级别，NA 产生

补充说明

源数据集

数据的主要特征是：

该列表是无名的，因此子集必须由项目编号而非名称
项目编号对应于列号
数据列表中可用的元数据数据框与数据中可用的单元列之间没有完全匹配
someValue列也应该迭代，因为可能包含应该替换的标签

解决方案

我对基于dplyr / data.table / sqldf的解决方案不感兴趣。
我对嵌套的for - 循环

Answer 1

我有一个不使用for循环或其他包的hacky解决方案。我需要将factors转换为characters才能生效，但您可以改进我的解决方案。

该解决方案仅通过创建匹配找到的索引向量来匹配lstMeta中找到的值。我还使用了<<-运算符。如果你在R比我更好，你可能会改善这一点。

set.seed(1)
size <- 20

# Data set
dta <-
  data.frame(
    unitA = sample(LETTERS[1:4], size = size, replace = TRUE),
    unitB = sample(letters[16:20], size = size, replace = TRUE),
    unitC = sample(month.abb[1:4], size = size, replace = TRUE),
    someValue = sample(1:1e6, size = size, replace = TRUE),
    stringsAsFactors = F
  )

# Meta data
lstMeta <- list(
  # Unit A definitions
  data.frame(
    V1 = c("A", "B", "D"),
    V2 = c("Letter A", "Letter B", "Letter D"),
    stringsAsFactors = F
  ),
  # Unit B definitions
  data.frame(
    V1 = c("t", "q"),
    V2 = c("small t", "small q"),
    stringsAsFactors = F
  ),
  # Unit C definitions
  data.frame(
    V1 = c("Mar", "Jan"),
    V2 = c("March", "January"),
    stringsAsFactors = F
  )
)

replaceLbls <- function(dataSet, lstDict) {
  sapply(1:3, function(i) {
    # Take corresponding metadata data frame
    dtaDict <- lstDict[[i]]

    # Replace values in selected column
    # Where matches on V1 push corrsponding values from V2
    myUniques <- which(dataSet[,i] %in% dtaDict[,1])

    dataSet[myUniques,i]<<- dtaDict[,2][match(dataSet[myUniques,i],dtaDict[,1])]  
  })
  return(dataSet)
}

# Testing -----------------------------------------------------------------

replaceLbls(dataSet = dta, lstDict = lstMeta)

Answer 2

以下方法适用于示例数据：

replaceLbls <- function(dataSet, lstDict) {
  dataSet[seq_along(lstDict)] <- Map(function(x, lst) {
    x <- as.character(x)
    idx <- match(x, as.character(lst$V1))
    replace(x, !is.na(idx), as.character(lst$V2)[na.omit(idx)])
  }, dataSet[seq_along(lstDict)], lstDict)
  dataSet
}


head(replaceLbls(dta, lstMeta))
#      unitA   unitB unitC someValue
# 1 Letter B small t   Apr    912876
# 2 Letter B small q March    293604
# 3        C       s   Apr    459066
# 4 Letter D       p March    332395
# 5 Letter A small q March    650871
# 6 Letter D small q   Apr    258017

这假定您要将更改应用于与元列表一样长的数据的第一个X列。您可能希望包含一个额外的步骤来转换回因子，因为此方法会将调整后的列转换为字符类。

关于因素的另一个评论：您可以通过仅处理任何因子变量的级别而不是整个列来加速性能。一般过程类似，但需要更多步骤来检查类等。

Answer 3

你也可以试试这个：

mapr<-function(t,meta){
    ind<-match(t,meta$V1)
    if(!is.na(ind)){return(meta$V2[ind])}
    else{return(t)}}

然后使用sapply：

dta<-as.data.frame(cbind(sapply(1:3,function(t,df,meta){sapply(df[,t],mapr,lstMeta[[t]])},dta,lstMeta,simplify = T),dta[,4]))

Answer 4

有几个mapply可以完成这项工作

f1 <- function(df, lst){
  d1 <- setNames(data.frame(mapply(function(x, y) x$V2[match(y, x$V1)], lst, df[1:3]), 
                            df$someValue, stringsAsFactors = FALSE), 
                 names(df))
  as.data.frame(mapply(function(x, y) replace(x, is.na(x), y[is.na(x)]), d1, df))

}

迭代数据框中的列，以替换数据框列表中匹配数据的值

实施例

期望的结果

现有方法

补充说明

源数据集

解决方案

4 个答案: