在R中创建一个运行计数变量?

时间:2015-05-11 03:01:27

标签: r time-series running-total

我有一个足球比赛结果的数据集,我希望通过创建一个类似于World Football Elo公式的运行评级来学习R.我遇到麻烦,在Excel中似乎很简单的东西在R中并不完全直观。例如,4270个观察中的前15个带有必要的变量:

       date t.1  t.2 m.result
1  19960406  DC   SJ      0.0
2  19960413 COL   KC      0.0
3  19960413  NE   TB      0.0
4  19960413 CLB   DC      1.0
5  19960413 LAG NYRB      1.0
6  19960414 FCD   SJ      0.5
7  19960418 FCD   KC      1.0
8  19960420  NE NYRB      1.0
9  19960420  DC  LAG      0.0
10 19960420 CLB   TB      0.0
11 19960421 COL  FCD      1.0
12 19960421  SJ   KC      0.5
13 19960427 CLB NYRB      1.0
14 19960427  DC   NE      0.5
15 19960428 FCD   TB      1.0

我希望能够创建一个新变量,该变量将是t.1和t.2的总匹配数的运行计数(即,直到相关日期的实例" DC"出现在第t.1或t.2列中:

           date t.1  t.2 m.result  ##t.1m    ##t.2m
    1  19960406  DC   SJ      0.0       1         1
    2  19960413 COL   KC      0.0       1         1
    3  19960413  NE   TB      0.0       1         1
    4  19960413 CLB   DC      1.0       1         2
    5  19960413 LAG NYRB      1.0       1         1
    6  19960414 FCD   SJ      0.5       1         2
    7  19960418 FCD   KC      1.0       2         2
    8  19960420  NE NYRB      1.0       2         2
    9  19960420  DC  LAG      0.0       3         2
    10 19960420 CLB   TB      0.0       2         2
    11 19960421 COL  FCD      1.0       2         3
    12 19960421  SJ   KC      0.5       3         3
    13 19960427 CLB NYRB      1.0       3         3
    14 19960427  DC   NE      0.5       4         3
    15 19960428 FCD   TB      1.0       4         3

在Excel中,这是一个(相对)简单= SUMPRODUCT等式,例如:

E4=SUMPRODUCT((A:A<=A4)*(B:B=B4))+SUMPRODUCT((A:A<=A4)*(C:C=B4))

其中E4为obs#4的t.1m,A:A为Date,B:B为t.1,C:C为t.2等

但在R中,我可以为我打印完整的副产品(即&#34; DC&#34;在我的数据集中玩了576场比赛),但由于某种原因(可能是我新的,不耐烦的,我试图对观察数据进行运行计数,尤其是如何将运行计数变为变量,这对于任何游戏评级指数都至关重要。我知道&#39; PlayerRatings&#39;存在,我觉得,对于我的R教育,我应该能够在没有那个包的R套房里做到这一点。当然,plyr或dplyr没问题。

供参考,以下是我将数据复制/粘贴到R中的数据。

date<-c(19960406,19960413,19960413,19960413,19960413,19960414,19960418,19960420,19960420,19960420,19960421,19960421,19960427,19960427,19960428)
t.1<-c("DC","COL","NE","CLB","LAG","FCD","FCD","NE","DC","CLB","COL","SJ","CLB","DC","FCD")
t.2<-c("SJ","KC","TB","DC","NYRB","SJ","KC","NYRB","LAG","TB","FCD","KC","NYRB","NE","TB")
m.result<-c(0.0,0.0,0.0,1.0,1.0,0.5,1.0,1.0,0.0,0.0,1.0,0.5,1.0,0.5,1.0)
mtable<-data.frame(date,t.1,t.2,m.result)
mtable

4 个答案:

答案 0 :(得分:5)

在数据创建步骤中,请确保stringsAsFactors = FALSE以避免出现问题。那很容易做到。 (编辑:我将其作为全部dplyr示例)

library(dplyr)

cross_count <- function(id, var) {
  length(which(mtable[id, var] == mtable[1:id, ] %>% select(t.1, t.2) %>% unlist))
}

mtable  %>% 
  arrange(date) %>% # This makes sure the dates are in order
  mutate(id = 1:nrow(.)) %>% 
  rowwise() %>% 
  mutate(t.1m = cross_count(id, 2), t.2m = cross_count(id, 3))




 date t.1  t.2 m.result id t.1m t.2m
1  19960406  DC   SJ      0.0  1    1    1
2  19960413 COL   KC      0.0  2    1    1
3  19960413  NE   TB      0.0  3    1    1
4  19960413 CLB   DC      1.0  4    1    2
5  19960413 LAG NYRB      1.0  5    1    1
6  19960414 FCD   SJ      0.5  6    1    2
7  19960418 FCD   KC      1.0  7    2    2
8  19960420  NE NYRB      1.0  8    2    2
9  19960420  DC  LAG      0.0  9    3    2
10 19960420 CLB   TB      0.0 10    2    2
11 19960421 COL  FCD      1.0 11    2    3
12 19960421  SJ   KC      0.5 12    3    3
13 19960427 CLB NYRB      1.0 13    3    3
14 19960427  DC   NE      0.5 14    4    3
15 19960428 FCD   TB      1.0 15    4    3

答案 1 :(得分:4)

这是一个非常简单的解决方案,虽然不是很好但是可以胜任。

首先,只需更改数据即可轻松进行比较:

mtable = mtable[order(mtable$date), ]

编辑于:

如果您想确保按日期排序匹配,可以使用@ {eipi10指出的as.Date()

t.1

请注意,如果日期的格式是按时间顺序不是整数顺序,您可以先使用t.2将它们转换为日期格式。

我们要做的是,对于每一行,使用列mtable$t.1m <- sapply(1:nrow(mtable), function(i) sum(mtable[1:i, c("t.1", "t.2")] == mtable$t.1[i])) t.1获取数据帧的子集,所有行都从1到所述行。所以1:1,1:2,1:3等。在每次运行中,我们计算团队出现的次数,并将其用作新列的结果。

==

这是针对t.2中的小组完成的,mtable$t.2m <- sapply(1:nrow(mtable), function(i) sum(mtable[1:i, c("t.1", "t.2")] == mtable$t.2[i])) > mtable date t.1 t.2 m.result t.1m t.2m 1 19960406 DC SJ 0.0 1 1 2 19960413 COL KC 0.0 1 1 3 19960413 NE TB 0.0 1 1 4 19960413 CLB DC 1.0 1 2 5 19960413 LAG NYRB 1.0 1 1 6 19960414 FCD SJ 0.5 1 2 7 19960418 FCD KC 1.0 2 2 8 19960420 NE NYRB 1.0 2 2 9 19960420 DC LAG 0.0 3 2 10 19960420 CLB TB 0.0 2 2 11 19960421 COL FCD 1.0 2 3 12 19960421 SJ KC 0.5 3 3 13 19960427 CLB NYRB 1.0 3 3 14 19960427 DC NE 0.5 4 3 15 19960428 FCD TB 1.0 4 3 之后我们可以为{{1}}进行一些小的更改:

{{1}}

现在我们的数据框看起来像这样:

{{1}}

答案 2 :(得分:0)

似乎单独的列t.1m和t.2m用于记账,你真的只对所玩的游戏数量感兴趣?我使用with()来处理mtable的列,而不必每次都写mtable

mtable$games <- with(mtable, {

如果特定球队参加比赛,则表现为球队1或球队2

    played <- t.1 == "DC" | t.2 == "DC"

比较是矢量化的,将列t.1的每个元素与“DC”等进行比较,逻辑比较也被矢量化为单个|

数据的一个棘手部分是几支球队在一天比赛,并且在比赛当天(显然)只有焦点球队应该增加。我通过弄清楚如何订购游戏来适应这一点,以便焦点团队在播放当天总是排在最后阶段

    o <- order(date, played)

然后计算出比赛的累计总和

    games <- cumsum(played[o])

并将游戏重新置于原始状态

    games[order(o)]
})

这是结果

> head(mtable, 11)
       date t.1  t.2 m.result games
1  19960406  DC   SJ      0.0     1
2  19960413 COL   KC      0.0     1
3  19960413  NE   TB      0.0     1
4  19960413 CLB   DC      1.0     2
5  19960413 LAG NYRB      1.0     1
6  19960414 FCD   SJ      0.5     2
7  19960418 FCD   KC      1.0     2
8  19960420  NE NYRB      1.0     2
9  19960420  DC  LAG      0.0     3
10 19960420 CLB   TB      0.0     2
11 19960421 COL  FCD      1.0     3

这是一个实现此功能的功能,可以轻松指定焦点团队

gamesplayed <- function(date, t1, t2, focal="DC") {
    played <- t1 == focal | t2 == focal
    o <- order(date, played)
    cumsum(played[o])[order(o)]
}

答案 3 :(得分:-1)

使用您提到的类似方式完成此操作:

<script src="http://ajax.googleapis.com/ajax/libs/jquery/1.7/jquery.min.js"></script>
 <script type="text/javascript" src="<?php bloginfo('template_directory'); ?>/js/tinynav.js"></script>
<link href="<?php bloginfo('template_directory'); ?>/css/mobile.css" rel="stylesheet" type="text/css" />