将时间序列中的分类列扩展到每秒多个计数列答案

【问题标题】：Expand Categorical Column in a Time Series to Mulitple Per Second Count Columns将时间序列中的分类列扩展到每秒多个计数列
【发布时间】：2011-07-22 13:28:47
【问题描述】：

进行以下转换的最佳方法是什么？这种转换有两个部分。首先是将速度转换为每秒平均值。第二个是获取分类列并将其转换为多列 - 每个分类值一列，其中值是每秒出现的计数。例如：

输入（xts A）：

Time(PosixCT), Observed Letter, Speed
2011/01/11 12:12:01.100,A,1
2011/01/11 12:12:01.200,A,2
2011/01/11 12:12:01.400,B,3
2011/01/11 12:12:01.800,C,4
2011/01/11 12:12:02.200,D,2
2011/01/11 12:12:02.200,A,7

输出：（xts B）

Time, A_Per_Second, B_Per_Second, C_Per_Second, D_Per_Second, Aggregate_Speed
2011/01/11 12:12:01,2,1,1,0,2.5
2011/01/11 12:12:02,1,0,0,1,4.5

我希望以不需要知道所有类别的方式来执行此操作。基本上，我试图在不丢失任何分类数据并将数值数据总结为每秒平均值的情况下将时间缩短到每秒。

【问题讨论】：

您能否将您的输入数据替换为dput(Input)，以便其他人可以获得我们应该使用的数据的精确副本？
您的输出缺少一列。
@Joshua Ulrich：谢谢，修复了缺失的列。
@chase：安德烈在他的回答中有，下次我会在我的问题中发布。
另外，已经从上一个问题中学到了将时间截断为每秒的问题——只需使用align.time()。但认为最好从原始数据开始，以免在可能有更好方法时跳过步骤。

标签： r time-series

【解决方案1】：

我不经常使用时间序列格式的数据（即xts），所以我提供了一个使用data.frame格式的数据的解决方案。

（另请注意，我已将此数据框的列名更改为单个单词以使其更易于使用。我在此问题的末尾发布了我的数据框的结构。）

我使用了两个包：

HMisc 用于 POSIXt 类的 trunc 方法
plyr 用于拆分、应用和合并数据的魔法

代码：

A <- as.data.frame(A)

library(Hmisc)
A$Date <- trunc(A$Date, units="secs")
A

library(plyr)
ddply(A, .(Date, Observed), summarise, Speed=mean(Speed))

结果的格式与您指定的格式略有不同，但应该很容易将其重新调整为您要求的宽格式。

                 Date Observed Speed
1 2011-01-11 12:12:01        A   1.5
2 2011-01-11 12:12:01        B   3.0
3 2011-01-11 12:12:01        C   4.0
4 2011-01-11 12:12:02        A   7.0
5 2011-01-11 12:12:02        D   2.0

这是A的dput结果：

A <- structure(list(Date = structure(list(sec = c(1, 1, 1, 1, 2, 2
), min = c(12L, 12L, 12L, 12L, 12L, 12L), hour = c(12L, 12L, 
12L, 12L, 12L, 12L), mday = c(11L, 11L, 11L, 11L, 11L, 11L), 
    mon = c(0L, 0L, 0L, 0L, 0L, 0L), year = c(111L, 111L, 111L, 
    111L, 111L, 111L), wday = c(2L, 2L, 2L, 2L, 2L, 2L), yday = c(10L, 
    10L, 10L, 10L, 10L, 10L), isdst = c(0L, 0L, 0L, 0L, 0L, 0L
    )), .Names = c("sec", "min", "hour", "mday", "mon", "year", 
"wday", "yday", "isdst"), class = c("POSIXlt", "POSIXt"), tzone = c("", 
"GMT", "BST")), Observed = structure(c(1L, 1L, 2L, 3L, 4L, 1L
), .Label = c("A", "B", "C", "D"), class = "factor"), Speed = c(1L, 
2L, 3L, 4L, 2L, 7L)), .Names = c("Date", "Observed", "Speed"), row.names = c(NA, 
-6L), class = "data.frame")

【讨论】：

这很有趣——与我所要求的不同，所以我试图绕开它。我想我会将其描述为每秒观察到的速度。但我认为，我真正想要的是观察每秒和每秒速度。原因是在我的例子中，第一秒，As 可能会影响 B 的速度。此外，速度不会是我想要关联的唯一因素。
我认为您正在寻找的是这样的：ddply(A,.(Date),function(x){c(table(x$Observed),mean(x$Speed))})。

【解决方案2】：

这是一个动物园解决方案。首先，我们在第 2 列读入拆分它的数据。然后我们将时间截断为秒并计算计数和总和。最后我们把它们放在一起。

Lines <- "Time(PosixCT), Observed Letter, Speed
2011/01/11 12:12:01.100,A,1
2011/01/11 12:12:01.200,A,2
2011/01/11 12:12:01.400,B,3
2011/01/11 12:12:01.800,C,4
2011/01/11 12:12:02.200,D,2
2011/01/11 12:12:02.200,A,7"

library(zoo)
z <- read.zoo(textConnection(Lines), header = TRUE, sep = ",", split = 2, tz = "")

tt <- as.POSIXct(trunc(time(z), "sec"))
z.knt <- aggregate(z, tt, function(x) sum(!is.na(x)))
z.sum <- aggregate(z, tt, sum, na.rm = TRUE)

cbind(z.knt, Speed = rowSums(z.sum) / rowSums(z.knt))

结果如下：

                    A B C D Speed
2011-01-11 12:12:01 2 1 1 0   2.5
2011-01-11 12:12:02 1 0 0 1   4.5

【讨论】：

【解决方案3】：

这是我用于A 的结构。请注意，“数字”是真正的字符，因为您不能在矩阵中混合类型。

A <- structure(c("A", "A", "B", "C", "D", "A", "1", "2", "3", "4", 
"2", "7"), .Dim = c(6L, 2L), .Dimnames = list(NULL, c("Observed_Letter", 
"Speed")), index = structure(c(1294769521.1, 1294769521.2, 1294769521.4, 
1294769521.8, 1294769522.2, 1294769522.2), tzone = "", tclass = c("POSIXct", 
"POSIXt")), .indexCLASS = c("POSIXct", "POSIXt"), .indexTZ = "",
class = c("xts", "zoo"))

此函数将清理每个类别。

clean <- function(x) {
  # construct xts object with only Speed and convert it to numeric
  out <- xts(as.numeric(x$Speed),index(x))
  # add column names
  colnames(out) <- paste(x$Observed_Letter[1],"_Per_Second",sep="")
  out  # return object
}

这是您需要的内容。请注意需要明确声明split.default，因为有一个split 用于按时间拆分的xts 对象的方法。您也不需要需要align.time，但它会将每个周期四舍五入到整秒。否则，您的索引将是每秒索引中的最后一个实际值。

# split by Observed_Letter, apply clean() to each list element, and merge results
combA <- do.call(merge, lapply(split.default(A, A$Observed_Letter), clean))
alignA <- align.time(combA,1)
# get the last obs for each 1-second period (for period.apply)
EPalignA <- endpoints(combA, "seconds")
# count the number of non-NA observations by column for each 1-second period
counts <- period.apply(alignA, EPalignA, function(x) colSums(!is.na(x)))
# sum the non-NA observations for each column and 1-second period
values <- period.apply(alignA, EPalignA, colSums, na.rm=TRUE)
# calculate aggregate speed
B <- counts
B$Aggregate_Speed <- rowSums(values)/rowSums(counts)

【讨论】：