準備工作

安裝/載入必要套件

# 請先安裝套件
install.packages("reshape2") # 安裝 `reshape2` 套件
install.packages("vegan")
install.packages("ggplot2")
install.packages("ggdendro")

# 載入套件
library(reshape2) 
library(dplyr)
library(vegan)
library(ggplot2)
library(ggdendro)

讀取檔案

103年台電得到發標案最高的前一百間公司決標公告

Taipower <- read.csv(("https://johnsonhsieh.github.io/DSC2016-R/data/Taipower_top100.csv"), 
                     fileEncoding = "big5")

str(Taipower) 
'data.frame':   798 obs. of  12 variables:
 $ job_number                 : Factor w/ 725 levels "008-0000017-4",..: 557 1 222 262 535 444 689 689 689 325 ...
 $ subject_of_procurement     : Factor w/ 650 levels "(新)谷關~天輪161kV線#1A鐵塔用防墜裝置",..: 48 86 618 2 363 122 398 398 398 116 ...
 $ procuring_entity           : Factor w/ 52 levels "台灣電力股份有限公司",..: 1 1 7 52 14 1 1 1 1 1 ...
 $ entity_code                : Factor w/ 46 levels "3.13.31","3.13.31.1",..: 1 1 35 37 46 1 1 1 1 1 ...
 $ attr_of_procurement        : Factor w/ 53 levels "<財物類>12石油及天然氣",..: 45 17 18 20 52 16 33 33 33 16 ...
 $ procurement_type           : Factor w/ 5 levels "公開取得報價單或企劃書",..: 4 4 3 2 2 5 5 5 5 5 ...
 $ tender_awarding_type       : Factor w/ 4 levels "參考最有利標精神",..: 3 3 3 3 3 3 3 3 3 3 ...
 $ tenderer_name              : Factor w/ 100 levels "安倉營造股份有限公司",..: 67 20 29 11 36 53 91 93 94 53 ...
 $ total_tender_awarding_value: int  970000 13839638 1308000 182000000 7847400 381981 89367696 89367696 89367696 2890000 ...
 $ amount_range               : Factor w/ 4 levels "查核金額以上未達巨額",..: 4 2 2 3 2 4 3 3 3 2 ...
 $ tender_awarding_date       : Factor w/ 247 levels "1/10/2014 0:00:00",..: 8 97 15 1 3 14 101 101 101 82 ...
 $ start_end_date             : Factor w/ 712 levels "098/03/16－105/12/31",..: 91 138 59 72 75 52 146 147 145 42 ...

資料整理

篩選出總決標金額最高的10間公司, 指向 TP10 物件

# 103年得到台電標案金額最高的10間公司
top10 <- group_by(Taipower, tenderer_name) %>%
  summarise(value=sum(as.numeric(total_tender_awarding_value), na.rm = TRUE), 
            count=n()) %>%
  arrange(-value) %>% slice(1:10)

setNames(top10, c("企業","總金額","得標數")) # show the output
Source: local data frame [10 x 3]

                                    企業     總金額 得標數
                                  (fctr)      (dbl)  (int)
1               華榮電線電纜股份有限公司 3115245425      9
2               合機電線電纜股份有限公司 3060890653      6
3                 Mitsubishi Corporation 2943266566     10
4                       大同股份有限公司 2587134910     23
5                 台灣艾斯敦股份有限公司 2437618930      9
6               中興電工機械股份有限公司 2153352721     50
7          BIT MARITIME LIMITED ( 海瀧 ) 2103372941     35
8                 大東電業廠股份有限公司 1462570000      2
9              TRANSBEST LIMITED（黃海） 1447958282     18
10 KAWASAKI KISEN KAISHA, LTD.(台灣川崎) 1439129452     13
# 從百大企業篩選出前十大
TP10 <- filter(Taipower, tenderer_name%in%top10$tenderer_name) 

# 建構這10間公司與標案類別的 incidence matrix

is.present <- function(x){
  y <- sum(as.numeric(x)>0, na.rm = TRUE)
  ifelse(y>0, 1, 0)
}

TP10.inc <- dcast(TP10, tenderer_name ~ attr_of_procurement, 
                  value.var = "total_tender_awarding_value", 
                  fun.aggregate = is.present)
rownames(TP10.inc) <- TP10.inc[,1]
TP10.inc <- TP10.inc[,-1] # 第一欄結果指向rownames, 並移除第一欄

土炮 hclust + plot

# 用Jaccard dissimilarity 計算距離
d <- vegdist((TP10.inc), method = "jaccard")
hc <- hclust(d)
par(family="STHeiti") # 讓Mac顯示中文的指令，Windows使用者請不要執行本行
plot(hc)

plot(hc, hang=-1) #  把樹枝拉平

好看一點 ggplot2 + ggdendro

# 一行搞定，但是Mac會無法顯示中文
ggdendrogram(hc, theme_dendro = FALSE)

# 土炮
dhc <- as.dendrogram(hc)
ddata <- dendro_data(dhc, type = "rectangle")
p <- ggplot(segment(ddata)) + 
  geom_segment(aes(x = x, y = y, xend = xend, yend = yend)) + 
  coord_flip() + 
  scale_y_reverse(expand = c(0., 0.4))  +
  geom_text(data = ddata$labels, 
            family = "STHeiti", # Windows的使用者不需要設定黑體字，請移除本行
            aes(x = x, y = y-0.01, label = label), size = 3, hjust = 0)
p

出大絕招：heatmap

par(family="STHeiti") # 讓Mac顯示中文的指令，Windows使用者請不要執行本行
mat <- as.matrix(TP10.inc[,-1])
heatmap(mat, scale = "none", 
        distfun=function(x){vegdist(x, method = "jaccard")})