HeatMap - 週一到週日＆24小時的熱點圖

traffic$time = as.Date(paste(traffic$time.month,traffic$time.day,sep = "."), format = "%m.%d")

traffic$time.weekday = weekdays(traffic$time)

traffic$time.weekday = as.factor(traffic$time.weekday)
traffic$time.weekday = factor(traffic$time.weekday, , levels = c("周一","周二","周三","周四","周五","周六","周日"))

time_injury_matrix = traffic %>% 
  group_by(time.hour,time.weekday) %>% 
  summarise(sum_injury = sum(number.injury))
  #spread(key=time.month,value=sum_injury)

# heatmap(as.matrix(time_injury_matrix), Rowv=NA, Colv=NA, labs=2, col = brewer.pal(9, "Reds"),margins=c(5,2))

# 為了讓axis上的座標出現做的步驟，如果是int形態就無法顯示
time_injury_matrix$time.hour = as.factor(time_injury_matrix$time.hour)
time_injury_matrix$time.hour = factor(time_injury_matrix$time.hour,levels = rev(levels(time_injury_matrix$time.hour)))

ggplot(aes(x=time.weekday,y=time.hour),data=time_injury_matrix) +
  geom_tile(aes(fill=sum_injury, height=1)) +
  theme_classic() +
  scale_fill_gradient(low="yellow",high="red", name="受傷人數") +
  scale_x_discrete(expand = c(0,0), position = "top") +
  scale_y_discrete(expand = c(0,0)) +
  theme(axis.line=element_blank(),
        axis.ticks=element_blank(),
        axis.text = element_text(size=12, color="black"),
        axis.text.y = element_text(size=10),
        text = element_text(family = "STHeiti"))+
  labs(x="",y="")

總結：

1. 週一早上並沒有因為週末狂歡睡眠不足而出現較多車禍，反而比較謹慎！？ＸＤ

2. 最多事故的早上反而是集中在週四五六 3. 至於週二下午兩點到三點的高峰值，仍無法想出合理的原因來解釋



戰男女囉！！

## 疑問！！party.gender這邊是指搭載乘客性別吧！？應該不是駕駛
tra_gender_hour = traffic %>% 
  group_by(party.gender,time.hour) %>% 
  tally()

ggplot(aes(x=time.hour, y = n), data=tra_gender_hour) +
  geom_line(aes(color=party.gender)) +
  theme(text=element_text(family="STHeiti"), legend.position = "bottom") +
  labs(x="事故發生時間點（時）", y="次數", title="台北市每小時時段發生車禍次數") +
  scale_x_continuous(limits = c(0,23), breaks = seq(0,23,2)) +
  scale_color_discrete(name="事故之乘客種類")

總結：

1. 當乘客為男性時，其事故發生頻率遠大於乘客為女性

2. 推測：為了展現工具人的安全感，所以載妹子都會比較小心ＸＤ

3. 得證 -> 妹子的命＞兄弟的命！？



亮點 - 警察的習慣

tra_minute = traffic %>% 
  group_by(time.minute) %>% 
  tally()

ggplot(aes(x=time.minute, y=n), data=tra_minute) +
  geom_histogram(stat="identity",aes(fill='#A5A552')) +
  labs(x="事故發生時間（分鐘）", y="事故發生次數") +
  theme(text = element_text(family = "STHeiti"), legend.position = "none") +
  scale_x_continuous(breaks = seq(0,60,5))

總結：

1. 警察在登記事故發生時，也意外地暴露出人性的一面。大多將其事故時間記錄在以五為單位的整數時刻（分鐘）



各類型車種事故發生比較

tra_vehicle = traffic %>% 
  filter(vehicle.type != "NA") %>% 
  group_by(vehicle.type) %>% 
  summarise(n=n()) %>% 
  arrange(desc(n)) %>% 
  head(10)

# tra_vehicle$vehicle.type = droplevels(tra_vehicle$vehicle.type)

tra_vehicle$vehicle.type = as.character(tra_vehicle$vehicle.type)
tra_vehicle$vehicle.type = factor(tra_vehicle$vehicle.type, levels = tra_vehicle$vehicle.type)

top10_vehicle = levels(tra_vehicle$vehicle.type)

ggplot(aes(x=reorder(vehicle.type,-n), y=n, fill=vehicle.type), data=tra_vehicle) +
  geom_bar(stat="identity") +
  theme_classic() +
  theme(text=element_text(family="STHeiti"), legend.position = "none") +
  coord_flip() +
  labs(x="車種類型", y="事故發生次數")



事發地點限速觀察

# table(traffic$location.speed.limit)

tra_speed_vehicle = traffic %>% 
  filter(vehicle.type != "NA") %>% 
  group_by(location.speed.limit, vehicle.type) %>% 
  summarise(n=n()) %>% 
  arrange(desc(n))

# tra_vehicle$vehicle.type = droplevels(tra_vehicle$vehicle.type)


ggplot(aes(x=location.speed.limit, y=n, color=vehicle.type), data=subset(tra_speed_vehicle, vehicle.type %in% top10_vehicle[1])) +
  geom_point() +
  geom_line() +
  labs(x="限速", y="事故次數",title="普通重型機車之速限與事故次數關係圖") +
  theme(text = element_text(family = "STHeiti"), legend.position = "none")

ggplot(aes(x=location.speed.limit, y=n, color=vehicle.type), data=subset(tra_speed_vehicle, vehicle.type %in% top10_vehicle[-1])) +
  geom_point() +
  geom_line() +
  labs(x="限速", y="事故次數") +
  theme(text = element_text(family = "STHeiti")) +
  facet_wrap(~vehicle.type, ncol=3) +
  scale_color_discrete(name="事故車種")

總結：

1. 大多車禍都集中發生在中等限速40-60之間



預測分析交通事故 - 隨機森林

# 篩選適合做自變數的因子
tra_factor = traffic[c("time.weekday","time.hour","location.district","location.weather","location.speed.limit","location.road.type","location.type","number.dead","number.injury")]

# table(complete.cases(tra_factor))
# table(is.na(tra_factor$location.type))

#table(traffic$number.dead)
#table(traffic$number.injury > 1)

#mean(traffic$number.injury)
#median(traffic$number.injury)

## 定義兩人以上受傷或者有人死亡為嚴重事故（包含兩人），其餘為輕微事故

tra_factor = tra_factor %>% 
  filter(!is.na(location.type)) %>% 
  mutate(major_accident=ifelse(number.injury >=2 | number.dead ==1 ,1,0))

tra_factor = tra_factor[,c(-8,-9)]

set.seed(123)
spl = sample.split(tra_factor$major_accident, SplitRatio = 0.6)

train = tra_factor[spl,]
test = tra_factor[!spl,]

# random forest http://www.cnblogs.com/nxld/p/6374945.html
rf = randomForest(major_accident ~ . , data=train, ntree = 100)

pred = predict(rf, newdata = test)
t = table(test$major_accident,pred>0.5)
sum(diag(t))/sum(t)
## [1] 0.7791489
var_importance <- data_frame(variable=setdiff(colnames(test), "major_accident"),importance=as.vector(importance(rf)))
var_importance <- arrange(var_importance, desc(importance))
var_importance$variable <- factor(var_importance$variable, levels=var_importance$variable)

p <- ggplot(var_importance, aes(x=variable, weight=importance, fill=variable))
p <- p + geom_bar() + ggtitle("Variable Importance from Random Forest Fit")
p <- p + xlab("Demographic Attribute") + ylab("Variable Importance")
p <- p + scale_fill_discrete(name="Variable Name")
p + theme(axis.text.x=element_blank(),
          axis.text.y=element_text(size=12),
          axis.title=element_text(size=16),
          plot.title=element_text(size=18),
          legend.title=element_text(size=16),
          legend.text=element_text(size=12))

總結：

1.說到車禍第一直覺都想到跟天雨路滑有關，也就是天氣。但在此分析預測中，其實時段、地點才是最重要的，反而天氣的重要性並無想像中的高

2.此模型（預測準確度為0.78）最主要靈感來源是期望可藉由非當日狀況之資訊來提前做交警及醫護之人力安排，也就是依照各個時間地點天氣狀況來做適度的調動已達到人力使用最大化。