In ahorawzy/Mreport: Monthly Report of traffic condition

options(stringsAsFactors = F)
rm(list = ls())
source("D:\\R\\packages\\Mreport\\scripts\\source_toglobal.R", encoding = "utf-8")

library(Mreport)
library(plyr)
library(ggplot2)
library(reshape2)
library(knitr)
library(lubridate)
library(usefulr)

load_base()
load_sample_base()

7.1 台风影响

7.1.1 温比亚台风的时空影响

jdwby <- read.csv("D:\\data\\sx_raw\\交调数据\\8月重点\\jd2018_08_16~21.csv",stringsAsFactors=F)
dim(jdwby)

jdwbys <- handle_gather_forday(jdwby)
dim(jdwbys)

names(jdwbys)

table(jdwbys$day)

x <- caculate_carsmean(jdwbys,c("province","day"))
x <- x[x$province %in% c("江苏省","天津市","河北省",
                         "安徽省","河南省","山东省"),]
y <- dcast(x,x$province~x$day)
kable(cbind(y[1],round(y[2:7])))

山东

27078/32091

河南

15024/17735

ggplot(x,aes(x$province,as.factor(x$day),fill=-x$Wmean))+
  geom_tile()+
  coord_flip()+
  xlab("省级行政区")+
  ylab("日期")+
  labs(fill="单日交通量")+
  theme(axis.text.y = element_text(size=12))+
  theme(axis.text.x = element_text(size=12))
ggsave(file="D:\\交大云同步\\实习\\06_月度分析报告\\8月分析\\绘图\\台风温比亚.png",dpi=600,height=4.5,width=9)

7.1.2 温比亚对山东省影响

wbysd <- jdwbys[jdwbys$province=="山东省",]
dim(wbysd)

wbysd17 <- wbysd[wbysd$day==17,]
dim(wbysd17)
wbysd20 <- wbysd[wbysd$day==20,]
dim(wbysd20)

wbysd20s <- wbysd20[,c(1,12)]
x <- merge(wbysd17,wbysd20s,by="index")
dim(x)
names(x)[12] <- "cars17"
names(x)[31] <- "cars20"

x$diff <- x$cars20-x$cars17
summary(x$diff)

#t <- sbdeep(x$diff,5,0)
x$type <- ifelse(x$diff>0,"增加","减少")
#x$type <- t$degreevalue
xsd <- x[x$province=="山东省",]
xsd <- xsd[,c(1,2,4,5,33)]

geo_pointplot(xsd,na.rm = T,type=T,region = "山东省")

options(digits = 1)

x$cars <- x$diff
y <- caculate_carsmean(x,"city")
kable(y)

options(digits = 3)
x$cars <- (x$cars20-x$cars17)/x$cars17
kable(caculate_carsmean(x,"city"))

y$Wmean <- -y$Wmean
map = leafletGeo("山东省", y)

#涂色环节
pal <- colorNumeric(palette = "Blues",domain = map$value)


leaflet(map) %>% 
  #addProviderTiles("CartoDB.PositronNoLabels") %>%
#加入框边界及颜色
addPolygons(stroke = TRUE,
                smoothFactor = 1,
                fillOpacity = 0.7,
                weight = 1,
                color = ~pal(value),
                label = ~popup,
                #popup = ~htmltools::htmlEscape(popup),
            labelOptions = labelOptions(noHide = T)) %>%
#加入右下角边框
addLegend("bottomright", pal = pal, values = ~value,
              title = "交通量下降量",
              labFormat = leaflet::labelFormat(prefix = ""),
              opacity = 1)

xweifang <- x[x$city=="潍坊市",]
dim(xweifang)
y <- caculate_carsmean(xweifang,"county")
kable(y)

xlinyi <- x[x$city=="临沂市",]
dim(xlinyi)
y <- caculate_carsmean(xlinyi,"county")
kable(y)

x$cars <- x$diff
y <- caculate_carsmean(x,"county")
y$Wmean <- round(y$Wmean,3)
kable(head(y,20))

x$cars <- x$diff/x$cars17
y <- caculate_carsmean(x,"county")
y$Wmean <- round(y$Wmean,3)
kable(head(y,20))

102个区县中，下降量在10000以上的有17个，下降量在5000以上的有53个，30%以上10个，在20%以上的有30个，10%以上71个。

jdsd <- read.csv("D:\\data\\sx_raw\\交调数据\\8月重点\\jd2018_山东8月分日.csv",stringsAsFactors=F)
dim(jdsd)

jdsds <- handle_gather_forday(jdsd)
dim(jdsds)

x <- caculate_carsmean(jdsds,"day")
x <- x[order(x$day),]

ggplot(x,aes(day,Wmean))+geom_point(colour="steelblue")+geom_line(colour="steelblue")+
    ylim(26000,33000)+labs(x="日期",y="机动车交通量")+
  scale_x_continuous(breaks = c(1,31,seq(1,31,2)))+
  geom_point(aes(x=20,y=27032.91),colour="red",size = 3)
ggsave(file="D:\\交大云同步\\实习\\06_月度分析报告\\8月分析\\绘图\\山东8月分日.png",dpi=600,height=4.5,width=9)

7.1.3 温比亚对河南省影响

wbyhn <- jdwbys[jdwbys$province == "河南省",]
dim(wbyhn)

wbyhn17 <- wbyhn[wbyhn$day == 17,]
dim(wbyhn17)
wbyhn19 <- wbyhn[wbyhn$day == 19,]
dim(wbyhn19)

wbyhn19s <- wbyhn19[,c(1,12)]
x <- merge(wbyhn17,wbyhn19s,by="index")
dim(x)
#names(x)[12] <- "cars17"
names(x)[12] <- "cars"
names(x)[31] <- "cars19"

x$diff <- x$cars19-x$cars17
summary(x$diff)

x$type <- ifelse(x$diff>0,"增加","减少")
#x$type <- t$degreevalue
xsd <- x[x$province=="河南省",]
xsd <- xsd[,c(1,2,4,5,33)]
geo_pointplot(xsd,na.rm = T,type=T,region = "河南省")

x$cars <- x$diff
y <- caculate_carsmean(x,"city")
kable(y)

options(digits = 3)
x$cars <- (x$cars19-x$cars17)#/x$cars17
kable(caculate_carsmean(x,"city"))

y$Wmean <- -y$Wmean
map = leafletGeo("河南省", y)

#涂色环节
pal <- colorNumeric(palette = "Blues",domain = map$value)


leaflet(map) %>% 
  # addProviderTiles("CartoDB.PositronNoLabels") %>%
#加入框边界及颜色
addPolygons(stroke = TRUE,
                smoothFactor = 1,
                fillOpacity = 0.7,
                weight = 1,
                color = ~pal(value),
                label = ~popup,
                #popup = ~htmltools::htmlEscape(popup),
            labelOptions = labelOptions(noHide = T)) %>%
#加入右下角边框
addLegend("bottomright", pal = pal, values = ~value,
              title = "交通量下降量",
              labFormat = leaflet::labelFormat(prefix = ""),
              opacity = 1)

xpuyang <- x[x$city=="濮阳市",]
dim(xpuyang)
y <- caculate_carsmean(xpuyang,"county")
kable(y)

xshangqiu <- x[x$city=="商丘市",]
dim(xshangqiu)
y <- caculate_carsmean(xshangqiu,"county")
kable(y)

x$cars <- x$diff
y <- caculate_carsmean(x,"county")
y$Wmean <- round(y$Wmean,3)
kable(head(y,20))

options(digits = 3)
x$cars <- x$diff/x$cars17
y <- caculate_carsmean(x,"county")
y$Wmean <- round(y$Wmean,3)
kable(head(y,20))

115个区县中，下降量在30%以上24个，20%以上49个，10%以上74个。

jdhn <- read.csv("D:\\data\\sx_raw\\交调数据\\8月重点\\jd2018_河南8月分日.csv",stringsAsFactors=F)
dim(jdhn)

jdhns <- handle_gather_forday(jdhn)
dim(jdhns)

x <- caculate_carsmean(jdhns,"day")
x <- x[order(x$day),]
x

ggplot(x,aes(day,Wmean))+geom_point(colour="steelblue")+geom_line(colour="steelblue")+
    ylim(14000,19000)+labs(x="日期",y="机动车交通量")+
  scale_x_continuous(breaks = c(1,31,seq(1,31,2)))+
  geom_point(aes(x=19,y=14962.64),colour="red",size = 3)
ggsave(file="D:\\交大云同步\\实习\\06_月度分析报告\\8月分析\\绘图\\河南8月分日.png",dpi=600,height=4.5,width=9)

7.2 8月暑期旅游景区交通情况

7.2.1 8月全国旅游景区交通情况

jdnew <- read.csv("D:\\data\\sx_raw\\交调数据\\jd2018_08.csv")
jdlast <- read.csv("D:\\data\\sx_raw\\交调数据\\jd2018_07_2.csv")
jdprevious <- read.csv("D:\\data\\sx_raw\\交调数据\\jd2017_08.csv")

jdnews <- handle_gather(jdnew)
jdlasts <- handle_gather(jdlast)
jdpreviouss <- handle_gather(jdprevious)
usefulstation <- intersect(jdnews$index,jdlasts$index)
jdnews <- jdnews[jdnews$index %in% usefulstation,]
jdlasts <- jdlasts[jdlasts$index %in% usefulstation,]
jdpreviouss <- jdpreviouss[jdpreviouss$index %in% usefulstation,]

机动车

今年8月

jdscenerynew <- jdnews[not(is.na)(jdnews$scenery),]
dim(jdscenerynew)

weighted.mean(jdscenerynew$cars,na.rm = T)

去年8月

jdsceneryprevious <- jdpreviouss[not(is.na)(jdpreviouss$scenery),]
dim(jdsceneryprevious)

weighted.mean(jdsceneryprevious$cars,na.rm = T)

今年7月

jdscenerylast <- jdlasts[not(is.na)(jdlasts$scenery),]
dim(jdscenerylast)

weighted.mean(jdscenerylast$cars,na.rm = T)

同比增长

(28998-26787)/26787

环比增长

(28998-27297)/27297

客车

weighted.mean(jdscenerynew$passenger_cars,na.rm = T)
weighted.mean(jdsceneryprevious$passenger_cars,na.rm = T)
weighted.mean(jdscenerylast$passenger_cars,na.rm = T)

(15020-13690)/13690 # 同比
(15020-13682)/13682 # 环比

各旅游景区情况

scenery1808 <- caculate_carsmean(jdnews,"scenery")
scenery1807 <- caculate_carsmean(jdlasts,"scenery")
scenery1708 <- caculate_carsmean(jdpreviouss,"scenery")

tb <- caculate_increaseratio(scenery1808,scenery1708)
hb <- caculate_increaseratio(scenery1808,scenery1807)
x <- merge_outcome(scenery1808,tb,hb,bywhat = "scenery")

t <- table(jdnews$province,jdnews$scenery) %>% as.data.frame()
t <- t[t$Freq!=0,c(1,2)]
names(t) <- c("province","scenery")

g <- merge(x,t,by="scenery")
g$province <- factor(g$province,ordered = T,levels=province_level)
g <- g[,c("province","scenery","now","previous","last")]
kable(g[order(g$province),])

7.2.2 8月贵州旅游景区

jdgz <- read.csv("D:\\data\\sx_raw\\交调数据\\8月重点\\jd2018_贵州8月分日.csv",stringsAsFactors=F)
dim(jdgz)

jdgzs <- handle_gather_forday(jdgz)
names(jdgzs)

xp <- jdgzs[jdgzs$label=="小坡观测站",]
dim(xp)

xp <- xp[order(xp$day),]
ggplot(xp,aes(day,passenger_cars))+
  geom_point(colour="steelblue")+geom_line(colour="steelblue")+
  ylim(5000,18000)+labs(x="日期",y="客车交通量")+
  scale_x_continuous(breaks = c(1,31,seq(1,31,2)))
ggsave(file="D:\\交大云同步\\实习\\06_月度分析报告\\8月分析\\绘图\\小坡.png",dpi=600,height=4.5,width=9)

10月6日达到最大：15636。

dss <- jdgzs[jdgzs$label=="大山哨观测站",]
dim(dss)

dss <- dss[order(dss$day),]

ggplot(dss,aes(day,passenger_cars))+
  geom_point(colour="steelblue")+geom_line(colour="steelblue")+
  labs(x="日期",y="客车交通量")+ylim(20000,45000)+
  scale_x_continuous(breaks = c(1,31,seq(1,31,2)))
ggsave(file="D:\\交大云同步\\实习\\06_月度分析报告\\8月分析\\绘图\\大山哨.png",dpi=600,height=4.5,width=9)

x <- caculate_level_passcarsmean(jdgzs,"day")
x <- x[order(x$day),c(1,2,3)]
x <- melt(x,id.vars = "day")

ggplot(x,aes(day,value,group=variable,colour=variable))+
  geom_point()+
  geom_line()+
  scale_x_continuous(breaks = c(1,31,seq(1,31,2)))+
  labs(x="日期",y="单日交通量",colour="道路等级")+
  ylim(0,22000)
ggsave(file="D:\\交大云同步\\实习\\06_月度分析报告\\7月分析\\绘图\\国高国道.png",dpi=600,height=4.5,width=9)

x <- caculate_level_passcarsmean(jdgzs,"day")
x <- x[,c(1,2)]

jd2017gz <- read.csv("D:\\data\\sx_raw\\交调数据\\8月重点\\jd2017_贵州8月分日.csv",stringsAsFactors=F)
dim(jd2017gz)

jd2017gzs <- handle_gather_forday(jd2017gz)
dim(jd2017gzs)

y <- caculate_level_passcarsmean(jd2017gzs,"day")
y <- y[order(y$day),c(1,2)]

z <- cbind(x,y)
z <- z[,-3]
names(z)[2:3] <- c("2018年8月","2017年8月")
z <- melt(z,id.vars = "day")

ggplot(z,aes(x=z$day,y=z$value,group=z$variable,colour=z$variable))+
  geom_line()+geom_point()+
  scale_x_continuous(breaks = c(1,31,seq(1,31,2)))+
  labs(x="日期",y="单日交通量",colour="年份")+
  ylim(10000,22000)
ggsave(file="D:\\交大云同步\\实习\\06_月度分析报告\\8月分析\\绘图\\贵州1718对比.png",dpi=600,height=4.5,width=9)

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