Question

我正在尝试执行以下操作，我最初发布了一个更简单的版本，这个想法可以概括但现在已经意识到它不会被解决，所以我在这里重新发布问题

原始问题（及解决方案）可在此处找到：Matching data from one data frame to another

我有两个数据框，dfa和dfb

IDa <- c(1,2,3)
score1a <- c(5,10,1)
score2a <- c(NA,8,NA)
score3a <- c(NA,NA,13)
score1b <- c(NA,4,9)
score2b <- c(2,3,NA)
score2c <- c(1,5,1)
score3c <- c(6,NA,1)

dfa <- data.frame(IDa,score1a,score2a,score3a,score1b,score2b,score2c,score3c)

IDb <- c(1,1,1,2,2,3)
timeb <- c(1,2,3,2,3,3)

dfb <- data.frame(IDb,timeb)

在得分1a中，＆＃39; 1＆＃39;代表dfb中的timeb = 1和＆＃39; a＆＃39;代表第一种测试类型（因此有3种类型的测试，a，b，c和3个时间点1,2,3）

我想从dfa获取数据并将其添加到dfb以创建类似下面的dfc（注意dfc的前两列与dfb相同）

IDc <- c(1,1,1,2,2,3)
timec <- c(1,2,3,2,3,3)
scorea <- c(5,NA,NA,8,NA,13)
scoreb <- c(NA,2,NA,3,NA,NA)
scorec <- c(NA,1,6,5,NA,1)

dfc <- data.frame(IDc, timec, scorea, scoreb, scorec)

希望这是有道理的，非常感谢您对此的任何帮助！

Answer 1

这是使用dplyr和tidyr的选项：

require(dplyr)
require(tidyr)

gather(dfa, xx, timea, -IDa) %>%
  mutate(xx = as.character(xx),
         x = gsub("[0-9]", "", xx)) %>%
  spread(x, timea) %>%
  mutate(xx = as.numeric(gsub("[a-zA-Z]", "", xx))) %>%
  group_by(IDa, xx) %>%
  summarise_each(funs(first(.[!is.na(.)]))) %>%
  left_join(dfb, ., by = c("IDb" = "IDa", "timeb" = "xx"))

#  IDb timeb scorea scoreb scorec
#1   1     1      5     NA     NA
#2   1     2     NA      2      1
#3   1     3     NA     NA      6
#4   2     2      8      3      5
#5   2     3     NA     NA     NA
#6   3     3     13     NA      1

进行以下步骤（每行代码）：

收集：从宽到长格式重新整形（收集）数据，新列将被命名为＆＃34; xx＆＃34;和＆＃34; timea＆＃34;
变异：转动列＆＃34; xx＆＃34;到字符列（以前是一个因素）
仍然变异：创建一个新专栏＆＃34; x＆＃34;基于列＆＃34; xx＆＃34;但是xx中的所有数字都被删除了
传播：根据新的＆＃34; x＆＃34;重新整理数据从长到宽。柱
变异：删除＆＃34; xx＆＃34;中的所有字符并将其余的（字母格式的数字）存储为数字数字
group_by：将数据分组为＆＃34; IDa＆＃34;和＆＃34; xx＆＃34;
summarise_each：在每个组内（通过IDa和xx），对于除分组变量IDa和xx之外的每个列：取不 NA的第一个元素。更明确地说：.[!is.na(.)]从数据中删除所有NA条目，然后围绕它的first()函数，在没有NA的情况下获取数据的第一个元素。通常，summarise和summarise_each会将每个组的数据分解为1行（在这种情况下，它将保存第一个非NA条目）。
left_join：通过ID列和timeb和xx分别执行dfb与先前计算数据的左连接（请注意left_join中的顺序，这在此很重要）。

编辑2

以下是一些示例，可以更好地了解first(.[!is.na(.)])部分的作用。请记住，在代码中，.表示传递给函数的分组数据（相当于下面示例中我称之为x的内容）。

set.seed(99)
x <- sample(10)  #create a vector with random numbers
x
#[1]  6  2 10  7  4  5  3  1  8  9

x[sample(10, 4, replace = F)] <- NA  # add some NAs
x
#[1]  6 NA 10  7 NA NA  3  1 NA  9 

is.na(x)  # is the value in each in index/place of x equal to NA?
#[1] FALSE  TRUE FALSE FALSE  TRUE  TRUE FALSE FALSE  TRUE FALSE

x[is.na(x)]   # show me the values of x which are NA (of course, they are NA)
#[1] NA NA NA NA

x[!is.na(x)]  # show me the values of x which are not NA (== remove NAs)
#[1]  6 10  7  3  1  9

dplyr::first(x[!is.na(x)])  # of all the values in x which are not NA, return the first one
#[1] 6

x[!is.na(x)][1]  # this is equivalent to the previous line but using [1] instead of first()
#[1] 6

head(x[!is.na(x)], 1)  # this is also equivalent of the two previous lines but using head(..., 1)
#[1] 6

希望有所帮助。

Answer 2

这是使用我的“splitstackshape”包中的merged.stack以及merge的替代方法。

通常，R中的与形状相关的函数似乎喜欢名称为“type”+“time”的形式（您的变量目前采用“time”+“type”的形式）。我们可以使用“data.table”中的setnames轻松地将列重命名为所需的表单（与“splitstackshape”一起加载）。

library(splitstackshape)
setnames(dfa, gsub("(score)(\\d)([a-z])", "\\3_\\2", names(dfa)))

一旦名称正确，我们堆叠相关列并将结果与第二个数据集合并。需要转换为数字才能使合并发生在相同类型的数据上。

setkey(
  merged.stack(dfa, var.stubs = c("^a", "^b", "^c"), 
               sep = "_")[, .time_1 := as.numeric(.time_1)],
  IDa, .time_1)[setkeyv(as.data.table(dfb), names(dfb))]
#    IDa .time_1 ^a ^b ^c
# 1:   1       1  5 NA NA
# 2:   1       2 NA  2  1
# 3:   1       3 NA NA  6
# 4:   2       2  8  3  5
# 5:   2       3 NA NA NA
# 6:   3       3 13 NA  1

Answer 3

与@beginneR上面的答案类似，但避免使用grouping / summarise_each：

library(tidyr)
library(dplyr)

colnames(dfa)[-1] <- c("scorea1","scorea2","scorea3","scoreb1","scoreb2","scorec2","scorec3") 

dfa %>%
  gather(name, score, scorea1:scorec3) %>%
  separate(variable, c("score","time"), 6) %>%
  mutate(time = as.numeric(time)) %>%
  spread(score, value) %>%
  left_join(dfb, ., by= c("IDb"="IDa", "timeb"="time"))

将数据从一个数据帧匹配到另一个数据帧

3 个答案: