knitr::opts_chunk$set(echo = F,message = F)

本实验的主要任务是:

根据7月4日的实验,建立通用化分析模板,并进一步分析,为月报分析提供材料。

环境准备

options(stringsAsFactors = F)
rm(list = ls())
source("D:\\R\\packages\\Mreport\\scripts\\caculate.R", encoding = "utf-8")
source("D:\\R\\packages\\Mreport\\scripts\\select.R", encoding = "utf-8")
library(Mreport)
library(plyr)
library(ggplot2)
library(reshape2)
library(knitr)
load_base()
load_sample_base()

数据准备

2018年6月

jdnew <- read.csv("D:\\data\\sx_raw\\交调数据\\jd2018_06.csv")
dim(jdnew)
jdnew <- caculate_equivalent(jdnew)
jdnew <- select_atts(jdnew)
jdnew <- handle_mergeline(jdnew,station_line)
jdnew <- handle_mergesample(jdnew,sample_base)
jdnew <- merge(jdnew,roadlevel,by="index",all.x = T)
dim(jdnew)
jdnews <- subset(jdnew,index %in% station_use)
dim(jdnews)

2018年5月

jdlast <- read.csv("D:\\data\\sx_raw\\交调数据\\jd2018_05.csv")
dim(jdlast)
jdlast <- caculate_equivalent(jdlast)
jdlast <- select_atts(jdlast)
jdlast <- handle_mergeline(jdlast,station_line)
jdlast <- handle_mergesample(jdlast,sample_base)
jdlast <- merge(jdlast,roadlevel,by="index",all.x = T)
dim(jdlast)
jdlasts <- subset(jdlast,index %in% station_use)
dim(jdlasts)

2017年6月

jdprevious <- read.csv("D:\\data\\sx_raw\\交调数据\\jd2017_06.csv")
dim(jdprevious)
jdprevious <- caculate_equivalent(jdprevious)
jdprevious <- select_atts(jdprevious)
jdprevious <- handle_mergeline(jdprevious,station_line)
jdprevious <- handle_mergesample(jdprevious,sample_base)
jdprevious <- merge(jdprevious,roadlevel,by="index",all.x = T)
dim(jdprevious)
jdpreviouss <- subset(jdprevious,index %in% station_use)
dim(jdpreviouss)

1. 基础数据解释

所使用交调站原则:

  1. 本月有数据(并在交调系统中可下载)的站点;
  2. 连续式站点;
  3. 道路等级为国家级高速路、省级高速路,普通国道,普通省道

所使用的各省分等级交调站数目如下:

table(jdnews$province,jdnews$level) %>% kable()

2. 总体运行态势分析

2.1 机动车当量

本月

(totalnewcars <- ddply(jdnews,"level",summarise,Wmean = weighted.mean(cars,w=mileage))) %>% 
  kable()

同比

totalpreviouscars <- ddply(jdpreviouss,"level",summarise,Wmean = weighted.mean(cars,w=mileage))
caculate_increaseratio(totalnewcars,totalpreviouscars) %>% kable()

环比

totallastcars <- ddply(jdlasts,"level",summarise,Wmean = weighted.mean(cars,w=mileage))
caculate_increaseratio(totalnewcars,totallastcars) %>% kable()

2.2 分等级客车当量

本月

(totalnewpasscars <- ddply(jdnews,"level",summarise,Wmean = weighted.mean(passenger_cars,w=mileage))) %>% kable()

同比

totalpreviouspasscars <- ddply(jdpreviouss,"level",summarise,Wmean = weighted.mean(passenger_cars,w=mileage))
caculate_increaseratio(totalnewpasscars,totalpreviouspasscars) %>% kable()

环比

totallastpasscars <- ddply(jdlasts,"level",summarise,Wmean = weighted.mean(passenger_cars,w=mileage))
caculate_increaseratio(totalnewpasscars,totallastpasscars) %>% kable()

2.3 分等级货车当量

本月

(totalnewfrecars <- ddply(jdnews,"level",summarise,Wmean = weighted.mean(freight_cars,w=mileage))) %>% kable()

同比

totalpreviousfrecars <- ddply(jdpreviouss,"level",summarise,Wmean = weighted.mean(freight_cars,w=mileage))
caculate_increaseratio(totalnewfrecars,totalpreviousfrecars) %>% kable()

环比

totallastfrecars <- ddply(jdlasts,"level",summarise,Wmean = weighted.mean(freight_cars,w=mileage))
caculate_increaseratio(totalnewfrecars,totallastfrecars) %>% kable()

3. 分省分析

3.1 分省总体

本月总体

caculate_carsmean(jdnews,"province") %>% kable()
caculate_carsmean(jdnews,"province") %>% gg_boxplot(xangle = 90,xlabname = "省级行政区",
                                                    ylabname="月平均日机动车交通量")
ggsave(filename = "D:\\交大云同步\\实习\\06_月度分析报告\\6月分析\\绘图\\省级机动车.jpg",dpi=600)

同比总体

caculate_increaseratio(caculate_carsmean(jdnews,"province"),
                       caculate_carsmean(jdpreviouss,"province")) %>% kable()

环比总体

caculate_increaseratio(caculate_carsmean(jdnews,"province"),
                       caculate_carsmean(jdlasts,"province")) %>% kable()

3.2 分等级机动车

本月分等级

provincenewcars <- caculate_level_carsmean(jdnews,"province")
kable(provincenewcars)
caculate_carsmean(jdnews,"province") %>% 
geojsonMap(mapName = "China")

同比分等级

provincepreviouscars <- caculate_level_carsmean(jdpreviouss,"province")
caculate_increaseratio(provincenewcars,provincepreviouscars) %>% kable()

环比分等级

provincelastcars <- caculate_level_carsmean(jdlasts,"province")
caculate_increaseratio(provincenewcars,provincelastcars) %>% kable()

3.3 各省客运车辆

本月

(provincepassnew <- caculate_passcarsmean(jdnews,"province")) %>% kable()

同比

provincepassprevious <- caculate_passcarsmean(jdpreviouss,"province")
caculate_increaseratio(provincepassnew,provincepassprevious) %>% kable()

环比

provincepasslast <- caculate_passcarsmean(jdlasts,"province")
caculate_increaseratio(provincepassnew,provincepasslast) %>% kable()

3.4 各省货运车辆

本月

(provincefrenew <- caculate_frecarsmean(jdnews,"province")) %>% kable()

同比

provincefreprevious <- caculate_frecarsmean(jdpreviouss,"province")
caculate_increaseratio(provincefrenew,provincefreprevious) %>% kable()

环比

provincefrelast <- caculate_frecarsmean(jdlasts,"province")
caculate_increaseratio(provincefrenew,provincefrelast) %>% kable()

4. 城市群分析

站点在各个城市群的分布如下:

t <- merge(station_plot,sample_base$citygroup2,by.x = "popup",by.y = "index",all.y = T)
names(t)[5] <- "type"
geo_pointplot(t,na.rm=T,type = T)

4.1 总体

x <- caculate_carsmean(jdnews,"citygroup2")
x1 <- caculate_increaseratio(caculate_carsmean(jdnews,"citygroup2"),
                       caculate_carsmean(jdpreviouss,"citygroup2"))
x2 <- caculate_increaseratio(caculate_carsmean(jdnews,"citygroup2"),
                       caculate_carsmean(jdlasts,"citygroup2"))
merge_outcome(x,x1,x2,bywhat = "citygroup2") %>% kable()

4.2 客车

x <- caculate_passcarsmean(jdnews,"citygroup2")
x1 <- caculate_increaseratio(caculate_passcarsmean(jdnews,"citygroup2"),
                       caculate_passcarsmean(jdpreviouss,"citygroup2"))
x2 <- caculate_increaseratio(caculate_passcarsmean(jdnews,"citygroup2"),
                       caculate_passcarsmean(jdlasts,"citygroup2"))
merge_outcome(x,x1,x2,bywhat = "citygroup2")

4.3 货车

x <- caculate_frecarsmean(jdnews,"citygroup2")
x1 <- caculate_increaseratio(caculate_frecarsmean(jdnews,"citygroup2"),
                       caculate_frecarsmean(jdpreviouss,"citygroup2"))
x2 <- caculate_increaseratio(caculate_frecarsmean(jdnews,"citygroup2"),
                       caculate_frecarsmean(jdlasts,"citygroup2"))
merge_outcome(x,x1,x2,bywhat = "citygroup2")

5. 通道分析

5.1 十横通道

十横通道分布如下:

t <- merge(station_plot,sample_base$horizon10,by.x = "popup",by.y = "index",all.y = T)
names(t)[5] <- "type"
geo_pointplot(t,na.rm=T,type = T)
horizonnew <- caculate_carsmean(jd = jdnews,attsname = "horizon10")
gg_boxplot(horizonnew,xangle = 15,xlabname = "十横通道",ylabname = "平均机动车当量")
horizonprevious <- caculate_carsmean(jd = jdpreviouss,attsname = "horizon10")
x1 <- caculate_increaseratio(horizonnew,horizonprevious)
horizonlast <- caculate_carsmean(jd = jdlasts,attsname = "horizon10")
x2 <- caculate_increaseratio(horizonlast,horizonprevious)
merge_outcome(horizonnew,x1,x2,bywhat = "horizon10") %>% kable()

5.2 十横重点通道

5.2.1 沪昆通道

x <- subset(jdnews,horizon10 == "上海-瑞丽")
x <- ddply(x,c("horizon10","province"),
                     summarise,Wmean = weighted.mean(cars,w=mileage))
x <- na.omit(x)
x %>% kable()

5.2.2 路桥通道

x <- subset(jdnews,horizon10 == "连云港-霍尔果斯")
x <- ddply(x,c("horizon10","province"),
                     summarise,Wmean = weighted.mean(cars,w=mileage))
x <- na.omit(x)
x %>% kable()

5.2.3 沿江通道

x <- subset(jdnews,horizon10 == "上海-樟木")
x <- ddply(x,c("horizon10","province"),
                     summarise,Wmean = weighted.mean(cars,w=mileage))
x <- na.omit(x)
x %>% kable()

5.3 十纵通道

十纵通道分布如下:

t <- merge(station_plot,sample_base$vertical10,by.x = "popup",by.y = "index",all.y = T)
names(t)[5] <- "type"
geo_pointplot(t,na.rm=T,type = T)
verticalnew <- caculate_carsmean(jd = jdnews,attsname = "vertical10")
gg_boxplot(verticalnew,xangle = 15,xlabname = "十横通道",ylabname = "平均机动车当量")
verticalprevious <- caculate_carsmean(jd = jdpreviouss,attsname = "vertical10")
x1 <- caculate_increaseratio(verticalnew,verticalprevious)
verticallast <- caculate_carsmean(jd = jdlasts,attsname = "vertical10")
x2 <- caculate_increaseratio(verticallast,verticalprevious)
merge_outcome(verticalnew,x1,x2,bywhat = "vertical10") %>% kable()

5.4 十纵重点通道

5.4.1 京沪通道

x <- subset(jdnews,vertical10 == "北京-上海")
x <- ddply(x,c("vertical10","province"),
                     summarise,Wmean = weighted.mean(cars,w=mileage))
x <- na.omit(x)
x %>% kable()

5.4.2 沿海通道

x <- subset(jdnews,vertical10 == "同江-三亚")
x <- ddply(x,c("vertical10","province"),
                     summarise,Wmean = weighted.mean(cars,w=mileage))
x <- na.omit(x)
x %>% kable()

5.4.3 黑河至港澳台通道

x <- subset(jdnews,vertical10 == "黑河-港澳台")
x <- ddply(x,c("vertical10","province"),
                     summarise,Wmean = weighted.mean(cars,w=mileage))
x <- na.omit(x)
x %>% kable()

6. 疏港公路分析

(portroadnew <- caculate_carsmean(jdnews,attsname = "portroad")) %>% kable()
gg_boxplot(portroadnew,xangle = 20,xlabname = "疏港公路",ylabname = "平均机动车当量")
portroadprevious <- caculate_carsmean(jdprevious,attsname = "portroad")
x1 <- caculate_increaseratio(portroadnew,portroadprevious)
portroadlast <- caculate_carsmean(jdlasts,attsname = "portroad")
x2 <- caculate_increaseratio(portroadnew,portroadlast)
merge_outcome(portroadnew,x1,x2,bywhat = "portroad") %>% kable()


ahorawzy/Mreport documentation built on May 3, 2019, 3:40 p.m.