【002】本圖呈現台灣各縣市平均每10,000位老人有多少長照機構數量,可以發現整體而言,中部地區的數量較少、
load("graphData_homework3_002.Rda")
c('city','year','kid_share','youth_share','elder_share','pop_change','pop_density','labor_par','unemployment','youth_un','middle_un','older_un','nursing_homes','nh_capacity','nh_admission','avg_nh','annuity_num','annuity_total','income','expense','self_funding','tax_incidence','hospitals','practitioners','family_size','family_emp','area')->names(graphData[[1]])
## ----graph, echo=T, eval=T-----------------------------------------------
#reorder "city" & draw dotplot
graphData$sub_2015_city%>%
arrange(desc(area), avg_nh)%>%
mutate(city = fct_inorder(city))%>%
ggplot(aes(x = avg_nh, y = city, color = area))+labs(x = "長照機構數(每10,000位老人)", y="")+theme_bw()+geom_point(size=3)
本圖呈現台灣各縣市平均每10,000位老人有多少長照機構數量,可以發現整體而言,中部地區的數量較少、離島地區除連江縣為全台數量最多以外,其餘均為為全台灣數量最低。
【003】該筆資料為新北市林口區各街段於民國107年的公告地價盒形圖。

load("graphData_homework3_003.Rda")
c('country','district','segment','lid','official_value','official_price')->names(graphData[[1]])
c('official_value','official_price','district')->names(graphData[[2]])
## ----graph, echo=T, eval=T-----------------------------------------------
library(ggthemes); library(colorspace)
# colorspace::choose_palette(gui = "shiny")
# colorspace::choose_color()
# How bout a box plot this week?
house.plot <- graphData$new.land %>% ggplot() +
geom_boxplot(aes(x = district, y = official_price, fill = district),
show.legend = F) +
geom_hline(yintercept = c(20000, 40000), linetype = "twodash",
color = "steelblue") +
theme(plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
plot.subtitle = element_text(hjust = 0.5, size = 12),
plot.caption = element_text(size = 5),
axis.line.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.line.x = element_blank(),
axis.ticks.x = element_blank(),
axis.text.x = element_text(angle = 30, vjust = 0.3),
plot.background = element_rect(fill = "#FBDFB2"),
panel.background = element_rect(fill = "#FBDFB2")) +
labs(x = NULL, y = NULL, title = "林口區107年公告地價分布",
caption = "資料來源: 台灣政府資料開放平台", subtitle = "依照街段呈現") +
annotate("text", x = 4, y = 18500, label = paste("20000 (元/平方公尺)"),
size = 3, color = "steelblue") +
annotate("text", x = 5.5, y = 38500, label = paste("40000 (元/平方公尺)"),
size = 3, color = "steelblue") +
annotate("text", x = 16, y = 50000,
label = paste("平均地價為: ",
round(mean(graphData$new.land$official_price)),
" (元/平方公尺)"),
size = 3, color = "black")
house.plot
該筆資料為新北市林口區各街段於民國107年的公告地價盒形圖。
由圖中各街段的“盒子”可知,僅有少部分的地段具有較高的公告地價。此些地段不僅為相對高價地段,此些街區和其他街區的公告地價相比具有誇張的差距。其中又以“力行段”的公告地價相差最大,該地段的中位數遠遠超過其他地段的中位數且其組內的差距也十分大,更加拉大林口區公告地價的高低差異。
另兩地段: “建林段” 以及 “國宅段” 也較其他地段的公告地價中位數高出些許,但最主要的影響仍是此兩地段眾多的離群值。建林段的離群值效果極度明顯,不僅離群值高出力行段的第三四分位距且離群值的數量非常多。國宅段的離群值雖較建林段來的少,但仍可見此地段和其他地段的差異。
又由圖中的兩條輔助線以及上方全地段平均公告地價可窺見上述三個地段和其他地段的地價差異。林口地區雖然常有高房價、值得投資房地產的印象,但或許僅侷限在此三個地段而已。
設計想法
原始資料不分大段小段其實有35個地段,但小段多為大段下的小區段,例如- 大南灣寶斗厝坑小段。考量到35個地段不適合以盒形圖呈現,且雖分為小段但仍同屬同一地區的性質,故筆者認為將同一大段下之小段合併仍能呈現出該地段的房價資訊。又考量到類別資料中會出現的Sparse Data
問題(單一類別中的觀察值數量過少,導致進行統計檢定甚至繪圖時出現偏差),故將小段合併應能避免此一問題。
因為該圖共有18個“盒子”,畫面非常繁雜。故筆者將X、Y兩軸皆刪去,僅留下必要的資訊,使畫面一瞬簡潔許多。幸運的是,地段名稱(大段)最長僅4個字,因此可將字體做角度處理而不用將XY軸轉換,使盒形圖的效果更為直覺。
該圖的重點在於呈現三個地段和其他地段的明顯差距,因此各地段的準確地價便不需交代,可以直接將Y軸刪掉。隨後加上的兩條輔助線可達到凸顯地價壓制的效果,還可將地價單位偷渡進圖中的效果。最後再將林口區全地段的平均地價標示於太過空曠右上角,平衡掉尷尬感,順便加強地價差異的實感。
選色上因為有18個盒子要選,因此果斷交給default,反正一定很鮮豔。背景色也因此被局限在較為平淡低調的色系。最終達到“華國美學”的繪圖效果,還算可以。
【004】臺灣 2016 至 2018 年國小一年級至三年級近視學生總人數趨勢圖:

load("graphData_homework3_004.Rda")
c('級別','年分','總近視學生人數')->names(graphData[[1]])
## ----graph, echo=T, eval=T-----------------------------------------------
colorspace::sequential_hcl(n = 7, h = c(-4, 80), c = c(100, NA, 47), l = c(55, 96), power = c(1, NA), register = "YEAR-Palette")
graphData$nearsightedStud%>%
ggplot()+
geom_col(
aes(
x = 級別,
y = 總近視學生人數,
fill = 年分
),
position = position_dodge(0.85),
width =0.65,
color = "black",
linetype = "solid",
size = 0.76
)+
scale_fill_discrete_sequential(
palette = "YEAR-Palette",
nmax = 5
)+
scale_x_discrete(
breaks = c("國小一年級","國小二年級","國小三年級"),
labels = c("一年級","二年級","三年級")
)+
theme(
panel.background = element_rect(fill = NA),
panel.grid = element_line(colour = "black", size = 5),
panel.ontop = F,
panel.grid.major.y = element_line(colour = "gray50"),
panel.border = element_rect(fill = NA,size = 1)
)+
labs(
title = "臺灣2016至2018年國小一到三年級近視學生總人數趨勢圖",
tag = "(單位:人)",
caption = "資料來源:政府資料開放平台")+
theme(
plot.tag.position = "topleft",
plot.title = element_text(hjust = 0.5),
legend.title.align = 0.5,
axis.title.x.bottom = element_blank(),
axis.title.y.left = element_blank()
) -> finalplot
finalplot
臺灣 2016 至 2018 年國小一年級至三年級近視學生總人數趨勢圖:
左方資料圖顯示國小一、二、三年級分別的各年度近視學生人數。從趨勢上分析,一年級人數有增加現象,尤其在 2018 年時(與前一年比較)上升幅度最大;二年級人數在 2017 年時減少,但在 2018 年時稍微回升,高峰時間是 2016 年;三年級人數是三級別中總數最多的,且在 2016 至 2018 年期間逐漸下降。
設計想法:
作圖者想呈現國小各年級在不同年度的人數趨勢,因此 X 軸以級別為類別,用漸層色的長條圖顯示其各年度之間的變化。
【005】此筆資料為2018年台灣地區確診登革熱病例統計,從圖中可以得知年齡層21-40歲的確診人數最多,而2
load("graphData_homework3_005.Rda")
c('area','age','性別','n')->names(graphdata[[1]])
## ----graph, echo=T, eval=T-----------------------------------------------
library(ggalluvial)
#is_alluvia_form(as.data.frame(graphdata), axes = 1:3, silent = TRUE)
finalplot<-ggplot(as.data.frame(graphdata),
aes(y = n, axis1 = age, axis2 =area)) +
geom_alluvium(aes(fill=性別), width = 1/10) +
geom_stratum(width = 1/10, fill = "gray", color = "white") +
geom_label(stat = "stratum", label.strata = TRUE) +scale_x_discrete(limits = c("age", "area"), expand = c(.1, .1)) +scale_fill_brewer(type = "qual", palette = "Set2")+
ggtitle("2018年登革熱病例統計")+ylab('確診人數')+theme(title = element_text(family ="QYuan" ))
finalplot
此筆資料為2018年台灣地區確診登革熱病例統計,從圖中可以得知年齡層21-40歲的確診人數最多,而21-40這個年齡層的病例集中於北部及南部地區。此圖亦可得知整體男性確診人數多於女性。
【006】該圖為2019年8月台灣縣市已登記公司總實收資本額分布圖。橫軸為經度
,縱軸為緯度
,類

load("graphData_homework3_006.Rda")
c('COUNTYNAME','總計家數','總計資本額','農林漁牧業家數','農林漁牧業資本額','礦業及土石採取業家數','礦業及土石採取業資本額','製造業家數','製造業資本額','電力及燃氣供應業家數','電力及燃氣供應業資本額','用水供應及污染整治業家數','用水供應及污染整治業資本額','營造業家數','營造業資本額','批發及零售業家數','批發及零售業資本額','運輸及倉儲業家數','運輸及倉儲業資本額','住宿及餐飲業家數','住宿及餐飲業資本額','資訊及通訊傳播業家數','資訊及通訊傳播業資本額','金融及保險業家數','金融及保險業資本額','不動產業家數','不動產業資本額','專業科學及技術服務業家數','專業科學及技術服務業資本額','支援服務業家數','支援服務業資本額','公共行政及國防;強制性社會安全家數','公共行政及國防;強制性社會安全資本額','教育服務業家數','教育服務業資本額','醫療保健及社會工作服務業家數','醫療保健及社會工作服務業資本額','藝術娛樂及休閒服務業家數','藝術娛樂及休閒服務業資本額','其他服務業家數','其他服務業資本額','未分類家數','未分類資本額','geometry')->names(graphData[[1]])
## ----graph, echo=T, eval=T-----------------------------------------------
library(ggrepel)
finalplot <- graphData$my.taiwan.map.data %>%
ggplot() + geom_sf(aes(fill = 總計資本額/10000)) + scale_fill_distiller(palette = "Spectral",name = "總計資本額(百億元)") + coord_sf(xlim=c(117,123), ylim = c(21,27)) + labs(title="台灣縣市已登記公司總實收資本額分布圖", x ="經度", y = "緯度") + ggrepel::geom_label_repel(
data = graphData$my.taiwan.map.data[c(10), ],
aes(label = COUNTYNAME, geometry = geometry),
stat = "sf_coordinates",
min.segment.length = 0,
colour = "white",
segment.colour = "black",
arrow = arrow(length = unit(0.03,"npc"),ends = "first"),
xlim=120, ylim = 25.5,
fill = "darkorchid2",
fontface="bold"
) + annotate("text",x = 120, y = 21,
label = paste("資料來源:https://data.gov.tw/dataset/8296"), size = 3)
finalplot
該圖為2019年8月台灣縣市已登記公司總實收資本額分布圖。橫軸為經度
,縱軸為緯度
,類別為總計資本額(百億元)
,類別以色條表示,越接近紅色,總計資本額越大,越接近藍色,總計資本額越小。本圖以色條搭配臺灣地圖,使輕易看出全臺不同縣市的比較,其中臺北市的資本額極高,因此特別標示出來。
此圖的資料由政府資料開放平台中的已登記公司csv檔(https://data.gov.tw/dataset/8296)取得,而此圖所繪製的臺灣地圖資料同樣由政府資料開放平台中的直轄市、縣市界線(TWD97經緯度)ESRI Shapefile檔(https://data.gov.tw/dataset/7442)取得。
由此圖可以清楚看出高雄市、臺中市、桃園市、新北市的顏色接近綠色,而其餘縣市幾乎都是藍色,得知這些直轄市資本額遠大於其他縣市。細項來看,臺北市的顏色為紅色,資本額為全臺之冠,甚至可稱為離群值,由於臺北市的其值相對過大因此特別標示文字於旁。而東部、南投、離島的顏色相較其他縣市,其藍色較深,也較接近色條底部的顏色,因此可以看出這些縣市的資本額較低。
本圖可說明臺灣的城鄉差距之嚴重程度有多明顯,並可清楚看出臺灣已登記公司的總資本額由高至低,依序為臺北市(首都),接著是六都中除了臺北市以外的直轄市,最後則是東部及離島。這些狀況除了城鄉差距以及人口基數問題,也因各縣市的行業別組成不同而導致,如臺北市大多為金融業、服務業,然而這些產業在東部及離島較少人願意投資。倘若持續下去,城鄉差距恐逐年上升。
【007】此圖為2017年底六都各年齡層人口比例。從此圖中可發現:
load("graphData_homework3_007.Rda")
c('區域別','年齡層','比例')->names(graphData[[1]])
## ----graph, echo=T, eval=T-----------------------------------------------
graphData$population %>%
ggplot()+
aes(x = 區域別,
y = 比例,
fill = 年齡層) +
geom_col() +
geom_text(mapping = aes(label = sprintf("%.1f%%",
比例*100)),
size = 3,
colour = 'black',
vjust = 1,
hjust = .5,
position = position_stack())+
labs(title = "2017年底六都各年齡層人口比例")
此圖為2017年底六都各年齡層人口比例。從此圖中可發現: 1.桃園市15歲以下的人口比例為六都中最高,且老年人口比例為六都中最低,由此可知在六都中,桃園的人口平均最為年輕;台中則為次年輕。 2.新北市為六都中民間人口(勞動力+非勞動力)最多的區域(74.3%);桃園市則為次多(73.5%)。 3.台北市為六都中老年人口最多的區域,但15-64歲的人口比例為六都最低,為民間人口最少的區域。 4.台灣於2018年3月正式邁入高齡社會(65歲以上老年人口占總人口比率達到14%),在本資料中顯示,2017年底台北市、台南市及高雄市已進入高齡社會,可見此三區域之老年人口比例較全台灣高。 (資料來源:中華民國內政部戶政司全球資訊網>年度縣市及全國統計資料>戶數、人口數及遷徙>縣市人口案性別及五齡組)
【008】以新北市資料為例,整體輟學率在 12 年間無太多變動,大約在 0.3 % 上下,而原住民生輟學率從近

load("graphData_homework3_008.Rda")
c('年','變數名稱','數值')->names(graphData[[1]])
c('年','變數名稱','數值')->names(graphData[[2]])
## ----graph, echo=T, eval=T-----------------------------------------------
graphData$drop_out_New_Taipei2 %>%
ggplot() +
geom_bar(aes(x = 年, y = 數值, color = 變數名稱), size = 0.5, stat = "identity", position = "dodge", fill = "black", size = 1.5) +
geom_path(data = graphData$drop_out_New_Taipei1, aes(x = 年, y = 數值, color = 變數名稱), size = 0.8) +
geom_point(data = graphData$drop_out_New_Taipei1, aes(x = 年, y = 數值, color = 變數名稱), size = 1.4) +
scale_x_continuous(breaks = 2003:2015) +
labs(title = "原住民生輟學率有下降趨勢 ( 新北市 )", subtitle = "原住民生男女輟學比例趨同", caption = "資料來源 : 新北市政府主計處" ) +
theme(
plot.background = element_rect(fill = "black"),
panel.background = element_rect(fill = "black"),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
title = element_text(colour = "white"),
axis.ticks = element_line(colour = "white"),
axis.line = element_line(colour = "white"),
axis.text = element_text(colour = "white"),
legend.text = element_text(colour = "white"),
legend.background = element_rect(fill = "black"),
legend.position = "top",
legend.title = element_blank(),
plot.caption = element_text(size = 10, hjust = -0.01, vjust = -5),
plot.title = element_text(hjust = -0.05,vjust = 3, size = 18),
plot.subtitle = element_text(hjust = -0.02, vjust = 3, size = 12),
plot.margin = margin(0.8, 0.8, 0.8, 0.8, "cm"),
axis.text.x = element_text(vjust = -1),
) +
scale_color_manual(values = c( 全體輟學率 = "#00FF00", 原住民族輟學率 = "red", 原住民族輟學率_男 = "deepskyblue", 原住民族輟學率_女 = "#FF00FF")) +
scale_y_continuous(breaks = 0:2 ,position = "right")
以新北市資料為例,整體輟學率在 12 年間無太多變動,大約在 0.3 % 上下,而原住民生輟學率從近 2 % 下降至近 1 %,且原住民生的男女比例相近,除 2003、2007 有些微拉開外。 在 2006 - 2008 年間原住民生輟學率大幅低於其他時間,原因未明,但推測是統計資料缺失,或原住民族認定標準有短暫更動過,或是其他政策推行所導致,因年間的總輟學率波動沒有這樣的情形。
【009】該圖呈現2017年亞洲、歐洲、北美、大洋洲各國之人均GNP,其中

load("graphData_homework3_009.Rda")
c('Country Name','Country Code','Series Name','Series Code','2017 [YR2017]','rigion')->names(graphData[[1]])
c('Country Name','Country Code','Series Name','Series Code','2017 [YR2017]','rigion')->names(graphData[[2]])
c('Country Name','Country Code','Series Name','Series Code','2017 [YR2017]','rigion')->names(graphData[[3]])
c('Country Name','Country Code','Series Name','Series Code','2017 [YR2017]','rigion')->names(graphData[[4]])
c('國名','國家代碼','區域','GNP per capita(current US$)')->names(graphData[[5]])
c('國名','國家代碼','區域','GNP per capita(current US$)')->names(graphData[[6]])
## ----graph, echo=T, eval=T-----------------------------------------------
graphData$AEA_bindThree_eV1 %>%
ggplot() +
geom_point(
aes(
x = 區域,
y = `GNP per capita(current US$)`
),
shape = 124,
size = 10,
color = "#00BFFF",
alpha = 0.2
) +
geom_point(
data = graphData$AEA_bindThree_eV2,
aes(
x = 區域,
y = `GNP per capita(current US$)`
),
shape = 124,
size = 10,
color = "#00BFFF",
) +
geom_text(
data = graphData$AEA_bindThree_eV2,
aes(
x = 區域,
y = `GNP per capita(current US$)`,
label = 國名
),
size = 3,
vjust = -3,
hjust = 0.6
) +
coord_flip() ->
graphData$godplot_base
graphData$godplot_base +
theme_bw() +
theme(
panel.border = element_blank(),
panel.grid.minor = element_blank()
) +
theme(
axis.ticks = element_blank(),
axis.title = element_blank()
) +
scale_x_discrete(
limits = c("EastAsiaPacific", "NorthAmerica", "EuropeCentralAsia"),
labels = c("East Asia & Pacific", "North America", "Europe & Central Asia")
) +
scale_y_continuous(
labels = function(x) x/1000
) ->
graphData$godplot_1
graphData$godplot_1 +
labs(
title = "GNP per capita 2017",
subtitle = "Source: World Bank",
caption = "US$ thousand"
) +
theme(
plot.title = element_text(face = "bold"),
plot.subtitle = element_text(color = "#AAAAAA"),
plot.caption = element_text(color = "#666666")
) ->
graphData$godplot_eV
graphData$godplot_eV
該圖呈現2017年亞洲、歐洲、北美、大洋洲各國之人均GNP,其中
-
歐洲、亞洲國家人均GNP差異很大
-
北美地區人均GNP偏高
【011】圖為從2008年以來,因急性上呼吸道感染而健保就醫的人數變化趨勢。
load("graphData_homework3_011.Rda")
c('時間(年週)','人次','週次')->names(graphData[[1]])
c('xstart','xend','ymax')->names(graphData[[2]])
c('xstart','xend','ymax')->names(graphData[[3]])
## ----graph, echo=T, eval=T-----------------------------------------------
graphData$InfectedPeople%>%
ggplot()+
geom_line(
aes(x=週次,y=人次)
)+
geom_rect(
data = graphData$Rect_high,
mapping = aes(
xmin=xstart,
xmax=xend,
ymin=(-Inf),
ymax=ymax
),alpha=0.25,fill="red"
)+
theme(aspect.ratio = 1/4)+
labs(
title = "因急性上呼吸道感染之健保就診人次",
caption = "資料來源:疾病管制署資料開放平台網"
)+
scale_x_continuous(name = "時間" , breaks=XBreakDecWeek,labels = xLabel)+
scale_y_continuous(name = "人次(萬)", breaks = YBreakPeople,labels=YLabel)+
theme(axis.text.x = element_text(angle = 30,hjust = 0.97))+
geom_rect(
data = graphData$Rect_Low,
mapping = aes(
xmin=xstart,
xmax=xend,
ymin=(-Inf),
ymax=ymax
),alpha=0.4
)
圖為從2008年以來,因急性上呼吸道感染而健保就醫的人數變化趨勢。
我們可以看到圖形呈現週期性變化,一般而言,就醫高峰落在每年的12月
到隔年3月
,人數因每年而異,落在60萬到80萬以上。
而就醫低峰大約落在每年的6月
到9月
,每年都不超過40萬人次。
說明了每年夏季
(就醫低峰)的就醫人數變化不大
;而冬季
(就醫高峰)的就醫人數變化較大
,約為夏季的1.5倍至2倍以上。
【012】此圖107學年度調查台北大學大學生對於交往時間與性行為發生時間的認知差異,輔助線上的點是個人認知和對

load("graphData_homework3_012.Rda")
c('你個人認為交往多長時間可以發生性行為?','你認為大學生交往多長時間願意發生性行為?','總人數百分比','交往經驗比','交往經驗','人數')->names(graphData[[1]])
## ----graph, echo=T, eval=T-----------------------------------------------
graphData$myth_of_love %>%
ggplot(
aes(x=`你個人認為交往多長時間可以發生性行為?`,
y=`你認為大學生交往多長時間願意發生性行為?`,
size = 總人數百分比,
alpha = 交往經驗比)
)+
geom_point() +
scale_size_area(
max_size = 10
) +
scale_y_discrete(
"認為普遍大學生交往多久願意發生性行為",
limits = c("交往前(曖昧期)","半年內","一年內",
"一年以上","無論多久都不行")
) +
scale_x_discrete(
"個人認為交往多久可以發生性行為",
limits = c("交往前(曖昧期)","半年內","一年內",
"一年以上","無論多久都不行")
) +
geom_abline(intercept = 0,slope = 1,linetype="dashed",
alpha = 0.3,size = 1) +
labs(title = "大學生交往與性行為發生時間認知差異",
caption = "資料來源: 我大一社會學報告問卷",
subtitle="對群體認知v.s個人認知") +
theme(
plot.title = element_text(size = 18, hjust = 0.5),
plot.caption = element_text(size = 10,
color = "#6D6D6D"),
plot.subtitle = element_text(size = 10),
legend.position = "none",
aspect.ratio = 1/1.3
) +
annotate(
"text",x=5,y=1,size=3,
label = paste("認為他人願意發生\n性行為時間較自己早")
) +
annotate(
"text",x=1.3,y=5,size=3,
label = paste("認為自己願意發生\n性行為時間較他人早")
) -> finalplot
finalplot
此圖107學年度調查台北大學大學生對於交往時間與性行為發生時間的認知差異,輔助線上的點是個人認知和對群體認知相同的狀況,以點的大小表示人數、深淺代表該點的樣本中有交往經驗者的百分比。
可以發現大多數人自我認知中大學生願意發生性行為的時間較自己早,但若從是否有交往經驗的角度來看反而是無交往經驗者較傾向自己願意發生性行為的時間較他人晚,或者可以說無交往經驗者普遍認為自己在整個大學生群體中對於性行為是相對保守的。
【013】原始資料為民國103年,不同領域的工作者“上網”通報於職災網路系統的統計數據,分成不同身體部位計數。

library(ggforce)
load("graphData_homework3_013.Rda")
c('受傷部位','工作領域','受傷部位次數')->names(graphData[[1]])
## ----graph, echo=T, eval=T-----------------------------------------------
graphData$data %>% ggplot(
aes(x= as.numeric(受傷部位),y=受傷部位次數,fill=工作領域)
)+geom_col(
position = "dodge",width=0.5,
)+labs(
x = "受傷部位", y = "",
title="各領域職業災害之受傷部位統計",
caption ="資料來源:政府資料開放平台"
# tag="單位: 次"
) + facet_zoom(
y = 受傷部位 %in% c("內臟"), horizontal = T, xlim = c(0.67, 1.35),zoom.size=0.4,show.area = T
)+ scale_x_continuous(
breaks = 1:length(levels(graphData$data$受傷部位)),
label = levels(graphData$data$受傷部位),
)+
theme_bw()+
theme(
axis.ticks.x = element_line(size = 0),
axis.title.x = element_text(vjust=-1),
plot.title = element_text(hjust = 0.4,vjust=-0.2),
legend.position="bottom",
plot.caption =element_text(hjust=0.99,vjust =+165 ),
# panel.grid.minor = element_blank()
)
# plot.tag =element_text(hjust=-60,vjust = -4)
# annotation_custom(grob = grid::textGrob("單位: 次"),xmin = 3, xmax = 3, ymin = 5200, ymax = 5200)
# annotate("text", x = 0.8, y = 500, label = "單位: 次")
# scale palete theme(
# panel.grid.minor = element_blank(), #remove the grid of legend
# plot.caption = element_text(hjust = +1), #plot.=element_text(.just=) 移動位子
# plot.title = element_text(hjust =-0.05))
*資料整理: 原始資料為民國103年,不同領域的工作者“上網”通報於職災網路系統的統計數據,分成不同身體部位計數。
原址資料其受傷害的身體部位,分類共有二十三種,在此分成“內臟”、“身體(頭部以下)”,以及“頭頸”,主要是因為四肢及身體受傷的發生情況相似,而頭頸及內臟較不容易從其工作環境判別。
原始資料雖然沒有提到身體部位受傷的程度,但從經驗及現實角度來看,通報職災訊息往往要經過繁雜的行政程序,再加上傷者可能迫於主管單位的壓力下自行處理,所以大致上除了情節嚴重者外,其他輕傷往往會被忽略而沒有上報系統,導致資料沒有辦法完全呈現該行業的受傷狀況。 但我們仍可以預期,就算只是情節較嚴重的職災,服務業及金融保險不動產,這類需要付出勞力較低的工作者,發生職業傷害的頻率仍會低於第一、二級產業,而第三級產業又會高於金融保險業,在此可從圖型看出,差異確實存在。
【014】圖為台灣2017年至2018年前五大發生火災原因,可以看出下面幾件事情
load("graphData_homework3_014.Rda")
c('年份','原因','件數')-> names(graphData[[1]])
## ----graph, echo=T, eval=T-----------------------------------------------
graphData$fire %>%
ggplot()+
geom_col(
aes(x=reorder(原因,件數,order=T),y=件數,fill=年份),position="dodge")+
scale_fill_manual(
name="年份",values = c("#FFA488","#E63F00"))+
theme(
axis.text.x=element_text(angle=20,hjust = 0.8,size=8),plot.title=element_text(size=18,face="bold",color = "#E63F00"))+
labs(
x="起火原因",title="2017到2018火災前五原因",caption = "資料來源: 中華民國統計資料網")+
annotate("text", x = 1, y = 3500,
label = paste("+5%"), size = 3)+
annotate("text", x = 2, y = 4000,
label = paste("-17%"), size = 3)+
annotate("text", x = 3, y = 5000,
label = paste("-13%"), size = 3)+
annotate("text", x = 4, y = 5500,
label = paste("-2%"), size = 3)+
annotate("text", x = 5, y = 8000,
label = paste("+9%"), size = 3)+
annotate("text", x = 6, y = 32000,
label = paste("-8%"), size = 3)
傳達訊息:
圖為台灣2017年至2018年前五大發生火災原因,可以看出下面幾件事情: 一、2018年比2017年總件數減少。 二、菸蒂及遺留火種件數卻增加。
設計理念:
資料類型跟火災有關,故顏色選擇橘紅色系。 資料來源有數十個類別,但有些數量占比小,因此選出前五名做比較。
【015】此圖為106年國營事業的獲利情形,可看出中央銀行遙遙領先其他國營企業,而唯一虧損的企業是台灣鐵路管理
load("graphData_homework3_015.Rda")
c('主管機關','事業名稱','年度','netprofit','淨利.損.預算數.億元.','繳庫盈餘.億元.','占所有事業繳庫百分比...','繳庫盈餘預算數.億元.','繳庫盈餘達成率...')->names(graphData[[1]])
## ----graph, echo=T, eval=T-----------------------------------------------
library(gghighlight)
graphData$publicenterprisenetprofit %>%
ggplot(aes(x=事業名稱,y=netprofit))+
geom_bar(position="dodge",stat = "identity", fill="red")+
xlab("事業名稱")+
ylab("淨利(損)(億元)")+
gghighlight(事業名稱 == "臺灣鐵路管理局")+coord_flip()+
labs(title ="106年國營事業獲利情形",caption="資料來源:政府資料開放平臺")->finalplot
finalplot
此圖為106年國營事業的獲利情形,可看出中央銀行遙遙領先其他國營企業,而唯一虧損的企業是台灣鐵路管理局。
為了讓閱圖者一目瞭然,選擇用barchart並按照獲利多寡來排序,而在106年的資料中,只有臺鐵是虧損的狀況,所以特地將它標示出來。
【016】股市與全球重大事件息息相關,2008年的金融海嘯導致全球股市投資信心下跌,由此圖可以看到在2008年
load("graphData_homework3_016.Rda")
c('時間','指數名稱','指數')->names(graphData[[1]])
c('start','end','ymin','ymax','name')->names(graphData[[2]])
## ----graph, echo=T, eval=T-----------------------------------------------
graphData$data %>%
ggplot()+
geom_line(
aes(x=時間,y=指數,color=指數名稱)
)+
labs(x="時間",
y="指數",
title="金融指數與金融危機之對應關係")+
scale_x_date(limits = c(ymd("2008-01-01"),NA))+
geom_rect(
data= graphData$events,
mapping = aes(
xmin=start,
xmax=end,
ymin=ymin,
ymax=ymax
),
inherit.aes = FALSE,alpha=0.2
)+
geom_text(
data= graphData$events,
aes(
x=start,
y=25000,
label=name
),
inherit.aes = FALSE,size=4
)
股市與全球重大事件息息相關,2008年的金融海嘯導致全球股市投資信心下跌,由此圖可以看到在2008年中開始了股價指數跳水的狀況。 而2016年,據我們推測是因為英國脫歐事件,使得全球股市呈現一段上漲的波段。 而我們取用這兩種指數是根據IMF全球經濟展望報告(1998)中,對金融事件所推薦的指標。
【017】在此圖中可以非常明顯看出在臺北大學圖書館中,被借閱最多的書籍類別為語言文學類。
load("graphData_homework3_017.Rda")
c('書籍類別','讀者年級','借閱冊數')->names(graphData[[1]])
## ----graph, echo=T, eval=T-----------------------------------------------
library(grDevices) # 不同顏色模型代碼的呈現及轉換
library(scales) # show_col()螢幕立即顯示顏色
library(colorspace) # 調色盤選擇及ggplot應用工具
library(shinyjs) # 支援套件
#choose_palette(gui="shiny")
colorspace::sequential_hcl(n = 15, h = 260, c = c(80, NA, NA), l = c(20, 90), power = 1.5, register = "Custom-Palette")
graphData$libraryArrange %>%
ggplot() +
geom_tile(aes(x=讀者年級,y=書籍類別,fill=借閱冊數)) +
scale_fill_continuous_sequential(palette = "Custom-Palette") +
labs(title = "國立臺北大學圖書館借閱比較",
subtitle = "依書籍類別及讀者年級(2011-2013入學)",
caption = "資料來源:國立臺北大學圖書館") +
theme(plot.background = element_rect(fill="#EEC9CB", colour = "black"))
在此圖中可以非常明顯看出在臺北大學圖書館中,被借閱最多的書籍類別為語言文學類。而在此類別中,又以大三的人借最多(約11000本)。此圖將借閱數量高達一萬本以上的類別以特別鮮艷的藍色表示,以凸顯其數量。
其次,在語言文學類之下的則是社會科學類,其值可看出約落在5000-7500之間。其中也是以大三、大四的借閱量最多。
而其他類別的書籍則都落在5000之下,因為並未想要凸顯5000以下的書籍借閱量,因此在顏色上較不明顯,不過依然可以些微看出大部分借書的高峰年級大約皆落在三年級或四年級的時候。或許是因為作業需要或者是由於課堂時數較少,較有時間閱讀其他書籍。但推測以作業需要佔大多數。
【018】從圖中可以看出登革熱確定病例人數最高出現在高雄市,時間是2019年6月。第二高仍出現在高雄市,時間是
load("graphData_homework3_018.Rda")
c('年月','居住縣市','人數')->names(graphData[[1]])
## ----graph, echo=T, eval=T-----------------------------------------------
library(scales)
library(colorspace)
library(shiny)
library(shinyjs)
colorspace::sequential_hcl(n = 8, h = c(0, 35), c = c(65, 100, 5), l = c(20, 97), power = c(0.05, 1.45), register = "Palette4")
graphData$Dengue_Daily_last12m_1%>%
ggplot()+
geom_raster(aes(x=年月,y=居住縣市,fill=人數,hjust=1,vjust=10))+
scale_fill_continuous_sequential(palette = "Palette4",breaks=c(1,5,10,15,20,25,30))+
theme(axis.text.x = element_text(angle = 45,hjust = 1),
plot.background = element_rect(fill = "#F1F1F1",colour="black",size = 1),
legend.box.background = element_rect(),
legend.box.margin = margin(6,6,6,6))+
coord_flip()+
labs(title = "登革熱近12個月每月確定病例人數",
caption= "資料來源: 臺灣政府資料開放平臺")->finalplot
finalplot
從圖中可以看出登革熱確定病例人數最高出現在高雄市,時間是2019年6月。第二高仍出現在高雄市,時間是2019年7月。第三高則是出現在台中市,時間是2018年10月。 分別從X軸跟Y軸去看,X軸可以看出台中市、台北市、台南市、桃園市、高雄市、新北市為主要登革熱病例發生處,大多集中在都市;Y軸可以看出登革熱的疫情大多集中在6月到11月(集中夏季到秋季)。由此可以看出人口越密集,天氣較悶熱潮濕時,登革熱疫情較為嚴重。
【019】此圖為107學年度我國經濟學系學士人數,由圖可知,全台共有17所學校有經濟學系,其中學士人數最多的是
load("graphData_homework3_019.Rda")
c('學校代碼','學校名稱','科系代碼','科系名稱','日間∕進修別','等級別','學生數','教師數','上學年度畢業生數','縣市名稱','體系別')->names(graphData[[1]])
c('科系名稱','學校名稱','日間∕進修別','學生數','等級別','教師數')->names(graphData[[2]])
## ----graph---------------------------------------------------------------
library(grDevices) # 不同顏色模型代碼的呈現及轉換
library(scales) # show_col()螢幕立即顯示顏色
library(colorspace) # 調色盤選擇及ggplot應用工具
library(shinyjs) # 支援套件
colorspace::sequential_hcl(n = 3, h = c(-4, 80), c = c(100, NA, 47), l = c(55, 96), power = c(1, NA), rev = TRUE, register = "Custom-Palette")
graphData$dayschool %>%
ggplot()+
geom_col(aes(x=reorder(學校名稱,`學生數`,order=T),y=學生數,fill=(教師數),width=0.5))+
scale_fill_discrete_sequential(
palette="Custom-Palette")+
geom_text(
aes(
x=reorder(學校名稱,`學生數`,order=T),y=學生數+70,label=round(學生數)
),color="green", size = 3)+
labs(y="學士人數",x="有經濟系的學校(17所)",title="(107)我國經濟學系學士人數")+
coord_flip()+
geom_hline(aes(y=學生數,width=0.5,yintercept=400),linetype="dotted",color="red")
此圖為107學年度我國經濟學系學士人數,由圖可知,全台共有17所學校有經濟學系,其中學士人數最多的是東吳大學,教師數最多的學校則視國立台灣大學,另外,透過輔助線可以知道大約一半以上的學校超過400人,而國立台北大學的學士人數為492人,教師人數為中等數量。此外,從圖中的顏色由淺至深的變化,可以了解學士數量大概和教師數量呈正比。