R中的向量化循环操作

Question

我有一个长格式的平衡数据框 (df1)，它有 7 列：

df1 <- structure(list(Product_ID = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 
3, 3, 3, 3), Product_Category = structure(c(1L, 1L, 1L, 1L, 1L, 
2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L), .Label = c("A", "B"), class = "factor"), 
    Manufacture_Date = c(1950, 1950, 1950, 1950, 1950, 1960, 
    1960, 1960, 1960, 1960, 1940, 1940, 1940, 1940, 1940), Control_Date = c(1961L, 
    1962L, 1963L, 1964L, 1965L, 1961L, 1962L, 1963L, 1964L, 1965L, 
    1961L, 1962L, 1963L, 1964L, 1965L), Country_Code = structure(c(1L, 
    1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L), .Label = c("ABC", 
    "DEF", "GHI"), class = "factor"), Var1 = c(NA, NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), Var2 = c(NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA)), row.names = c(NA, 
15L), class = "data.frame")

此数据集中的每个 Product_ID 都与唯一的 Product_Category、Country_Code 和 Manufacture_Date 相关联，并随时间推移 (Control_Date)。 Product_Category 有两个可能的值（A 或 B）； Country_Code 和 Manufacture_Date 分别有 190 和 90 个唯一值。 有 400,000 个唯一的 Product_ID，它们被跟踪了 50 年（Control_Date 从 1961 年到 2010 年）。 这意味着 df1 有 20,000,000 行。 此数据框的最后两列开头为 NA，必须使用另一个数据框 (df2) 中的可用数据进行填充：

df2 <- structure(list(Product_ID = 1:6, Product_Category = structure(c(1L, 
2L, 1L, 1L, 1L, 2L), .Label = c("A", "B"), class = "factor"), 
    Manufacture_Date = c(1950, 1960, 1940, 1950, 1940, 2000), 
    Country_Code = structure(c(1L, 2L, 3L, 1L, 2L, 3L), .Label = c("ABC", 
    "DEF", "GHI"), class = "factor"), Year_1961 = c(5, NA, 10, 
    NA, 6, NA), Year_1962 = c(NA, NA, 4, 5, 3, NA), Year_1963 = c(8, 
    6, NA, 5, 6, NA), Year_1964 = c(NA, NA, 9, NA, 10, NA), Year_1965 = c(6, 
    NA, 7, 4, NA, NA)), row.names = c(NA, 6L), class = "data.frame")

第二个数据框包含关于完全相同的 400,000 种产品的另一种类型的宽格式信息。 每行代表一个唯一的产品 (Product_ID)，并附有其 Product_Category、Manufacture_Date 和 Country_Code。 还有 50 个其他列（从 1961 年到 2010 年的每一年）包含这些年份中每种产品的测量值（或 NA）。

现在我想做的是通过对第二个数据框中可用的数据进行一些计算来填充第一个数据框中的 Var1 和 Var2 列。 更准确地说，对于第一个数据框中的每一行（即 Control_Date "t" 处的产品），最后两列定义如下：

Var1：df2 中具有相同Product_Category、Manufacture_Date 和Country_Code 且Year_t 中具有非NA 值的产品总数；

Var2：df2 中具有不同 Product_Category 但相同 Manufacture_Date 和 Country_Code 且在 Year_t 中具有非 NA 值的产品总数。

我使用嵌套 for 循环的初始解决方案如下：

for (i in unique(df1$Product_ID)){

    Category <- unique(df1[which(df1$Product_ID==i),"Product_Category"])
    Opposite_Category <- ifelse(Category=="A","B","A")
    Manufacture <- unique(df1[which(df1$Product_ID==i),"Manufacture_Date"])
    Country <- unique(df1[which(df1$Product_ID==i),"Country_Code"])

    ID_Similar_Product <- df2[which(df2$Product_Category==Category & df2$Manufacture_Date==Manufacture & df2$Country_Code==Country),"Product_ID"]
    ID_Quasi_Similar_Product <- df2[which(df2$Product_Category==Opposite_Category & df2$Manufacture_Date==Manufacture & df2$Country_Code==Country),"Product_ID"]

    for (j in unique(df1$Control_Date)){
        df1[which(df1$Product_ID==i & df1$Control_Date==j),"Var1"] <- length(which(!is.na(df2[which(df2$Product_ID %in% ID_Similar_Product),paste0("Year_",j)])))
        df1[which(df1$Product_ID==i & df1$Control_Date==j),"Var2"] <- length(which(!is.na(df2[which(df2$Product_ID %in% ID_Quasi_Similar_Product),paste0("Year_",j)])))
    }
}

这种方法的问题在于它需要很多时间来运行。 所以我想知道是否有人可以建议一个可以在更短的时间内完成工作的矢量化版本。

Answer 1

看看这是否符合您的要求。 我正在使用 data.table 包，因为您有一个相当大（20M）的数据集。

library(data.table)

setDT(df1)
setDT(df2)

# Set keys on the "triplet" to speed up everything
setkey(df1, Product_Category, Manufacture_Date, Country_Code)
setkey(df2, Product_Category, Manufacture_Date, Country_Code)

# Omit the Var1 and Var2 from df1
df1[, c("Var1", "Var2") := NULL]

# Reshape df2 to long form
df2.long <- melt(df2, measure=patterns("^Year_"))

# Split "variable" at the "_" to extract 4-digit year into "Control_Date" and delete leftovers.
df2.long[, c("variable","Control_Date") := tstrsplit(variable, "_", fixed=TRUE)][
  , variable := NULL]

# Group by triplet, Var1=count non-NA in value, join with... 
#   (Group by doublet, N=count non-NA), update Var2=N-Var1.
df2_N <- df2.long[, .(Var1 = sum(!is.na(value))), 
                   by=.(Product_Category, Manufacture_Date, Country_Code)][
                     df2.long[, .(N = sum(!is.na(value))), 
                              by=.(Manufacture_Date, Country_Code)], 
                     Var2 := N - Var1, on=c("Manufacture_Date", "Country_Code")]

# Update join: df1 with df2_N
df1[df2_N, c("Var1","Var2") := .(i.Var1, i.Var2), 
           on = .(Product_Category, Manufacture_Date, Country_Code)]

---

df1
   Product_ID Product_Category Manufacture_Date Control_Date Country_Code Var1 Var2
 1:          3                A             1940         1961          GHI    4    0
 2:          3                A             1940         1962          GHI    4    0
 3:          3                A             1940         1963          GHI    4    0
 4:          3                A             1940         1964          GHI    4    0
 5:          3                A             1940         1965          GHI    4    0
 6:          1                A             1950         1961          ABC    6    0
 7:          1                A             1950         1962          ABC    6    0
 8:          1                A             1950         1963          ABC    6    0
 9:          1                A             1950         1964          ABC    6    0
10:          1                A             1950         1965          ABC    6    0
11:          2                B             1960         1961          DEF   NA   NA
12:          2                B             1960         1962          DEF   NA   NA
13:          2                B             1960         1963          DEF   NA   NA
14:          2                B             1960         1964          DEF   NA   NA
15:          2                B             1960         1965          DEF   NA   NA

---

df2
   Product_ID Product_Category Manufacture_Date Country_Code Year_1961 Year_1962 Year_1963 Year_1964 Year_1965
1:          5                A             1940          DEF         6         3         6        10        NA
2:          3                A             1940          GHI        10         4        NA         9         7
3:          1                A             1950          ABC         5        NA         8        NA         6
4:          4                A             1950          ABC        NA         5         5        NA         4
5:          2                B             1940          DEF        NA        NA         6        NA        NA
6:          6                B             2000          GHI        NA        NA        NA        NA        NA