分而治之的策略(1)——手动版

昨天在工作中遇到了这样一个问题：我希望按年月，按省份，按公路等级计算断面交通量，进而计算总行驶量。

PS：以下交通量计算数据均用随机数代替。

使用我之前写的caculate_frecarsmean函数，可以调用plyr::ddply函数，这里便使用了plyr的思想：分而治之。关于plyr的思想，具体会在之后的《分而治之的策略》系列中详细写。考虑到日期必须是列的形式，公路等级必须是行的形式（因为各省公路里程是行的形式，如下表）。

head(mileage,1)

##   province 国家高速 普通国道 省级高速 普通省道
## 1   北京市      615     1236      398     1593

如果把省份和公路里程都放在行，那么他们会自动融合，不利于后续分析，如下表。

x <- caculate_frecarsmean(jdcitys,c("ym","province","level")) %>% dcast(ym~level+province)
head(x,3)

##          ym 国家高速_湖北省 国家高速_上海市 普通国道_湖北省
## 1 2017-01月         -0.2204          -0.178           0.249
## 2 2017-02月         -0.0972           0.134           0.156
## 3 2017-03月         -0.0413          -1.529          -0.158
##   普通国道_上海市 普通国道_重庆市 普通省道_湖北省 普通省道_上海市
## 1          0.3034         -0.1476           0.239          0.0349
## 2          0.4650         -0.0684           0.256         -0.4193
## 3          0.0806         -0.3006          -0.199         -0.4410
##   普通省道_重庆市 省级高速_湖北省 省级高速_上海市
## 1          -0.113          0.4691         -0.0698
## 2          -0.328         -0.1016         -0.8590
## 3           0.114          0.0452          0.9774

所以只能把省份和年月一样放在列上，如下表。

x <- caculate_frecarsmean(jdcitys,c("ym","province","level")) %>% dcast(ym+province~level)
x <- x[,c(1,2,3,4,6,5)]
head(x,3)

##          ym province 国家高速 普通国道 省级高速 普通省道
## 1 2017-01月   湖北省   -0.220    0.249   0.4691   0.2387
## 2 2017-01月   上海市   -0.178    0.303  -0.0698   0.0349
## 3 2017-01月   重庆市       NA   -0.148       NA  -0.1133

接下来思考：怎样让每个省份的分等级断面交通量乘以自己省份的分等级公路里程。所以必然的选择是：将x分而治之，先分成不同省，各自计算后，再将计算结果合并。

为此我写了个函数如下:

caculate_travel_volume <- function(section_volume,mileage,atts){
  l <- split(section_volume,section_volume[[atts]])
  m <- split(mileage,mileage[[atts]])
  l2 <- lapply(l, `[`, 3:6)
  m2 <- lapply(m, `[`, 2:5)
  k2 <- list(length = length(l2))
  for (i in 1:length(l2)) {
    k2[[i]] <- l2[[i]] * matrix(as.numeric(m2[[names(l2[i])]]),nrow = nrow(l2[[i]]),ncol = 4,byrow=T)
  }
  names(k2) <- names(l2)
  k3 <- lapply(k2, rowSums, na.rm = T)
  for(i in 1:length(k3)){
    names(k3[[i]]) <- l[[1]][[1]]
  }
  return(data.frame(k3))
}

1. 将断面交通量和公路里程两个DataFrame用split函数分割成以每个省份为元素的列表，分割的依据是传入的atts参数（其实就是省份），得到l和m。
2. 使用lapply函数，对l和m取数字的部分（去掉年月列和省份列）。这里的lapply函数其实也是对列表元素的“分而治之”。
3. 使用了个循环，计算每个省的分等级交通量乘里程，得到各省分等级行驶量k2。其实这里按理来说也可以用mapply实现，对l2和m2同时循环，不过要写匿名函数，倒不如循环来的清晰。
4. 使用lapply对每个省份的数据框rowSums，得到各省总行驶量k3。
5. 对k3中每个省份的计算结果命名，名字为年月。
6. 返回将k3合并为数据框的结果，效果如下x2所示。

x2 <- caculate_travel_volume(x,mileage,"province")
head(x2)

##           湖北省 上海市 重庆市
## 2017-01月   6195  -13.2  -1897
## 2017-02月   5432 -418.1  -3545
## 2017-03月  -5181 -671.0   -525
## 2017-04月   6805  349.6  -2397
## 2017-05月   2352  130.5   2364
## 2017-06月    404  545.1    155

后经检验，原来函数中

k2 <- list(length = 3);
k2

## $length
## [1] 3

没有达到分配列表空间的目的;应改为

k2 <- vector(mode = "list",length = 3)
k2

## [[1]]
## NULL
## 
## [[2]]
## NULL
## 
## [[3]]
## NULL