Question

我有2个带有多个因子列的数据框。一个是基础数据帧，另一个是最终数据帧。我想使用最终数据帧更新基本数据帧的级别。

考虑以下示例：

base <- data.frame(product=c("Business Call", "Business Transactional", 
                             "Monthly Non-Compounding and Standard Non-Compounding",
                             "OCR based Call", "Offsale Call", "Offsale Savings",
                             "Offsale Transactional", "Out of Scope","Personal Call"))
base$product <- as.factor(base$product)

final <- data.frame(product=c("Business Call", "Business Transactional", 
                              "Monthly Standard Non-Compounding", "OCR based Call", 
                              "Offsale Call", "Offsale Savings","Offsale Transactional", 
                              "Out of Scope","Personal Call", "You Money")) 
final$product <- as.factor(final$product)

我现在想要的是使最终数据库具有与基准相同的级别，并删除“ You Money”之类根本不存在的级别。而“每月标准非复合”要模糊匹配

例如：

levels(base$var1) <- "a" "b" "c"
levels(final$var1) <- "Aa" "Bb" "Cc"

有没有办法通过某种模糊匹配使用最终数据覆盖基础数据中的水平？

就像我希望两个数据的最终级别一样。即

levels(base$var1) <- "Aa" "Bb" "Cc"
levels(final$var1) <- "Aa" "Bb" "Cc"

Answer 1

我们可以构建自己的fuzzyMatcher。

首先，我们需要一种矢量化agrep函数，

agrepv <- function(x, y) all(as.logical(sapply(x, agrep, y)))

我们在其中构建fuzzyMatcher的地方。

fuzzyMatcher <-  function(from, to) { 
  mc <- mapply(function(y) 
    which(mapply(function(x) agrepv(y, x), Map(levels, to))), 
    Map(levels, from))
  return(Map(function(x, y) `levels<-`(x, y), base, 
             Map(levels, from)[mc]))
}

final标签应用于base标签（请注意，我已经对列进行了移动，使其更加复杂）：

base[] <- fuzzyMatcher(final1, base1)
#    X1 X2
# 1  Aa Xx
# 2  Aa Xx
# 3  Aa Yy
# 4  Aa Yy
# 5  Bb Yy
# 6  Bb Zz
# 7  Bb Zz
# 8  Aa Xx
# 9  Cc Xx
# 10 Cc Zz

更新

根据上面提供的新数据，可以使用另一个矢量化的agrepv2()，将其与outer()配合使用，使我们可以将agrep应用于所有级别的组合两个向量。此后，colSums等于零，给我们非匹配级别，而which.max给我们目标数据帧final的匹配级别。我们可以使用这两个结果向量，一方面删除final的未使用的行，另一方面可以对base数据帧的所需级别进行子集，以重建因子列。

# add to mimic other columns in data frame
base$x <- seq(nrow(base))
final$x <- seq(nrow(final))

# some abbrevations for convenience
p1 <- levels(base$product)
p2 <- levels(final$product)

# agrep
AGREPV2 <- Vectorize(function(x, y, ...) agrep(p2[x], p1[y]))  # new vectorized agrep 
out <- t(outer(seq(p2), seq(p1), agrepv2, max.distance=0.9))  # apply `agrepv2`
del.col <- grep(0, colSums(apply(out, 2, lengths))) # find negative matches
lvl <- unlist(apply(out, 2, which.max))  # find positive matches
lvl <- as.character(p2[lvl])  # get the labels

# delete "non-existing" rows and re-generate factor with new labels
transform(final[-del.col, ], product=factor(product, labels=lvl))
#                  product x
# 1          Business Call 1
# 2 Business Transactional 2
# 4         OCR based Call 4
# 5           Offsale Call 5
# 6        Offsale Savings 6
# 7  Offsale Transactional 7
# 8           Out of Scope 8
# 9          Personal Call 9

数据

base1 <- structure(list(X1 = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 1L, 
3L, 3L), .Label = c("a", "b", "c"), class = "factor"), X2 = structure(c(1L, 
1L, 2L, 2L, 2L, 3L, 3L, 1L, 1L, 3L), .Label = c("x", "y", "z"
), class = "factor")), row.names = c(NA, -10L), class = "data.frame")

final1 <- structure(list(X1 = structure(c(1L, 3L, 1L, 1L, 2L, 3L, 2L, 1L, 
2L, 2L, 3L, 3L, 2L, 2L, 2L), .Label = c("Xx", "Yy", "Zz"), class = "factor"), 
    X2 = structure(c(2L, 1L, 1L, 2L, 2L, 3L, 3L, 1L, 1L, 2L, 
    2L, 2L, 2L, 2L, 3L), .Label = c("Aa", "Bb", "Cc"), class = "factor")), row.names = c(NA, 
-15L), class = "data.frame")

使用另一个数据框覆盖一个数据框中的因子列的级别

1 个答案:

更新

数据