簡體   English   中英

使用查找表將多個列添加到數據框

[英]Adding multiple columns to a dataframe using lookup table

我有一個數據表,想使用查找表對其進行修改。 我想遍歷數據中的代碼列,並根據匹配的datayear列和匹配查找表的field列中正確行值的代碼列的名稱,為每個代碼列添加一個新的對應value列。

我嘗試將lapply與left_join一起使用,但是我無法鍛煉如何使用數據列名稱在查找的field列中引用正確的值。 我還考慮了查找表在寬格式下是否可能更好,因此您至少要具有匹配的列名,但是我仍然無法生成可行的函數。

示例數據和所需的輸出:

數據(編輯:實際數據將包含更多代碼列):

structure(list(id = 1:10, datayear = c(2007L, 2007L, 2007L, 2007L, 
2007L, 2008L, 2008L, 2008L, 2008L, 2008L), nationalitycode = c(1L, 
1L, 1L, 2L, 3L, 5L, 4L, 3L, 2L, 1L), subjectcode = c(2L, 5L, 
5L, 5L, 2L, 5L, 4L, 2L, 1L, 4L)), .Names = c("id", "datayear", 
"nationalitycode", "subjectcode"), class = "data.frame", row.names = c(NA, 
-10L))

   id datayear nationalitycode subjectcode
1   1     2007               1           2
2   2     2007               1           5
3   3     2007               1           5
4   4     2007               2           5
5   5     2007               3           2
6   6     2008               5           5
7   7     2008               4           4
8   8     2008               3           2
9   9     2008               2           1
10 10     2008               1           4

查找表:

structure(list(datayear = c(2007L, 2007L, 2007L, 2007L, 2007L, 
2007L, 2007L, 2007L, 2007L, 2007L, 2008L, 2008L, 2008L, 2008L, 
2008L, 2008L, 2008L, 2008L, 2008L, 2008L), field = structure(c(1L, 
1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 2L), .Label = c("nationalitycode", "subjectcode"), class = "factor"), 
    code = c(1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 
    3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L), lookupvalue = structure(c(10L, 
    16L, 9L, 4L, 5L, 2L, 7L, 13L, 1L, 14L, 5L, 16L, 4L, 6L, 11L, 
    17L, 3L, 15L, 8L, 12L), .Label = c("Algebra", "Art", "Beekeeping", 
    "Chinese", "English", "French", "Geography", "H.E.", "Indian", 
    "Irish", "Italian", "Latin", "Maths", "P.E.", "Rivetting", 
    "Scottish", "Sewing"), class = "factor")), class = "data.frame", row.names = c(NA, 
-20L), .Names = c("datayear", "field", "code", "lookupvalue"))

   datayear           field code lookupvalue
1      2007 nationalitycode    1       Irish
2      2007 nationalitycode    2    Scottish
3      2007 nationalitycode    3      Indian
4      2007 nationalitycode    4     Chinese
5      2007 nationalitycode    5     English
6      2007     subjectcode    1         Art
7      2007     subjectcode    2   Geography
8      2007     subjectcode    3       Maths
9      2007     subjectcode    4     Algebra
10     2007     subjectcode    5        P.E.
11     2008 nationalitycode    1     English
12     2008 nationalitycode    2    Scottish
13     2008 nationalitycode    3     Chinese
14     2008 nationalitycode    4      French
15     2008 nationalitycode    5     Italian
16     2008     subjectcode    1      Sewing
17     2008     subjectcode    2  Beekeeping
18     2008     subjectcode    3   Rivetting
19     2008     subjectcode    4        H.E.
20     2008     subjectcode    5       Latin

所需的輸出:

   id datayear nationalitycode subjectcode nationalityvalue subjectvalue
1   1     2007               1           2            Irish    Geography
2   2     2007               1           5            Irish         P.E.
3   3     2007               1           5            Irish         P.E.
4   4     2007               2           5         Scottish         P.E.
5   5     2007               3           2           Indian    Geography
6   6     2008               5           5          Italian        Latin
7   7     2008               4           4           French         H.E.
8   8     2008               3           2          Chinese   Beekeeping
9   9     2008               2           1         Scottish       Sewing
10 10     2008               1           4          English         H.E.

非常感謝您的協助!

訣竅是根據您的查找表的適當子集進行聯接。 那就是通過使用正確的字段值進行子集化。

library(dplyr)

dt1 = structure(list(id = 1:10, datayear = c(2007L, 2007L, 2007L, 2007L, 
2007L, 2008L, 2008L, 2008L, 2008L, 2008L), nationalitycode = c(1L, 
1L, 1L, 2L, 3L, 5L, 4L, 3L, 2L, 1L), subjectcode = c(2L, 5L, 
5L, 5L, 2L, 5L, 4L, 2L, 1L, 4L)), .Names = c("id", "datayear", 
"nationalitycode", "subjectcode"), class = "data.frame", row.names = c(NA, -10L))


dt2 = structure(list(datayear = c(2007L, 2007L, 2007L, 2007L, 2007L, 
2007L, 2007L, 2007L, 2007L, 2007L, 2008L, 2008L, 2008L, 2008L, 
2008L, 2008L, 2008L, 2008L, 2008L, 2008L), field = structure(c(1L, 
1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 2L), .Label = c("nationalitycode", "subjectcode"), class = "factor"), 
code = c(1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 
3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L), lookupvalue = structure(c(10L, 
16L, 9L, 4L, 5L, 2L, 7L, 13L, 1L, 14L, 5L, 16L, 4L, 6L, 11L, 
17L, 3L, 15L, 8L, 12L), .Label = c("Algebra", "Art", "Beekeeping", 
"Chinese", "English", "French", "Geography", "H.E.", "Indian", 
"Irish", "Italian", "Latin", "Maths", "P.E.", "Rivetting", 
"Scottish", "Sewing"), class = "factor")), class = "data.frame", row.names = c(NA, 
-20L), .Names = c("datayear", "field", "code", "lookupvalue"))


dt1 %>%
  left_join(dt2 %>% filter(field == "nationalitycode"), by=c("datayear"="datayear","nationalitycode"="code")) %>%
  left_join(dt2 %>% filter(field == "subjectcode"), by=c("datayear"="datayear","subjectcode"="code")) %>%
  rename(nationalityvalue = lookupvalue.x,
         subjectvalue = lookupvalue.y) %>%
  select(-field.x, -field.y)

#    id datayear nationalitycode subjectcode nationalityvalue subjectvalue
# 1   1     2007               1           2            Irish    Geography
# 2   2     2007               1           5            Irish         P.E.
# 3   3     2007               1           5            Irish         P.E.
# 4   4     2007               2           5         Scottish         P.E.
# 5   5     2007               3           2           Indian    Geography
# 6   6     2008               5           5          Italian        Latin
# 7   7     2008               4           4           French         H.E.
# 8   8     2008               3           2          Chinese   Beekeeping
# 9   9     2008               2           1         Scottish       Sewing
# 10 10     2008               1           4          English         H.E.

對於使用循環請求的更一般的情況,我需要重塑您的查找表,以便可以使用列名。 該過程將自動檢測您的查找表中有多少個唯一字段,並將使用for循環(順序)執行聯接。

library(dplyr)
library(tidyr)

dt1 = structure(list(id = 1:10, datayear = c(2007L, 2007L, 2007L, 2007L, 
2007L, 2008L, 2008L, 2008L, 2008L, 2008L), nationalitycode = c(1L, 
1L, 1L, 2L, 3L, 5L, 4L, 3L, 2L, 1L), subjectcode = c(2L, 5L, 
5L, 5L, 2L, 5L, 4L, 2L, 1L, 4L)), .Names = c("id", "datayear", 
"nationalitycode", "subjectcode"), class = "data.frame", row.names = c(NA, -10L))


dt2 = structure(list(datayear = c(2007L, 2007L, 2007L, 2007L, 2007L, 
2007L, 2007L, 2007L, 2007L, 2007L, 2008L, 2008L, 2008L, 2008L, 
2008L, 2008L, 2008L, 2008L, 2008L, 2008L), field = structure(c(1L, 
1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 2L), .Label = c("nationalitycode", "subjectcode"), class = "factor"), 
code = c(1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 
3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L), lookupvalue = structure(c(10L, 
16L, 9L, 4L, 5L, 2L, 7L, 13L, 1L, 14L, 5L, 16L, 4L, 6L, 11L, 
17L, 3L, 15L, 8L, 12L), .Label = c("Algebra", "Art", "Beekeeping", 
"Chinese", "English", "French", "Geography", "H.E.", "Indian", 
"Irish", "Italian", "Latin", "Maths", "P.E.", "Rivetting", 
"Scottish", "Sewing"), class = "factor")), class = "data.frame", row.names = c(NA, 
-20L), .Names = c("datayear", "field", "code", "lookupvalue"))


# reshape your lookup data
dt2 %>%
  spread(field, code) -> dt2_reshaped

# start dataset (to join every field you have)
dt_temp = dt1

# for every field you have do the join
for (fld in as.character(unique(dt2$field))) {

  dt_temp %>% left_join(dt2_reshaped %>% select_("datayear", "lookupvalue", fld), by=c("datayear",fld)) -> dt_temp
  names(dt_temp)[names(dt_temp) == "lookupvalue" ] = gsub("code","value",fld)

}


dt_temp

#    id datayear nationalitycode subjectcode nationalityvalue subjectvalue
# 1   1     2007               1           2            Irish    Geography
# 2   2     2007               1           5            Irish         P.E.
# 3   3     2007               1           5            Irish         P.E.
# 4   4     2007               2           5         Scottish         P.E.
# 5   5     2007               3           2           Indian    Geography
# 6   6     2008               5           5          Italian        Latin
# 7   7     2008               4           4           French         H.E.
# 8   8     2008               3           2          Chinese   Beekeeping
# 9   9     2008               2           1         Scottish       Sewing
# 10 10     2008               1           4          English         H.E.

如果X是您的第一個data.frameLU是您的第二個,則data.tablemerge使此過程變得簡單,而且很重要的一點是要使其清晰。

library(data.table)

# Convert the data.frames into data.tables
setDT(X)
setDT(LU)

# Join the tables on datayear and the appropriate code, for the 
# nationality data only.
X1 <- merge(X, LU[field == "nationalitycode"],
            by.x=c("datayear", "nationalitycode"),
            by.y=c("datayear", "code"))

# Now join the resulting table by subjectcode. 
X2 <- merge(X1, LU[field == "subjectcode"],
            by.x=c("datayear", "subjectcode"),
            by.y=c("datayear", "code"))

# Now subset the data.table to the columns you want, set the key 
# (order) by id, and rename some columns.
M <- X2[, c("id", "datayear", "nationalitycode", "subjectcode",
            "lookupvalue.x", "lookupvalue.y"), with=FALSE]
setkey(M, "id")
setnames(M, c("lookupvalue.x", "lookupvalue.y"),
         c("nationalityvalue", "subjectvalue"))

M
#     id datayear nationalitycode subjectcode nationalityvalue subjectvalue
#  1:  1     2007               1           2            Irish    Geography
#  2:  2     2007               1           5            Irish         P.E.
#  3:  3     2007               1           5            Irish         P.E.
#  4:  4     2007               2           5         Scottish         P.E.
#  5:  5     2007               3           2           Indian    Geography
#  6:  6     2008               5           5          Italian        Latin
#  7:  7     2008               4           4           French         H.E.
#  8:  8     2008               3           2          Chinese   Beekeeping
#  9:  9     2008               2           1         Scottish       Sewing
# 10: 10     2008               1           4          English         H.E.

您可以采取一些措施來縮短時間,但是我認為這很清楚發生了什么。

編輯:這是一個應該可以幫助您入門的功能:

merge_fn <- function(column, data=X, lookup=LU)
{
    value_nm <- paste0(gsub("code", "", column),
                      "value")

    X1 <- merge(data, LU[field == column],
               by.x=c("datayear", column),
               by.y=c("datayear", "code"))

    setnames(X1, "lookupvalue", value_nm)
    X1[, !"field", with=FALSE]
}

M <- merge_fn("subjectcode", data=merge_fn("nationalitycode"))
setkey(M, "id")
M
#     datayear subjectcode nationalitycode id nationalityvalue subjectvalue
#  1:     2007           2               1  1            Irish    Geography
#  2:     2007           5               1  2            Irish         P.E.
#  3:     2007           5               1  3            Irish         P.E.
#  4:     2007           5               2  4         Scottish         P.E.
#  5:     2007           2               3  5           Indian    Geography
#  6:     2008           5               5  6          Italian        Latin
#  7:     2008           4               4  7           French         H.E.
#  8:     2008           2               3  8          Chinese   Beekeeping
#  9:     2008           1               2  9         Scottish       Sewing
# 10:     2008           4               1 10          English         H.E.

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM