r - 这种从长到宽的 reshape 我做错了什么？

Question

问题

我编写的一个函数用于扩展一长串重复的多元时间序列数据以输入到分类器函数，即使对于简单的测试数据，它似乎也会导致错误的结果，但我找不到问题所在。

背景

我在像这样的长 data.table 格式中保留了一堆多元时间序列的重复试验，以提高大多数 R 习语的速度和易用性:

> this.data
              Time Trial Class Channel      Value
     1: -100.00000     1    -1      V1  0.4551513
     2:  -96.07843     2    -1      V1  0.8241555
     3:  -92.15686     3    -1      V1  0.7667328
     4:  -88.23529     4    -1      V1  0.7475106
     5:  -84.31373     5    -1      V1  0.9810273
    ---                                          
204796:  884.31373   196     1      V4 50.2642220
204797:  888.23529   197     1      V4 50.5747661
204798:  892.15686   198     1      V4 50.5749421
204799:  896.07843   199     1      V4 50.1988299
204800:  900.00000   200     1      V4 50.7756015

具体来说，上面的数据有一个 Time 列，它有 256 个从 0 到 900 的唯一数字，对于每个 Channel ，对于每个 Trial 重复。类似地，每个 Channel 都是 V1,V2,V3,V4 之一，对于每个 Time 样本，每个 Trial 重复。换句话说， Time,Trial,Channel 的任何组合唯一指定一个 Value 。为了简单起见，100以下的 Trial都是 Class -1，99以上的都是 Class 1。(为了测试， Value 1中的所有 Class的均值为50，而 Class 0中的均值为50 0。(可以使用 a gist I made 中包含的 dummy.plug() 函数生成和调整此数据。)

为了使用不同的机器学习分类算法处理数据，似乎有必要将数据重塑为更宽一些的数据，以便每个时间序列都有自己的列，而其他的保留为 id。 (例如， stepclass 中的逐步分类器 klaR 需要不同列中的特征，因此它可以在训练时选择将哪些特征删除或添加到其模型中。)由于反复试验，我没有成功制作现有函数，例如 cast 家族的工作，所以我写了我自己的:

##### converting from long table form to channel-split wide form #####
# for multivariate repeated time series
channel.form <- function(input.table,
                         value.col = "Voltage",
                         split.col = "Channel",
                         class.col = "Class",
                         time.col = "Time",
                         trial.col = "Trial") {
# Converts long table format to slightly wider format split by channels.
# For epoched datasets.

  setkeyv(input.table, class.col)

  chan.split <- split(input.table,input.table[,get(split.col)])

  chan.d <- cbind(lapply(chan.split, function(x){
    x[,value.col,with=FALSE]}))

  chan.d <- as.data.table(matrix(unlist(chan.d),
                            ncol = input.table[,length(unique(get(split.col)))], 
                            byrow=TRUE))

  # reintroduce class labels
  # since the split is over identical sections for each channel, we can just use
  # the first split's labels
  chan.d <- chan.d[,c(class.col):= chan.split[[1]][,get(class.col)]]
  chan.d[,c(class.col):=as.factor(get(class.col))]

  # similarly with time and trial labels
  chan.d <- chan.d[,Time:= chan.split[[1]][,get(time.col)]]
  chan.d <- chan.d[,Trial:= chan.split[[1]][,get(trial.col)]]

  return(chan.d) 
}

使用这个函数，我将一些我准备好的多变量试验变成了一个长 data.table，就像顶部的那个一样，并将它们重新塑造成一个更宽的，看起来像这样:

> this.data.training.channel
              V1        V2        V3        V4 Class       Time Trial
    1: -50.58389 -50.56397 -50.74251 -50.86700    -1 -100.00000     1
    2: -50.92713 -50.28009 -50.15078 -50.70161    -1  -96.07843     2
    3: -50.84276 -50.02456 -50.20015 -50.45228    -1  -76.47059     7
    4: -50.68679 -50.05475 -50.04270 -50.83900    -1  -72.54902     8
    5: -50.55954 -50.88998 -50.01273 -50.86856    -1  -68.62745     9
   ---                                                               
35836:  49.52361  49.37465  49.73997  49.10543     1  876.47059   194
35837:  49.93162  49.38352  49.62406  49.16854     1  888.23529   197
35838:  49.67510  49.63853  49.54259  49.81198     1  892.15686   198
35839:  49.26295  49.98449  49.60437  49.03918     1  896.07843   199
35840:  49.05030  49.42035  49.48546  49.73438     1  900.00000   200

在这一点上，我把加宽的表交给一个像 lda() 这样的分类器，然后在相同数据的一个单独的随机部分上测试它:

lda.model <- lda(Class ~ . -Trial, this.data.training.channel)
lda.pred <- predict(lda.model, this.data.testing.channel)

症状

但是，即使我生成了粗俗分离的虚拟数据(见下图)，我也几乎可以使用现有的合理库获得结果。 (我知道库可能没有错，因为如果我允许算法使用试验索引作为训练特征，它会正确地对每个输入进行分类。)

> table(predicted = lda.pred$class, data = this.data.testing.channel[,Class])
         data
predicted   -1    1
       -1 2119 1878
       1  5817 5546

> 1-sum(lda.pred$class != this.data.testing.channel[,Class])/length(lda.pred$class)
[1] 0.4984375

> table(predicted = sda.pred$class, data = this.data.testing.channel[,Class])
         data
predicted   -1    1
       -1 3705 3969
       1  3719 3967

> 1-sum(sda.pred$class != this.data.testing.channel[,Class])/length(sda.pred$class)
[1] 0.4994792

尽管来自 1 类的值大约是来自 -1 类的值的 50 倍，但错误率基本上是抛硬币。我必须犯一些巨大的错误(我认为这是一个编程错误，否则我会在交叉验证上结束)，但我花了几天的时间来刺激它并重写代码而没有任何改进。 (例如，请注意，无论我是否缩放输入值以使它们的均值为 0，方差为 1，我都会得到相同的结果。)

重现问题

可以运行以重现问题的完整要点是 here 。

我考虑过的可能问题，我尝试了什么

(由于篇幅考虑，请参阅问题的先前修订以获取完整列表)

我编写了一个函数(包含在 gist 中)来生成易于分离的虚拟数据，并编写了另一个函数来平均两个类中的每一个，由 Channel 分面并由 Class 着色，如上图。使用每个参数(人口平均值的差异、 channel 数等)似乎会产生预期的输出，以及使用 this.data[Trial==1,unique(Time),by=Subject] 之类的调用查看适当的子集。

我需要什么来解决这个问题？

我将不胜感激有关解决此问题的任何建议。我只是看不出我做错了什么。

如果有人诊断/定位了问题，或者能够使用不同的方法说明，从与这些(流行的)分类器函数一起使用的数据中重新塑造的表格，我不会只是接受，我会奖励赏金(之后测试，当然)。

session 信息

R version 3.0.2 (2013-09-25)
Platform: x86_64-pc-linux-gnu (64-bit)

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_US.UTF-8       
 [4] LC_COLLATE=en_US.UTF-8     LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
 [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                  LC_ADDRESS=C              
[10] LC_TELEPHONE=C             LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] parallel  grid      stats     graphics  grDevices utils     datasets  methods  
[9] base     

other attached packages:
 [1] doMC_1.3.2              iterators_1.0.6         AUC_0.3.0              
 [4] LiblineaR_1.80-7        RcppRoll_0.1.0          RcppArmadillo_0.4.300.0
 [7] Rcpp_0.11.1             foreach_1.4.1           cvTools_0.3.2          
[10] robustbase_0.90-2       latticist_0.9-44        vcd_1.3-1              
[13] latticeExtra_0.6-26     lattice_0.20-29         pheatmap_0.7.7         
[16] RColorBrewer_1.0-5      klaR_0.6-10             MASS_7.3-29            
[19] ggplot2_0.9.3.1         reshape2_1.2.2          data.table_1.9.2       
[22] sda_1.3.3               fdrtool_1.2.12          corpcor_1.6.6          
[25] entropy_1.2.0           zoo_1.7-11              testthat_0.8           

loaded via a namespace (and not attached):
 [1] codetools_0.2-8  colorspace_1.2-4 combinat_0.0-8   compiler_3.0.2   DEoptimR_1.0-1  
 [6] dichromat_2.0-0  digest_0.6.4     gtable_0.1.2     gWidgets_0.0-52  labeling_0.2    
[11] munsell_0.4.2    plyr_1.8         proto_0.3-10     scales_0.2.3     stringr_0.6.2   
[16] tools_3.0.2   

Answer 1

我无法重现您的错误，我发现 dummy.plug() 存在一些问题.我生成了数据

library(data.table)
library(reshape2)
library("MASS")

set.seed(115)
pp<-dummy.plug(trial.count = 200,
    chan.count = 4,
    mean.diff = 100,
    value.name = "Value")

而且我不关心 data.table，所以我只是将它转换为基本的 data.frame。

dd<-as.data.frame(pp)

现在你说 Time , Trial , 和 Channel应该唯一标识一个值，但在虚拟数据中似乎并非如此。我看到

subset(dd, Time==-100 & Trial==1 & Channel=="V1")

#       Time Trial Class Channel      Value
# 1     -100     1    -1      V1 0.73642916
# 6401  -100     1    -1      V1 0.17648939
# 12801 -100     1    -1      V1 0.41366964
# 19201 -100     1    -1      V1 0.07044473
# 25601 -100     1    -1      V1 0.86583284
# 32001 -100     1    -1      V1 0.24255411
# 38401 -100     1    -1      V1 0.92473225
# 44801 -100     1    -1      V1 0.69989600

因此，每个组合显然有多个值。所以为了继续，我决定只取观测值的平均值。我在使用 dcast 时没有问题和

xx<-dcast(dd, Class+Time+Trial~Channel, fun.aggregate=mean)

然后我拆分训练/测试数据集

train.trials = sample(unique(dd$Trial), 140)
train.data = subset(xx, Trial %in% train.trials)
test.data = subset(xx, !Trial %in% train.trials)

然后我像上面一样运行 lda

lda.model <- lda(Class ~ . -Trial, train.data)
lda.pred <- predict(lda.model, test.data)

我检查了我是怎么做的

table(lda.pred$class, test.data$Class)
#        -1    1
#   -1  704    0
#   1     0 1216

而且我似乎做得比你好得多。

除非我将 data.table 转换为 data.frame 时发生了不好的事情，否则您的测试数据似乎存在问题。也许您的非强制重塑功能存在问题。怎么看 dcast工作正常，也许您想检查您的功能是否也能正常工作。