按年拆分数据

时间:2011-10-24 08:10:04

标签: r split dataframe

我有这样的数据:

ID    ATTRIBUTE        START          END
 1            A   01-01-2000   15-03-2010
 1            B   05-11-2001   06-02-2002
 2            B   01-02-2002   08-05-2008
 2            B   01-06-2008   01-07-2008

我现在想要计算每年具有特定属性的不同ID的数量。

结果可能如下所示:

YEAR    count(A)    count(B)
2000          1           0
2001          1           1
2002          1           2
2003          1           1
2004          1           1
2005          1           1
2006          1           1
2007          1           1
2008          1           1
2009          1           0
2010          1           0

我计算出现次数的第二步可能很容易。

但是我如何将数据分成多年?

提前谢谢!

5 个答案:

答案 0 :(得分:9)

这是一种使用Hadley的一些软件包的方法。

library(lubridate); library(reshape2); library(plyr)

# extract years from start and end dates after converting them to date
dfr2 = transform(dfr, START = year(dmy(START)), END = year(dmy(END)))

# for every row, construct a sequence of years from start to end
dfr2 = adply(dfr2, 1, transform, YEAR = START:END)

# create pivot table of year vs. attribute with number of unique values of ID
dcast(dfr2, YEAR ~ ATTRIBUTE, function(x) length(unique(x)), value_var = 'ID')

编辑:如果原始data.frame很大,那么adply可能需要花费很多时间。在这种情况下,一个有用的替代方法是使用data.table包。以下是我们如何使用adply替换data.table来电。

require(data.table)
dfr2 = data.table(dfr2)[,list(YEAR = START:END),'ID, ATTRIBUTE']

答案 1 :(得分:6)

这是一个只使用R核心的解决方案。首先,我们展示输入数据,以保持这一点:

DF <- data.frame(ID = c(1, 1, 2, 2), 
    ATTRIBUTE = c("A", "B", "B", "B"), 
    START = c("01-01-2000", "05-11-2001", "01-02-2002", "01-06-2008"), 
    END = c("15-03-2010", "06-02-2002", "08-05-2008", "01-07-2008"))

现在我们得到了输入解决方案:yr被定义为提取年份的函数。计算的内容是遵循yr定义的陈述。对于DF的每一行,匿名函数生成一个数据帧,其年份跨越第1列,ATTRIBUTEID位于第2列和第3列。例如,对应的数据框DF的第一行是11行data.frame(YEAR = 2000:2010, ATTRIBUTE = 1, ID = "A"),与DF的第二行对应的数据框是两行data.frame(YEAR = 2001:2002, ATTRIBUTE = 1, ID = "B")lapply生成这样的数据帧列表,每行DF一个,因此在上面的示例输入中,它生成一个包含4个组件的列表。使用do.call我们rbind该列表的组件,即个人数据帧,产生单个大数据帧。我们从这个大型数据框中删除重复行(使用unique),删除ID列(第三列)并在结果上运行table

yr <- function(d) as.numeric(sub(".*-", "", d))
out <- table(unique(do.call(rbind, lapply(1:nrow(DF), function(r) with(DF[r, ],
    data.frame(YEAR = seq(yr(START), yr(END)), ATTRIBUTE, ID)))))[, -3])

结果表是:

> out
      ATTRIBUTE
YEAR   A B
  2000 1 0
  2001 1 1
  2002 1 2
  2003 1 1
  2004 1 1
  2005 1 1
  2006 1 1
  2007 1 1
  2008 1 1
  2009 1 0
  2010 1 0

编辑:

海报后来表示内存可能有问题,所以这里有一个sqldf解决方案,它处理R之外的sqlite中的关键大型中间结果(dbname = tempfile()告诉它这样做)所以R的任何内存限制不会影响它。它使用相同的输入和上面显示的相同yr函数并返回相同的结果,tab与上面的out相同。如果它确实适合内存,也可以在没有dbname = tempfile()的情况下尝试。

library(sqldf)

DF2 <- transform(DF, START = yr(START), END = yr(END))
years <- data.frame(year = min(DF2$START):max(DF2$END))

tab.df <- sqldf("select year, ATTRIBUTE, count(*) as count from
    (select distinct year, ATTRIBUTE, ID
    from years, DF2
    where year between START and END)
    group by year, ATTRIBUTE", dbname = tempfile())

tab <- xtabs(count ~., tab.df)

答案 2 :(得分:2)

Slighty令人费解,但试试这个:

dfr <- data.frame(ID=c(1,1,2,2),ATTRIBUTE=c("A","B","B","B"),START=c("01-01-2000","05-11-2001","01-02-2002","01-06-2008"),END=c("15-03-2010","06-02-2002","08-05-2008","01-07-2008"),stringsAsFactors=F)
dfr$ATTRIBUTE <- factor(dfr$ATTRIBUTE)

actYears <- mapply(":",as.numeric(substr(dfr$START,7,10)),as.numeric(substr(dfr$END,7,10)))

yrRng <- ":"(range(actYears)[1],range(actYears)[2])

yrTable <- sapply(actYears,function(x) yrRng %in% x)
rownames(yrTable) <- yrRange
colnames(yrTable) <- dfr$ATTRIBUTE

给出了:

yrTable
        A     B     B     B
2000 TRUE FALSE FALSE FALSE
2001 TRUE  TRUE FALSE FALSE
2002 TRUE  TRUE  TRUE FALSE
2003 TRUE FALSE  TRUE FALSE
2004 TRUE FALSE  TRUE FALSE
2005 TRUE FALSE  TRUE FALSE
2006 TRUE FALSE  TRUE FALSE
2007 TRUE FALSE  TRUE FALSE
2008 TRUE FALSE  TRUE  TRUE
2009 TRUE FALSE FALSE FALSE
2010 TRUE FALSE FALSE FALSE

现在我们可以构建表格了:

t(apply(yrTable,1,function(x) table(dfr$ATTRIBUTE[x])))
     A B
2000 1 0
2001 1 1
2002 1 2
2003 1 1
2004 1 1
2005 1 1
2006 1 1
2007 1 1
2008 1 2
2009 1 0
2010 1 0

它仍然会对ID进行重复计算,但在原始data.frame中合并重叠范围可能会更容易。

答案 3 :(得分:2)

我不打算在这里给出答案,因为问题似乎有点棘手,所以我本可以只编写一个丑陋的解决方案,但在阅读了@RomanLuštrik的评论之后,我无法摆脱这一挑战:)

无论如何,我不确定你是否会喜欢这个解决方案,所以要做好准备!

加载您的演示数据:

dfr <- structure(list(ID = c(1, 1, 2, 2), ATTRIBUTE = structure(c(1L, 2L, 2L, 2L), .Label = c("A", "B"), class = "factor"), START = c("01-01-2000", "05-11-2001", "01-02-2002", "01-06-2008"), END = c("15-03-2010", "06-02-2002", "08-05-2008", "01-07-2008")), .Names = c("ID", "ATTRIBUTE", "START", "END"), row.names = c(NA, -4L), class = "data.frame")

我们没有处理几个月左右,只是将年份保持在表中:

> dfr$START <- as.numeric(substr(dfr$START, 7, 10))
> dfr$END <- as.numeric(substr(dfr$END, 7, 10))
> dfr
  ID ATTRIBUTE START  END
1  1         A  2000 2010
2  1         B  2001 2002
3  2         B  2002 2008
4  2         B  2008 2008

清除重复的行(根据IDATTRIBUTE合并年份):

> dfr <- merge(aggregate(START ~ ID + ATTRIBUTE, dfr, min), aggregate(END ~ ID + ATTRIBUTE, dfr, max), by=c('ID', 'ATTRIBUTE'))
> dfr
  ID ATTRIBUTE START  END
1  1         A  2000 2010
2  1         B  2001 2002
3  2         B  2002 2008

与一些applylapplydo.call和朋友分享一行,以展示R的美丽! :)

> t(table(do.call(rbind, lapply(apply(dfr, 1, function(x) cbind(x[2], x[3]:x[4])), function(x) as.data.frame(x)))))
      V1
V2     A B
  2000 1 0
  2001 1 1
  2002 1 2
  2003 1 1
  2004 1 1
  2005 1 1
  2006 1 1
  2007 1 1
  2008 1 1
  2009 1 0
  2010 1 0

答案 4 :(得分:0)

感谢您的所有答案!

所有这些都非常整洁,但是有些驱动我的电脑达到极限,因为我必须处理大量的数据。

我终于看了你所有的解决方案并构建了一个稍微不同的解决方案:

data <- structure(list(ID = c(1, 1, 2, 2), ATTRIBUTE = structure(c(1L, 2L, 2L, 2L), .Label = c("A", "B"), class = "factor"), START = c("2000-01-01", "2001-11-05", "2002-02-01", "2008-06-01"), END = c("2010-03-15", "2002-02-06", "2008-05-08", "2008-07-01")), .Names = c("ID", "ATTRIBUTE", "START", "END"), row.names = c(NA, -4L), class = "data.frame")

data$START <- as.Date(data$START)
data$END <- as.Date(data$END)
data$y0 <- (format(data$START,"%Y"))
data$y1 <- (format(data$END,"%Y"))

attributeTable <- function(dfr) {
  years <- data.frame(row.names(seq(min(dfr$y0), max(dfr$y1))))

  for (i in min(dfr$y0):max(dfr$y1)) {
    years[paste(i), "A"] <- length(unique(dfr$ID[dfr$y0 <= i & dfr$y1 >= i & dfr$ATTRIBUTE == "A"]))
    years[paste(i), "B"] <- length(unique(dfr$ID[dfr$y0 <= i & dfr$y1 >= i & dfr$ATTRIBUTE == "B"]))
  }

  years
}

attributeTable(data)

缺点是,我必须定义属性的每个可能的形状。也许有一种方法可以自动完成,但我还没有找到它。

此解决方案的速度至少是完全可以接受的。