Question

我有一个大型数据集。以下示例是一个缩写版本。

有两个数据帧，df1和df2。我想映射到df1的每一行，一个派生值，使用来自df2的条件和来自df1的参数。

希望下面的例子更有意义

year <- rep(1996:1997, each=3)
age_group <- rep(c("20-24","25-29","30-34"),2)
df1 <- as.data.frame(cbind(year,age_group))

df1是一个包含年份和年龄组所有排列的数据库。

df2 <- as.data.frame(rbind(c(111,1997,"20-24"),c(222,1997,"30-34")))
names(df2) <- c("id","year","age.group")

df2是一个数据库，其中每一行代表特定年份的个人

我想使用df1中的参数条件来自df2的值，然后映射到df1。论点如下：

each_yr <- map(df1, function(year,age_group) case_when(
as.character(df1$year) == as.character(df2$year) & as.character(df1$age_group)    
== as.character(df2$age.group)~ 0, 
TRUE ~ 1))

我得到的输出错误，如下所示

structure(list(year = c(1, 1, 1, 1, 1, 0), age_group = c(1, 1, 
1, 1, 1, 0)), .Names = c("year", "age_group"))

理想情况下我想要的输出是这样的（数据帧作为示例，但作为列表会很高兴）

structure(list(year = structure(c(1L, 1L, 1L, 2L, 2L, 2L), .Label = c("1996", 
"1997"), class = "factor"), age_group = structure(c(1L, 2L, 3L, 
1L, 2L, 3L), .Label = c("20-24", "25-29", "30-34"), class = "factor"), 
v1 = structure(c(2L, 2L, 2L, 1L, 2L, 2L), .Label = c("0", 
"1"), class = "factor"), v2 = structure(c(2L, 2L, 2L, 2L, 
2L, 1L), .Label = c("0", "1"), class = "factor")), .Names = c("year", 
"age_group", "v1", "v2"), row.names = c(NA, -6L), class = "data.frame")

我之前使用的地图是＆＃39; df1＆＃39;是一个向量，但在这种情况下，它是一个数据框，其中两列都用作参数。 Map可以处理这个吗？

在df3中，列v1是基于df1和df2的条件的结果，然后映射到患者＆＃39; 111＆＃39;的df1。同样，第v2列是患者的结果＆＃39; 222＆＃39;

提前致谢

Answer 1

看起来像为pmap做一些工作。和一点点提提尔来获得建议的结果。

purrr::pmap(list(df2$id,as.character(df2$year),as.character(df2$age.group)),
  function(id,x,y)
   data.frame(df1,
              key=paste0("v",id),
              value=1-as.integer((x==df1$year)&(y==df1$age_group)),
              stringsAsFactors=FALSE
          )) %>%
   replyr::replyr_bind_rows() %>% tidyr::spread(key,value)

#  year age_group v1 v2
#1 1996     20-24  1  1
#2 1996     25-29  1  1
#3 1996     30-34  1  1
#4 1997     20-24  0  1
#5 1997     25-29  1  1
#6 1997     30-34  1  0

Answer 2

tidiverse可以通过以下方式实现：

library(tidyverse)
#library(dplyr)
#library(tidyr)

df2 %>%
  mutate(tmp = 0) %>%
  spread(id, tmp, fill = 1, sep = "_") %>%
  right_join(df1, by = c("year", "age.group" = "age_group")) %>%
  mutate_at(vars(-c(1, 2)), coalesce, 1)

#   year age.group id_111 id_222
# 1 1996     20-24      1      1
# 2 1996     25-29      1      1
# 3 1996     30-34      1      1
# 4 1997     20-24      0      1
# 5 1997     25-29      1      1
# 6 1997     30-34      1      0

#Warning messages:
# 1: Column `year` joining factors with different levels, coercing to character vector 
# 2: Column `age.group`/`age_group` joining factors with different levels, coercing to 
#    character vector

跨数据框映射值

2 个答案: