【问题标题】：R loop - read and aggregate from matrix - output to new matrix by two unique variablesR循环 - 从矩阵读取和聚合 - 通过两个唯一变量输出到新矩阵
【发布时间】：2015-07-07 20:13:26
【问题描述】：

我有一个关于 R 的编程问题，我一直在寻找解决方案，但似乎无法在网上找到。我正在使用一个数据集，该数据集随着时间的推移跟踪医院提供者的位置。因此，有一个唯一的 ID 来识别员工以及与相关位置相关的各种时间戳。我有一个距离矩阵，它描述了某些位置（A 到 E）彼此之间的距离，并且我有兴趣在整个数据集中聚合它（计算总步行距离）。

我的距离矩阵是一个 5x5 矩阵，描述从 Section X 到 Section Y 的移动，其中 X 和 Y 属于 Section A 到 E 的子集。下面描述距离矩阵：

dmatrix=matrix(c(1, 2, 2, 3, 4, 2, 1, 2, 3, 4, 2, 2, 1, 2, 3, 3, 3, 2, 1, 2, 4, 4, 3, 2, 1), nrow=5, ncol=5)
colnames(dmatrix)<-c("sectionA", "sectionB", "sectionC", "sectionD", "sectionE")
rownames(dmatrix)<-c("sectionA", "sectionB", "sectionC", "sectionD", "sectionE")

我的数据框是一个 500 万行的数据集，其中包含所有员工所在的位置。目标是计算每个员工 ID 在任何一天步行的总距离（通过从上面的距离矩阵中读取）。

我可以通过使用以下代码按日期和 ID 对数据进行子设置来成功地做到这一点：

jun10<-subset(dataframe,format(dataframe$st,'%m/%d')=='06/10')

jun1013<-jun10[jun10$id==13,]
jun1013[with(jun1013, order(st)),]
for(i in 1:nrow(jun1013))
{
jun1013$distance[i]=dmatrix[cbind(as.character(jun1013$section[i-1]),as.character(jun1013$section[i]))]
}
sum(jun1013$distance, na.rm=TRUE)

注意：“dataframe”是数据帧名称，dataframe$st 是 POSIXlt 时间戳数据，在这种情况下，我将提取 6 月 10 日的所有条目，然后提取 6 月 10 日 ID 号 13 的所有条目。这段代码给出我是 13 号员工在 6 月 10 日步行的总距离。

这是显示头部（数据帧）的输出：

   id                   room              start               stop duration               roomname       starttimelocal         endtimelocal durationseconds source resident attending1 attending2      unit     X_merge
1 104 ED-BCKNST (STAFF ROOM) 28feb2013 13:42:45 28feb2013 13:42:47        2 ED-BCKNST (STAFF ROOM) 2/28/2013 1:42:45 PM 2/28/2013 1:42:47 PM        00:00:02          1        0          0          0 EMERGENCY matched (3)
2 104 ED-BCKNST (STAFF ROOM) 28feb2013 13:37:46 28feb2013 13:37:51        5 ED-BCKNST (STAFF ROOM) 2/28/2013 1:37:46 PM 2/28/2013 1:37:51 PM        00:00:05      1        0          0          0 EMERGENCY matched (3)
3 104  ED-PELEV (STAFF ROOM) 14may2013 09:08:31 14may2013 09:08:35        4  ED-PELEV (STAFF ROOM) 5/14/2013 9:08:31 AM 5/14/2013 9:08:35 AM        00:00:04      2        0          0          0 EMERGENCY matched (3)
4 104 ED-BCKNST (STAFF ROOM) 28feb2013 09:34:34 28feb2013 09:34:38        4 ED-BCKNST (STAFF ROOM) 2/28/2013 9:34:34 AM 2/28/2013 9:34:38 AM        00:00:04      1        0          0          0 EMERGENCY matched (3)
5 104 ED-BCKNST (STAFF ROOM) 28feb2013 09:27:02 28feb2013 09:27:09        7 ED-BCKNST (STAFF ROOM) 2/28/2013 9:27:02 AM 2/28/2013 9:27:09 AM        00:00:07      1        0          0          0 EMERGENCY matched (3)
6 104 ED-BCKNST (STAFF ROOM) 26feb2013 19:07:56 26feb2013 19:08:01        5 ED-BCKNST (STAFF ROOM) 2/26/2013 7:07:56 PM 2/26/2013 7:08:01 PM        00:00:05      1        0          0          0 EMERGENCY matched (3)
                  st   categ  section   day
1 2013-02-28 01:42:45 staffrm sectionE 02/28
2 2013-02-28 01:37:46 staffrm sectionE 02/28
3 2013-05-14 09:08:31 staffrm sectionE 05/14
4 2013-02-28 09:34:34 staffrm sectionE 02/28
5 2013-02-28 09:27:02 staffrm sectionE 02/28
6 2013-02-26 07:07:56 staffrm sectionE 02/26

如何对所有数据执行此操作？我尝试创建 if 循环以按日期和 ID 执行此操作，但我不断在字段中收到错误或 NA。

完美的解决方案是通过数据，计算步行的总距离，类似于我上面所做的，然后输出到一个矩阵，其中每一列描述一个独特的日子（如 6 月 10 日、11 日、12 日等.) 并且行是在给定日期工作的唯一 ID。矩阵中的条目将是描述总步行距离的总和。请注意，每天工作的员工人数不同。

不确定这是否可能，我已经坚持了一个多星期了 - 任何帮助、见解或建议都会非常有帮助 - 谢谢！！

【问题讨论】：

您能发布至少一部分数据集吗？看不见就很难帮忙。
@Chris 非常感谢！我希望这会有所帮助。

标签： r loops matrix

【解决方案1】：

输入

为了解决这个问题，我综合了自己的数据。我用NS作为员工人数，ND作为考试期间的总天数，NSD作为每名员工在考试期间的工作天数，假设是统一的（但这不是我的解决方案所必需的）。因此，您可以使用这些数字来合成不同的输入，但在这个演示中，我使用了 3 名员工，5 天的时间段，每个员工在整个 5 天的时间段内工作了 3 天。

library('data.table');

## synthesize data
set.seed(1);
sec <- c('sectionA','sectionB','sectionC','sectionD','sectionE');
dmatrix <- matrix(c(0,2,2,3,4,2,0,2,3,4,2,2,0,2,3,3,3,2,0,2,4,4,3,2,0),5,dimnames=list(sec,sec));
NS <- 3; ND <- 5; NSD <- 3; loc <- data.table(id=rep(1:NS,each=NSD*8*60),st=as.POSIXlt('2015-06-10 09:00:00')+rep(replicate(NS,sort(sample(0:(ND-1),NSD))*86400),each=8*60)+seq(0,by=1,len=8*60)*60,section=do.call(c,replicate(NS*NSD,{ m <- 8L*60L; ls <- integer(); while (m > 0L) { ls[length(ls)+1L] <- as.integer(min(m,runif(1,10,100))); m <- m-ls[length(ls)]; }; rep(sample(sec,length(ls),replace=T),ls); },simplify=F)));
setkey(loc,id,st);
loc;
##       id                  st  section
##    1:  1 2015-06-11 09:00:00 sectionB
##    2:  1 2015-06-11 09:01:00 sectionB
##    3:  1 2015-06-11 09:02:00 sectionB
##    4:  1 2015-06-11 09:03:00 sectionB
##    5:  1 2015-06-11 09:04:00 sectionB
##   ---
## 4316:  3 2015-06-14 16:55:00 sectionE
## 4317:  3 2015-06-14 16:56:00 sectionE
## 4318:  3 2015-06-14 16:57:00 sectionE
## 4319:  3 2015-06-14 16:58:00 sectionE
## 4320:  3 2015-06-14 16:59:00 sectionE

注意事项：

如您所见，我保留了您的dmatrix 查找表。但是，我将同一区域单元格的数字从 1 更改为 0，因为当工作人员留在同一区域时，步行距离应该为零，对吗？如果我遗漏了什么，请纠正我。
我使用了data.table 包，它通常具有明显的（有时甚至是至关重要的）性能优势。
我使用了常规时间序列，但为了使数据更易于管理，我使用了分钟增量而不是秒。
我假设所有工作时间都在上午 9 点到下午 5 点的时间范围内，但这不是我的解决方案所必需的。

解决方案

如果我的理解是正确的，你想总结一下每个工作人员在检查时间段内工作的每一天所走的路段之间的总距离。

首先，我编写了这个小辅助函数，它接受一个部分向量并返回一个距离向量，表示从 previous 部分到 current 部分的距离。这总是返回零作为返回的距离向量的第一个元素，因为输入向量中的第一部分没有前一部分。

## vectorized section distance helper function
getDist <- function(secvec) c(0,dmatrix[cbind(secvec[-1],secvec[-length(secvec)])]);

现在，我们可以使用基于data.table 索引语法的漂亮的小单行来实现要求：

## calculate distance walked for each staff id and each day worked
loc[,.(dist=sum(getDist(rle(section)$values),na.rm=T)),.(id,day=as.Date(st))];
##    id        day dist
## 1:  1 2015-06-11   19
## 2:  1 2015-06-13   15
## 3:  1 2015-06-14   13
## 4:  2 2015-06-10   21
## 5:  2 2015-06-12   18
## 6:  2 2015-06-14   15
## 7:  3 2015-06-11   17
## 8:  3 2015-06-12   17
## 9:  3 2015-06-14   18

这按id 和工作日分组，在分组参数中动态计算为day=as.Date(st)，并计算步行距离的总和。为了得到这些距离，我们实际上并不关心位置表中记录的每一对相邻的部分，因为通常它们是相同的，因此不会代表任何步行距离。因此，我使用基本 R rle() 函数将组的部分向量减少到每个部分的游程长度。 rle() 返回一个分类为'rle' 的列表，其中包含两个组件：lengths 和values，但是我们并不关心每个部分花费的时间长度，所以我只是拉出了values，这是我们准备传递给getDist()的截面向量。

这是一个非常快速的解决方案。例如，下面我在 100 天的考试期间生成了 200 名员工和 60 天工作的输入数据，在 location 表中产生了 576 万条记录，并且它在大约一秒内完成：

set.seed(1);
NS <- 200; ND <- 100; NSD <- 60; loc <- data.table(id=rep(1:NS,each=NSD*8*60),st=as.POSIXlt('2015-06-10 09:00:00')+rep(replicate(NS,sort(sample(0:(ND-1),NSD))*86400),each=8*60)+seq(0,by=1,len=8*60)*60,section=do.call(c,replicate(NS*NSD,{ m <- 8L*60L; ls <- integer(); while (m > 0L) { ls[length(ls)+1L] <- as.integer(min(m,runif(1,10,100))); m <- m-ls[length(ls)]; }; rep(sample(sec,length(ls),replace=T),ls); },simplify=F)));
setkey(loc,id,st);
loc;
##           id                  st  section
##       1:   1 2015-06-10 09:00:00 sectionD
##       2:   1 2015-06-10 09:01:00 sectionD
##       3:   1 2015-06-10 09:02:00 sectionD
##       4:   1 2015-06-10 09:03:00 sectionD
##       5:   1 2015-06-10 09:04:00 sectionD
##      ---
## 5759996: 200 2015-09-14 16:55:00 sectionB
## 5759997: 200 2015-09-14 16:56:00 sectionB
## 5759998: 200 2015-09-14 16:57:00 sectionB
## 5759999: 200 2015-09-14 16:58:00 sectionB
## 5760000: 200 2015-09-14 16:59:00 sectionB
loc[,.(dist=sum(getDist(rle(section)$values),na.rm=T)),.(id,day=as.Date(st))];
##         id        day dist
##     1:   1 2015-06-10   16
##     2:   1 2015-06-11   21
##     3:   1 2015-06-13   23
##     4:   1 2015-06-14   19
##     5:   1 2015-06-15   20
##    ---
## 11996: 200 2015-09-09   22
## 11997: 200 2015-09-10   31
## 11998: 200 2015-09-11   21
## 11999: 200 2015-09-13   17
## 12000: 200 2015-09-14   17

重塑

刚刚在您的问题中注意到您说完美的解决方案将独特的日期作为列，将员工 ID 作为行。您可以使用基本 R reshape() 函数来实现此目的。对于下面的演示，我使用原始的简化输入（4320 行），我现在假设其输出已分配给locd：

reshape(locd[order(day)],dir='w',timevar='day')[order(id)];
##    id dist.2015-06-10 dist.2015-06-11 dist.2015-06-12 dist.2015-06-13 dist.2015-06-14
## 1:  1              NA              19              NA              15              13
## 2:  2              21              NA              18              NA              15
## 3:  3              NA              17              17              NA              18

注意，staff id（行）当天没有工作的单元格（列）以NA为距离，这是合理的。

【讨论】：

【解决方案2】：

为此，我创建了一个函数 distanceWalked，它计算除第一行之外的每一行的行进距离。

distanceWalked <- function(data) {
  data$distance[1] <- 0
  if (nrow(data) > 1) {
    for (i in 2:nrow(data)) {
      data$distance[i] <- dmatrix[data$section[i-1],data$section[i]]
    }
  }
  return(data)
}

然后我制作了一个新的数据表，其中包含 day 和 id 的所有唯一组合

unique_combos <- unique(data.table(date = dt$day, id = dt$id))

然后我运行了一个 for 循环，它对数据进行子集化，按 st 列按时间顺序对其进行排序，在其上运行 distanceWalked，然后将其聚合到一个新的数据表中

new_data <- data.table()
for (i in 1:nrow(unique_combos)) {
  dt_sub <- dt[dt$day == unique_combos$date[i] & dt$id == unique_combos$id[i]]
  setorder(dt_sub, st)
  dt_sub <- distanceWalked(dt_sub)
  new_data <- rbind(new_data, dt_sub)
}

然后我使用 dplyr 包通过日期和 id 的每个唯一组合来查找距离总和

library(dplyr)

final_data <- new_data %>% group_by(day, id) %>% summarize(total_distance = sum(distance))

它应该产生类似这样的东西

    day  id total_distance
1 02/28 104              3
2 05/14 104              0
3 02/26 104              0

这可能需要一段时间才能完成 500 万行，但它应该能让你到达你需要去的地方！

【讨论】：