QA1to5_example.R
jinbo
2021-05-17
#### 各種題型的r code範例
# Q1: 用長條圖繪製兩個類別變數的關係
# Q2: 用折線圖繪製三個變數(兩個類別變數、一個連續變數)的關係
# Q3: 用長條圖繪製兩個類別變數的關係(其中一個類別變數為複選題)
# Q4: 用長條圖繪製兩個變數(一個類別變數、一個連續變數)的關係
# Q5: 用長條圖繪製一個類別變數的頻率次數(以複選題為例)
# 偵測與處理，讓65+熟齡族告別假新聞危害
# http://www.crctaiwan.nctu.edu.tw/epaper/%E7%AC%AC202%E6%9C%9F20210409.htm
# RQ1:遇到假新聞的經驗，是否有年齡層的差異存在呢？
## 1. 輸入資料：將輸入的sav檔案命名為tcs2019
# install.packages("sjlabelled")
library(sjlabelled)
library(haven) ##
## Attaching package: 'haven'## The following objects are masked from 'package:sjlabelled':
##
## as_factor, read_sas, read_spss, read_stata, write_sas, zap_labelstcs2019 <- read_spss("tcs2019.sav")
# # 2. 檢視資料框的各種函數
# # 得知每個變數的描述性統計量
# summary(tcs2019)
# # 得知資料框複合式的資訊
# # (含資料結構種類、觀察值個數、變數個數、前幾筆觀察值資訊等)
# str(tcs2019)
# # 當資料較大時，建議使用sjPlot套件
# # install.packages("sjPlot")
# library(sjPlot)
# view_df(tcs2019,
# file="tcs2019tab.html", # 結果直接另存新檔
# show.na = T, # 顯示未重新編碼前的無效值個數
# show.frq = T, # 顯示次數
# show.prc = T, # 顯示百分比
# encoding = "big5"
# )
## 3. 應用實作
# (1)確認欲分析的變數
# 年齡層 agegroup #有序的類別變數
# 是否有遇到過假新聞? i12.1 #無序的類別變數
# (2)變數整理
# 年齡「變數重新分類」為4類：18-35,36-49,50-64,65UP
tcs2019$agegroup <- cut(tcs2019$ra2, breaks = c(17,35,49,64,Inf),
labels = c("18至35歲", "36至49歲","50至64歲","65歲以上"))
# 製作次數分配表
# install.packages("sjmisc")
library(sjmisc)
frq(tcs2019$agegroup, encoding = "big-5", out="v")| val | label | frq | raw.prc | valid.prc | cum.prc | |
|---|---|---|---|---|---|---|
|
18 |
|
343 | 17.15 | 17.15 | 17.15 | |
|
36 |
|
534 | 26.70 | 26.70 | 43.85 | |
|
50 |
|
583 | 29.15 | 29.15 | 73.00 | |
| 65甇脖誑銝<8a> |
|
540 | 27.00 | 27.00 | 100.00 | |
| NA | NA | 0 | 0.00 | NA | NA | |
| total N=2000 · valid N=2000 · x̄=2.66 · σ=1.05 | ||||||
### (3)回答RQ
## 製表
# install.packages("sjPlot")
library(sjPlot)## Warning: package 'sjPlot' was built under R version 4.0.5sjt.xtab(tcs2019$i12.1,tcs2019$agegroup,encoding = "utf-8",
show.cell.prc = T,show.row.prc = T,show.col.prc = T)|
I12-1.雿<81> |
agegroup | Total | |||
|---|---|---|---|---|---|
|
18 |
36 |
50 |
65甇脖誑銝<8a> | ||
|
|
304 20.7 % 88.6 % 15.2 % |
426 29 % 79.8 % 21.3 % |
429 29.2 % 73.6 % 21.4 % |
309 21 % 57.2 % 15.4 % |
1468 100 % 73.4 % 73.3 % |
|
敺 |
32 7.9 % 9.3 % 1.6 % |
87 21.5 % 16.3 % 4.3 % |
116 28.6 % 19.9 % 5.8 % |
170 42 % 31.5 % 8.5 % |
405 100 % 20.2 % 20.2 % |
|
銝 |
7 5.5 % 2 % 0.4 % |
21 16.5 % 3.9 % 1 % |
38 29.9 % 6.5 % 1.9 % |
61 48 % 11.3 % 3 % |
127 100 % 6.3 % 6.3 % |
| Total |
343 17.1 % 100 % 17.1 % |
534 26.7 % 100 % 26.7 % |
583 29.1 % 100 % 29.1 % |
540 27 % 100 % 27 % |
2000 100 % 100 % 100 % |
χ2=126.835 · df=6 · Cramer’s V=0.178 · p=0.000 |
## 製圖
# 1. 變數處理
# (1) 將要繪製的變數變成類別變數或先進行排序
class(tcs2019$i12.1)## [1] "haven_labelled" "vctrs_vctr" "double"class(tcs2019$agegroup)## [1] "factor"tcs2019$i12.1 <- as.factor(tcs2019$i12.1)
# tcs2019$agegroup <- factor(tcs2019$agegroup, ordered = TRUE,
# levels = c("65歲以上", "50至64歲","36至49歲","18至35歲"))
# 2. 安裝並載入 ggplot2
# install.packages("ggplot2")
# 載入 ggplot2
library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.0.5# 解決Rstudio cloud圖形中文顯示問題
# install.packages("showtext")
library(showtext)## Loading required package: sysfonts## Loading required package: showtextdbshowtext_auto()
# 3. 以圖層疊加的方式繪圖
## 請依據上述參數，自行繪製「台灣民眾各年齡層遇到假新聞的經驗比較」一圖
## 基本要求：
# 1. 要有主標題、x,y軸名稱及刻度名稱
# 2. 要有圖例說明
# 3. 圖上須注記作者姓名及資料來源
# 堆疊的長條圖
ggplot(tcs2019,aes(x=agegroup, fill=i12.1))+
geom_bar()+ #+geom_bar()預設為+geom_bar(position="stack")
geom_text(stat="count",aes(label=..count..),
position = position_stack(vjust = 0.5),size=2)+
labs(title = "台灣民眾各年齡層遇到假新聞的經驗比較",
x="各年齡層",y="次數",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.1))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
scale_fill_manual(name="接觸經驗",
values=c("1"="yellow", "2"="rosybrown2", "3"="steelblue1"),
labels=c("有遇到過假新聞", "從未遇過假新聞", "不知道是否遇過假新聞"))
# 標準化的長條圖
library(plyr)## Warning: package 'plyr' was built under R version 4.0.5ess2 = ddply(tcs2019,.(agegroup),function(.){
res = prop.table(table(factor(.$i12.1)))
res2 = table(factor(.$i12.1))
data.frame(lab=names(res), y=c(res),yy =c(res2))
})
ggplot(ess2,aes(x = agegroup,y=y,fill = lab))+
geom_bar(stat = "identity")+
geom_text(mapping = aes(label = sprintf("%.2f%%",y*100)),
size = 3, colour = 'black', vjust = 2, hjust = .5, position = position_stack())+
labs(title = "台灣民眾各年齡層遇到假新聞的經驗比較",
x="各年齡層",y="比例",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
scale_y_continuous(breaks = c(0,0.25,0.5,0.75,1) ,labels =c("0%","25%","50%","75%","100%"))+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
coord_flip()+
scale_fill_manual(name="接觸經驗",values=c("1"="yellow", "2"="rosybrown2", "3"="steelblue1"),
labels=c("有遇到過假新聞", "從未遇過假新聞", "不知道是否遇過假新聞"))
# 並排的長條圖
ggplot(tcs2019,
aes(agegroup, fill=i12.1))+
geom_bar(position = "dodge")+
labs(title = "台灣民眾各年齡層遇到假新聞的經驗比較",
x="各年齡層",y="次數",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
scale_fill_manual(name="接觸經驗",
values=c("1"="yellow", "2"="rosybrown2", "3"="steelblue1"),
labels=c("有遇到過假新聞", "從未遇過假新聞", "不知道是否遇過假新聞"))+
geom_text(stat="count",aes(label=..count..),size=3,
position = position_dodge(width = 1))
# 不同年齡層各繪製一張直方圖
ggplot(tcs2019,aes(x=i12.1, fill=agegroup))+geom_bar()+ #+geom_bar()預設為+geom_bar(position="stack")
facet_grid(.~agegroup)+
labs(title = "台灣民眾各年齡層遇到假新聞的經驗比較",
x="接觸假新聞經驗",y="次數",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
geom_text(stat="count",aes(label=..count..),
position = position_stack(vjust = 1),
size = 3)+
scale_x_discrete("是否接觸假新聞",labels = c("1" = "有","2" = "無",
"3" = "不知道"))+
scale_fill_manual("年齡層",values=c("lightskyblue1", "rosybrown2", "steelblue1","tomato1"))
### 說明：
# 1. 本語法可透過繪製長條圖，了解兩個類別變項間的關係(如本例為接觸假新聞經驗的類型、不同年齡層)
# 2. 可結合次數分配表與繪圖結果，進行結果的說明(目前課程未涉及統計觀念)
# 解釋範例如下：
# RQ1:遇到假新聞的經驗，是否有年齡層的差異存在呢？
# 根據2019年的調查資料（N = 2,000）顯示：
# 65+熟齡族和其他民眾在是否遇過假新聞的經驗上，確實有明顯差異，尤以18至35歲與65+熟齡族的差距最為明顯。
# 如圖一和表一所示，18至35歲的年齡層當中，有88.6%的人表示有遇到過假新聞，
# 36至49歲及50至64歲的年齡層當中，分別有79.8%及73.6%的人表示有遇到過假新聞，
# 然而，65+熟齡族的人僅有57.2%的人表示有遇到過假新聞，由此可見，
# 台灣人在不同年齡層中，認為自己有遇到過假新聞的比例均是超過半數的，而年齡層愈高，認為自己有遇到過假新聞的比例愈低。
# 此外，相對於其他年齡層(包含18至35歲、36至49歲、50至64歲)認為自己從未遇過假新聞、或是不知道是否遇過假新聞的經驗占比均低於一成，
# 65+熟齡族認為自己從未遇過假新聞、或是不知道是否遇過假新聞的占比為最高，分別為31.5%及11.3%，
# 因此，在認為自己從未遇過假新聞、或是不知道是否遇過假新聞的經驗上，均發現當年齡層愈高，比例愈高的現象。
# 偵測與處理，讓65+熟齡族告別假新聞危害
# http://www.crctaiwan.nctu.edu.tw/epaper/%E7%AC%AC202%E6%9C%9F20210409.htm
### RQ2:對假新聞的感受，是否有年齡層的差異存在呢？
## 1. 輸入資料：將輸入的sav檔案命名為tcs2019
# install.packages("sjlabelled")
library(sjlabelled)
library(haven)
tcs2019 <- read_spss("tcs2019.sav")
# # 2. 檢視資料框的各種函數
# # 得知每個變數的描述性統計量
# summary(tcs2019)
# # 得知資料框複合式的資訊
# # (含資料結構種類、觀察值個數、變數個數、前幾筆觀察值資訊等)
# str(tcs2019)
# # 當資料較大時，建議使用sjPlot套件
# # install.packages("sjPlot")
# library(sjPlot)
# view_df(tcs2019,
# file="tcs2019tab.html", # 結果直接另存新檔
# show.na = T, # 顯示未重新編碼前的無效值個數
# show.frq = T, # 顯示次數
# show.prc = T, # 顯示百分比
# encoding = "big5"
# )
## 3. 應用實作
# (1)確認欲分析的變數
# 年齡層 agegroup #有序的類別變數
# 對假新聞的感受:
# 普遍性 i7a #連續變數
# 嚴重性 i7b #連續變數
# 受影響的可能性 i7c #連續變數
# (2)變數整理
# a.年齡「變數重新分類」為4類：18-35,36-49,50-64,65UP
tcs2019$agegroup <- cut(tcs2019$ra2, breaks = c(17,35,49,64,Inf),
labels = c("18至35歲", "36至49歲","50至64歲","65歲以上"))
# 製作次數分配表
# install.packages("sjmisc")
library(sjmisc)
frq(tcs2019$agegroup, encoding = "big-5", out="v")| val | label | frq | raw.prc | valid.prc | cum.prc | |
|---|---|---|---|---|---|---|
|
18 |
|
343 | 17.15 | 17.15 | 17.15 | |
|
36 |
|
534 | 26.70 | 26.70 | 43.85 | |
|
50 |
|
583 | 29.15 | 29.15 | 73.00 | |
| 65甇脖誑銝<8a> |
|
540 | 27.00 | 27.00 | 100.00 | |
| NA | NA | 0 | 0.00 | NA | NA | |
| total N=2000 · valid N=2000 · x̄=2.66 · σ=1.05 | ||||||
# b.對假新聞的感受
# 先檢視變數(可用table函數，或是直接看tcs2019tab.html)
table(tcs2019$i7a)##
## 1 2 3 4 5 97 98
## 18 178 444 771 452 134 3table(tcs2019$i7b)##
## 1 2 3 4 5 97 98
## 15 124 393 882 484 99 3table(tcs2019$i7c)##
## 1 2 3 4 5 97 98
## 147 878 291 558 69 56 1# 發現此三個變數，均有選項不知道(97)、拒答(98)
# 因此，先將tcs2019資料中的選項不知道(97)、拒答(98)設為無效值(NA)，並將該變數排除無效值
library(sjmisc)
tcs2019 <- set_na(tcs2019, na=c(97:98, "NA"))
### (3)回答RQ
## 製表
# install.packages("sjPlot")
library(sjPlot)
sjt.xtab(tcs2019$i7a,tcs2019$agegroup,encoding = "utf-8",show.cell.prc = T,
show.row.prc = T,
show.col.prc = T)|
I7a.雿死敺<81> |
agegroup | Total | |||
|---|---|---|---|---|---|
|
18 |
36 |
50 |
65甇脖誑銝<8a> | ||
|
|
3 16.7 % 0.9 % 0.2 % |
3 16.7 % 0.6 % 0.2 % |
4 22.2 % 0.7 % 0.2 % |
8 44.4 % 1.8 % 0.4 % |
18 100 % 1 % 1 % |
|
銝 |
13 7.3 % 3.8 % 0.7 % |
37 20.8 % 7 % 2 % |
60 33.7 % 10.8 % 3.2 % |
68 38.2 % 15.4 % 3.7 % |
178 100 % 9.6 % 9.6 % |
|
|
72 16.2 % 21 % 3.9 % |
151 34 % 28.8 % 8.1 % |
126 28.4 % 22.8 % 6.8 % |
95 21.4 % 21.5 % 5.1 % |
444 100 % 23.8 % 23.9 % |
|
|
143 18.5 % 41.7 % 7.7 % |
206 26.7 % 39.2 % 11.1 % |
238 30.9 % 43 % 12.8 % |
184 23.9 % 41.6 % 9.9 % |
771 100 % 41.4 % 41.5 % |
|
|
112 24.8 % 32.7 % 6 % |
128 28.3 % 24.4 % 6.9 % |
125 27.7 % 22.6 % 6.7 % |
87 19.2 % 19.7 % 4.7 % |
452 100 % 24.3 % 24.3 % |
| Total |
343 18.4 % 100 % 18.4 % |
525 28.2 % 100 % 28.2 % |
553 29.7 % 100 % 29.7 % |
442 23.7 % 100 % 23.7 % |
1863 100 % 100 % 100 % |
χ2=59.700 · df=12 · Cramer’s V=0.103 · Fisher’s p=0.000 |
sjt.xtab(tcs2019$i7b,tcs2019$agegroup,encoding = "utf-8",show.cell.prc = T,
show.row.prc = T,
show.col.prc = T)|
I7b.雿死敺<81> |
agegroup | Total | |||
|---|---|---|---|---|---|
|
18 |
36 |
50 |
65甇脖誑銝<8a> | ||
|
|
1 6.7 % 0.3 % 0.1 % |
3 20 % 0.6 % 0.2 % |
5 33.3 % 0.9 % 0.3 % |
6 40 % 1.3 % 0.3 % |
15 100 % 0.8 % 0.9 % |
|
銝 |
9 7.3 % 2.6 % 0.5 % |
30 24.2 % 5.6 % 1.6 % |
44 35.5 % 7.8 % 2.3 % |
41 33.1 % 8.9 % 2.2 % |
124 100 % 6.5 % 6.6 % |
|
|
49 12.5 % 14.3 % 2.6 % |
126 32.1 % 23.7 % 6.6 % |
113 28.8 % 20.1 % 6 % |
105 26.7 % 22.8 % 5.5 % |
393 100 % 20.7 % 20.7 % |
|
|
166 18.8 % 48.4 % 8.7 % |
247 28 % 46.5 % 13 % |
256 29 % 45.5 % 13.5 % |
213 24.1 % 46.2 % 11.2 % |
882 100 % 46.5 % 46.4 % |
|
|
118 24.4 % 34.4 % 6.2 % |
125 25.8 % 23.5 % 6.6 % |
145 30 % 25.8 % 7.6 % |
96 19.8 % 20.8 % 5.1 % |
484 100 % 25.5 % 25.5 % |
| Total |
343 18.1 % 100 % 18.1 % |
531 28 % 100 % 28 % |
563 29.7 % 100 % 29.7 % |
461 24.3 % 100 % 24.3 % |
1898 100 % 100 % 100 % |
χ2=43.083 · df=12 · Cramer’s V=0.087 · Fisher’s p=0.000 |
sjt.xtab(tcs2019$i7c,tcs2019$agegroup,encoding = "utf-8",show.cell.prc = T,
show.row.prc = T,
show.col.prc = T)|
I7c.雿死敺 |
agegroup | Total | |||
|---|---|---|---|---|---|
|
18 |
36 |
50 |
65甇脖誑銝<8a> | ||
|
|
14 9.5 % 4.1 % 0.7 % |
35 23.8 % 6.6 % 1.8 % |
46 31.3 % 8 % 2.4 % |
52 35.4 % 10.5 % 2.7 % |
147 100 % 7.6 % 7.6 % |
|
銝 |
76 8.7 % 22.2 % 3.9 % |
188 21.4 % 35.3 % 9.7 % |
295 33.6 % 51.4 % 15.2 % |
319 36.3 % 64.7 % 16.4 % |
878 100 % 45.2 % 45.2 % |
|
|
65 22.3 % 19 % 3.3 % |
104 35.7 % 19.5 % 5.4 % |
73 25.1 % 12.7 % 3.8 % |
49 16.8 % 9.9 % 2.5 % |
291 100 % 15 % 15 % |
|
|
156 28 % 45.5 % 8 % |
183 32.8 % 34.3 % 9.4 % |
148 26.5 % 25.8 % 7.6 % |
71 12.7 % 14.4 % 3.7 % |
558 100 % 28.7 % 28.7 % |
|
|
32 46.4 % 9.3 % 1.6 % |
23 33.3 % 4.3 % 1.2 % |
12 17.4 % 2.1 % 0.6 % |
2 2.9 % 0.4 % 0.1 % |
69 100 % 3.6 % 3.5 % |
| Total |
343 17.7 % 100 % 17.7 % |
533 27.4 % 100 % 27.4 % |
574 29.5 % 100 % 29.5 % |
493 25.4 % 100 % 25.4 % |
1943 100 % 100 % 100 % |
χ2=258.340 · df=12 · Cramer’s V=0.211 · p=0.000 |
## 製圖
# 1. 變數處理
# (1) 將要繪製的連續變數轉換成各類別變數的平均數
# 使用dplyr套件
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:plyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize## The following object is masked from 'package:sjlabelled':
##
## as_label## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, uniondf1 <- tcs2019 %>%
group_by(agegroup) %>%
summarise(feel = mean(i7a, na.rm=T))
df2 <- tcs2019 %>%
group_by(agegroup) %>%
summarise(feel = mean(i7b, na.rm=T))
df3 <- tcs2019 %>%
group_by(agegroup) %>%
summarise(feel = mean(i7c, na.rm=T))
View(df1)
# (2) 透過垂直合併，重建一個繪圖用的資料框
df <- rbind(df1,df2,df3)
df$type <- c((rep(1, times=4)),(rep(2, times=4)),(rep(3, times=4)))
df$type <- as.factor(df$type)
str(df)## tibble [12 x 3] (S3: tbl_df/tbl/data.frame)
## $ agegroup: Factor w/ 4 levels "18至35歲","36至49歲",..: 1 2 3 4 1 2 3 4 1 2 ...
## $ feel : num [1:12] 4.01 3.8 3.76 3.62 4.14 ...
## $ type : Factor w/ 3 levels "1","2","3": 1 1 1 1 2 2 2 2 3 3 ...# 2. 安裝並載入 ggplot2
# install.packages("ggplot2")
# 載入 ggplot2
library(ggplot2)
# 解決Rstudio cloud圖形中文顯示問題
# install.packages("showtext")
library(showtext)
showtext_auto()
# 3. 以圖層疊加的方式繪圖
## 請依據上述參數，自行繪製「台灣民眾各年齡層遇到假新聞的經驗比較」一圖
## 基本要求：
# 1. 要有主標題、x,y軸名稱及刻度名稱
# 2. 要有圖例說明
# 3. 圖上須注記作者姓名及資料來源
## 請依據上述參數，自行繪製「台灣民眾各年齡層對假新聞感受之比較」一圖
## 基本要求：
# 1. 要有主標題、x,y軸名稱及刻度名稱
# 2. 要有圖例說明
# 3. 圖上須注記作者姓名及資料來源
# 折線圖
library(ggrepel)## Warning: package 'ggrepel' was built under R version 4.0.5library(RColorBrewer)
g1 <- ggplot(df,
aes(x=type, y=feel,color=agegroup, group=agegroup))+
geom_line()+
geom_point()+
labs(title = "台灣民眾各年齡層對假新聞感受之比較",
x="對假新聞的感受",y="程度",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫",
colour = "年齡層")+
theme_classic()+
ylim(1, 5)+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
scale_x_discrete("對假新聞的感受",labels = c("1" = "假新聞普遍性","2" = "假新聞嚴重性",
"3" = "受假新聞影響的可能性"))+
theme(legend.position="bottom")+
geom_text_repel(aes(label=round(feel, digits = 2)),
size = 3, color = "black")+
scale_colour_brewer(palette = "Set2")+
theme(plot.title = element_text(vjust = 2,hjust = 0.5))
g1 
# 不同年齡層各繪製一張折線圖
library(RColorBrewer)
g1 <- ggplot(df,
aes(x=type, y=feel,color=agegroup, group=agegroup))+
geom_line()+
geom_point()+
facet_grid(.~agegroup)+
labs(title = "台灣民眾各年齡層對假新聞感受之比較",
x="對假新聞的感受",y="程度",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫",
colour = "年齡層")+
theme_classic()+
ylim(1, 5)+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
scale_x_discrete("對假新聞的感受",labels = c("1" = "普遍性","2" = "嚴重性",
"3" = "可能受影響"))+
theme(legend.position="bottom")+
scale_colour_brewer(palette = "Set2")+
theme(plot.title = element_text(vjust = 2,hjust = 0.5))+
theme(axis.text.x = element_text(vjust = 0.7, angle=25))+
geom_text(stat="identity",aes(label=round(feel, digits = 2)),
size = 3, color = "black",vjust = -1)
g1 
### 說明：
# 1. 本語法可透過繪製折線圖，了解兩個類別變項及1個連續變項間的關係(如本例為不同感受類型、不同年齡層、感受程度)
# 2. 可結合次數分配表與繪圖結果，進行結果的說明(目前課程未涉及統計觀念)
# 解釋範例如下：
# RQ2:對假新聞的感受，是否有年齡層的差異存在呢？
# 2019年的調查中從三個面向（普遍性、嚴重性以及受影響的可能性）來詢問民眾對假新聞的感受，
# 根據三個面向的次數分配表與圖二可知，
# 在18至35歲民眾當中，有32.7%的人認為假新聞的狀況非常普遍，
# 34.45%的人認為假新聞的問題非常嚴重，同時，有9.3%的人表示非常可能受假新聞的影響，
# 反觀65+熟齡族則抱持著完全不同的感受，僅有19.7%的人認為假新聞的狀況非常普遍，
# 20.8%的人認為假新聞的問題非常嚴重，同時，僅有0.4%的人表示非常可能受假新聞的影響，
# 整體而言，隨著年齡的增長，認為假新聞的普遍性、嚴重性、及自己可能受影響的程度都隨之下降，
# 除了18至35歲的民眾，約有五成四的人認為會受到假新聞的影響之外，
# 其他年齡層的民眾都覺得自己不太會受到假新聞的影響，占比均低於五成，
# 36至49歲、50至64歲及65歲+熟齡族的比例分別為38.6%、27.9%、14.8%。
# 由此可知，年紀輕的民眾對於假新聞的警戒程度相對比年紀長的民眾來得高。
# 偵測與處理，讓65+熟齡族告別假新聞危害
# http://www.crctaiwan.nctu.edu.tw/epaper/%E7%AC%AC202%E6%9C%9F20210409.htm
### RQ3:對假新聞的確認與處理方式等，是否有年齡層的差異存在呢？
## 1. 輸入資料：將輸入的sav檔案命名為tcs2019
# install.packages("sjlabelled")
library(sjlabelled)
library(haven)
tcs2019 <- read_spss("tcs2019.sav")
# # 2. 檢視資料框的各種函數
# # 得知每個變數的描述性統計量
# summary(tcs2019)
# # 得知資料框複合式的資訊
# # (含資料結構種類、觀察值個數、變數個數、前幾筆觀察值資訊等)
# str(tcs2019)
# # 當資料較大時，建議使用sjPlot套件
# # install.packages("sjPlot")
# library(sjPlot)
# view_df(tcs2019,
# file="tcs2019tab.html", # 結果直接另存新檔
# show.na = T, # 顯示未重新編碼前的無效值個數
# show.frq = T, # 顯示次數
# show.prc = T, # 顯示百分比
# encoding = "big5"
# )
## 3. 應用實作
# (1)確認欲分析的變數
# 年齡層 agegroup #有序的類別變數
# 確認你接觸到的新聞是不是假新聞? i11.1-i11.8 #須整合為一個變數
# 遇到假新聞,你會如何處理? i12.2.1-i12.2.8 #須整合為一個變數
# (2)變數整理
# a.年齡「變數重新分類」為4類：18-35,36-49,50-64,65UP
tcs2019$agegroup <- cut(tcs2019$ra2, breaks = c(17,35,49,64,Inf),
labels = c("18至35歲", "36至49歲","50至64歲","65歲以上"))
# 製作次數分配表
# install.packages("sjmisc")
library(sjmisc)
frq(tcs2019$agegroup, encoding = "big-5", out="v")| val | label | frq | raw.prc | valid.prc | cum.prc | |
|---|---|---|---|---|---|---|
|
18 |
|
343 | 17.15 | 17.15 | 17.15 | |
|
36 |
|
534 | 26.70 | 26.70 | 43.85 | |
|
50 |
|
583 | 29.15 | 29.15 | 73.00 | |
| 65甇脖誑銝<8a> |
|
540 | 27.00 | 27.00 | 100.00 | |
| NA | NA | 0 | 0.00 | NA | NA | |
| total N=2000 · valid N=2000 · x̄=2.66 · σ=1.05 | ||||||
# b.確認你接觸到的新聞是不是假新聞? i11.1-i11.8
### 複選題處理方式：
# 1. 先篩選出年齡層、確認假新聞方式的相關題項
names(tcs2019)## [1] "id" "type" "a1" "a2" "a3" "a3.a"
## [7] "a4" "a5.1" "a6" "a6.a" "a7" "a7.a"
## [13] "a8" "a8.a" "a9" "a9.a" "b1" "b2a"
## [19] "b3a" "b3b" "b3c" "b3d" "b3e" "b3f"
## [25] "b4.1.a.1" "b4.1.a.2" "b4.1.b.1" "b4.1.b.2" "b4.2.a.1" "b4.2.a.2"
## [31] "b4.2.b.1" "b4.2.b.2" "b4.3.a.1" "b4.3.a.2" "b4.3.b.1" "b4.3.b.2"
## [37] "c1a" "c1b.1" "c1b.2" "c1c.1" "c1c.2" "c1c.3"
## [43] "c1c.4" "c1c.5" "c1c.6" "c1c.7" "c1c.13" "c1c.12"
## [49] "c1c.36" "c1c.10" "c1c.14" "c1c.17" "c1c.11" "c1c.15"
## [55] "c1c.19" "c1c.41" "c1c.42" "c1c.43" "c1c.28" "c1c.35"
## [61] "c1c.16" "c1c.20" "c1c.21" "c1c.22" "c1c.26" "c1c.30"
## [67] "c1c.31" "c1c.32" "c1c.33" "c1c.34" "c1c.37" "c1c.38"
## [73] "c1c.40" "c1c.44" "c1c.88" "c1c.a" "c3a" "c3b.1"
## [79] "c3b.2" "c3c.24" "c3c.28" "c3c.21" "c3c.26" "c3c.6"
## [85] "c3c.1" "c3c.2" "c3c.4" "c3c.5" "c3c.18" "c3c.8"
## [91] "c3c.17" "c3c.19" "c3c.9" "c3c.23" "c3c.16" "c3c.13"
## [97] "c3c.22" "c3c.11" "c3c.15" "c3c.14" "c3c.20" "c3c.12"
## [103] "c3c.10" "c3c.25" "c3c.27" "c3c.7" "c3c.29" "c3c.30"
## [109] "c3c.32" "c3c.33" "c3c.34" "c3c.35" "c3c.36" "c3c.37"
## [115] "c3c.38" "c3c.39" "c3c.40" "c3c.41" "c3c.42" "c3c.43"
## [121] "c3c.44" "c3c.45" "c3c.46" "c3c.47" "c3c.48" "c3c.49"
## [127] "c3c.50" "c3c.51" "c3c.52" "c3c.53" "c3c.54" "c3c.55"
## [133] "c3c.56" "c3c.57" "c3c.58" "c3c.59" "c3c.60" "c3c.61"
## [139] "c3c.88" "c3c.a" "d1a" "d1b.1" "d1b.2" "d2a"
## [145] "d2b.1" "d2b.2" "e1" "e2.1" "e2.2" "f1"
## [151] "f2.1" "f2.2" "f3" "f4.1" "f4.2" "f5"
## [157] "f6.1" "f6.2" "f7" "f7.a" "g1" "g2.1"
## [163] "g2.2" "g3.1" "g3.2" "g3.3" "g3.4" "g3.5"
## [169] "g3.6" "g3.7" "g3.8" "g3.9" "g3.10" "g3.11"
## [175] "g3.12" "g3.13" "g3.14" "g3.15" "g3.16" "g3.17"
## [181] "g3.18" "g3.19" "g3.20" "g3.21" "g3.22" "g3.23"
## [187] "g3.24" "g3.25" "g3.26" "g3.27" "g3.28" "g3.29"
## [193] "g3.30" "g3.31" "g3.32" "g3.33" "g3.34" "g3.35"
## [199] "g3.36" "g3.88" "g3.a" "g4.1" "g4.1.a" "g4.2"
## [205] "g4.2.a" "g5.0.1" "g5.0.2" "g5.0.3" "g5.0.4" "g5.0.5"
## [211] "g5.0.6" "g5.0.7" "g5.0.8" "g5.0.9" "g5.0.10" "g5.0.11"
## [217] "g5.0.12" "g5.0.13" "g5.0.14" "g5.0.15" "g5.0.88" "g5.0.a"
## [223] "g5.5" "g5.6" "g5.7" "g5.8" "g5.9" "g5.10"
## [229] "g5.11" "g5.12" "g5.14" "h1" "h2" "h3"
## [235] "h4.1.a.1" "h4.1.a.2" "h4.1.b.1" "h4.1.b.2" "h4.2.a.1" "h4.2.a.2"
## [241] "h4.2.b.1" "h4.2.b.2" "h4.3.a.1" "h4.3.a.2" "h4.3.b.1" "h4.3.b.2"
## [247] "h5.1" "h5.2" "h5.3" "h5.4" "h5.5" "h5.6"
## [253] "h5.7" "h5.8" "ha1" "ha2" "ha3a.1" "ha3a.2"
## [259] "ha3a.3" "ha3a.4" "ha3a.5" "ha3a.6" "ha3a.7" "ha3a.99"
## [265] "ha3b.1" "ha3b.2" "ha3b.3" "ha3b.4" "ha3b.5" "ha3b.6"
## [271] "ha3b.7" "ha3b.99" "ha4" "ha5a.1" "ha5a.2" "ha5a.3"
## [277] "ha5a.4" "ha5a.5" "ha5a.6" "ha5a.99" "ha5b.1" "ha5b.2"
## [283] "ha5b.3" "ha5b.4" "ha5b.5" "ha5b.6" "ha5b.99" "ha5c.1"
## [289] "ha5c.2" "ha5c.3" "ha5c.4" "ha5c.5" "ha5c.6" "ha5c.99"
## [295] "ha6.1" "ha6.2" "ha6.3" "ha6.4" "ha6.5" "ha6.6"
## [301] "ha6.7" "ha6.99" "ha7.1" "ha7.2" "ha7.3" "ha7.4"
## [307] "ha7.5" "ha7.6" "ha7.7" "ha7.99" "i1" "i1.a"
## [313] "i2" "i2.a" "i3" "i3.a" "i4.1" "i4.2"
## [319] "i4.3" "i4.4" "i4.5" "i5a.1" "i5a.2" "i5a.3"
## [325] "i5a.4" "i5a.5" "i5a.6" "i5a.7" "i5a.8" "i5a.9"
## [331] "i5a.10" "i5a.88" "i5a.a" "i5a.90" "i5b.1" "i5b.2"
## [337] "i5b.3" "i5b.4" "i5b.5" "i5b.6" "i5b.88" "i5b.a"
## [343] "i5b.90" "i6.1" "i6.2" "i6.3" "i6.4" "i6.5"
## [349] "i6.90" "i7a" "i7b" "i7c" "i8.1" "i8.2"
## [355] "i8.3" "i8.4" "i8.5" "i8.6" "i8.7" "i8.8"
## [361] "i8.88" "i8.a" "i9.1.1" "i9.1.2" "i9.1.3" "i9.1.4"
## [367] "i9.1.5" "i9.1.6" "i9.1.7" "i9.1.8" "i9.1.9" "i9.1.10"
## [373] "i9.1.88" "i9.1.a" "i9.2.1" "i9.2.2" "i9.2.3" "i9.2.4"
## [379] "i9.2.5" "i9.2.6" "i9.2.7" "i9.2.8" "i9.2.88" "i9.2.a"
## [385] "i10.1" "i10.2" "i10.3" "i10.4" "i10.5" "i10.6"
## [391] "i10.7" "i10.8" "i10.88" "i10.a" "i11.1" "i11.2"
## [397] "i11.3" "i11.4" "i11.5" "i11.6" "i11.7" "i11.8"
## [403] "i11.88" "i11.a" "i12.1" "i12.2.1" "i12.2.2" "i12.2.3"
## [409] "i12.2.4" "i12.2.5" "i12.2.6" "i12.2.7" "i12.2.8" "i12.2.88"
## [415] "i12.2.a" "n1.1" "n1.2" "n1.3" "n1.4" "n1.5"
## [421] "n1.6" "n1.7" "n1.8" "n1.9" "n1.10" "n2.1"
## [427] "n2.2" "n2.3" "n2.4" "n2.5" "n2.6" "n2.7"
## [433] "n2.8" "n2.9" "n2.10" "n2.11" "n2.12" "n2.13"
## [439] "n2.14" "j1a" "j1b.1" "j1b.2" "j1c.1" "j1c.2"
## [445] "j1c.3" "j1c.4" "j1c.5" "j1c.6" "j1c.8" "j1c.9"
## [451] "j1c.10" "j1c.11" "j1c.12" "j1c.13" "j1c.88" "j1c.a"
## [457] "j2.1" "j2.2" "j2.3" "j2.4" "j2.5" "j2.6"
## [463] "j2.7" "j2.8" "j2.9" "k1" "k2.1" "k2.2"
## [469] "k3.1" "k3.3" "k3.4" "k3.6" "k3.7" "k3.8"
## [475] "k3.88" "k3.a" "k4.1" "k4.2" "k4.3" "k4.4"
## [481] "k4.5" "k4.6" "k4.7" "k4.8" "k4.9" "k4.10"
## [487] "k4.11" "k4.12" "k4.13" "k4.14" "k4.15" "k4.88"
## [493] "k4.a" "k5.1" "k5.2" "k5.3" "k5.4" "k5.5"
## [499] "k5.6" "k6.1" "k6.2" "k6.3" "k6.4" "k7"
## [505] "k9.1" "k9.2" "k9.3" "k9.4" "k9.5" "k10"
## [511] "k11.1" "k11.2" "k11.3" "k11.4" "k11.5" "k12"
## [517] "k13" "k14" "k15.1" "k15.2" "k15.3" "k15.4"
## [523] "k15.5" "k15.6" "k15.7" "k15.88" "k15.a" "k16.1"
## [529] "k16.2" "l1a" "l1b" "l3a" "l3b" "l5.1"
## [535] "l5.2" "l6" "l7" "l8" "l9a" "l9b.1"
## [541] "l9b.2" "l9b.3" "l9b.4" "l10a" "l10b.1" "l10b.2"
## [547] "l10b.3" "l10b.4" "l11a" "l11b.1" "l11b.2" "l11b.3"
## [553] "l11b.4" "l12" "l13" "l14" "l14.a" "l15"
## [559] "m1.1" "m1.2" "m1.3" "m1.4" "m1.5" "m1.6"
## [565] "m1.7" "m1.8" "m1.9" "m2a.1" "m2a.2" "m2a.3"
## [571] "m2a.4" "m2a.5" "m2a.6" "m2a.7" "m2a.8" "m2a.9"
## [577] "n3a.1" "n3a.2" "n3a.3" "n3a.4" "n3a.5" "n3b"
## [583] "n4" "n5" "n6" "n7" "n8a" "n8b"
## [589] "n9.1" "n9.2" "n9.3" "n9.4" "n10a" "n10b"
## [595] "n11a" "n11b" "o1" "o1.a" "o2" "o2.a"
## [601] "o3a" "o3a.a" "o3b" "o3b.a" "o4" "ra2"
## [607] "rra2" "rcity" "ra9" "rb3a" "rb3b" "rb3c"
## [613] "rb3e" "rb4.1.a" "rrb4.1.a" "rb4.1.b" "rrb4.1.b" "rb4.2.a"
## [619] "rrb4.2.a" "rb4.2.b" "rrb4.2.b" "rb4.3.a" "rrb4.3.a" "rb4.3.b"
## [625] "rrb4.3.b" "rc1b" "rrc1b" "rc3b" "rrc3b" "rd1b"
## [631] "rrd1b" "rd2b" "rrd2b" "re2" "rre2" "rf2"
## [637] "rrf2" "rf4" "rrf4" "rf6" "rrf6" "rg2"
## [643] "rrg2" "rh4.1.a" "rrh4.1.a" "rh4.1.b" "rrh4.1.b" "rh4.2.a"
## [649] "rrh4.2.a" "rh4.2.b" "rrh4.2.b" "rh4.3.a" "rrh4.3.a" "rh4.3.b"
## [655] "rrh4.3.b" "rh5.8" "ri4.1" "ri4.2" "ri4.3" "ri4.4"
## [661] "ri4.5" "rj1b" "rrj1b" "rk2" "rrk2" "rl6"
## [667] "rl7" "ro3b.a" "weight" "agegroup"DF <- data.frame(tcs2019[,c(670, 395:402)])
# 2. 需填補遺漏值為1
DF[is.na(DF)] <- 0
# 3. 透過tidyr套件中的gather將寬格式轉為長格式(詳見ch12)
# install.packages("tidyr")
library(tidyr)##
## Attaching package: 'tidyr'## The following object is masked from 'package:sjmisc':
##
## replace_naDF1 <- gather(DF, key = "identify", value = "count", i11.1,i11.2,i11.3,
i11.4,i11.5,i11.6,i11.7,i11.8)## Warning: attributes are not identical across measure variables;
## they will be dropped# 可以不必理會警告訊息
# 4. 篩選出count==1的資料框
DF2 <- subset(DF1, count==1)
# c.遇到假新聞,你會如何處理? i12.2.1-i12.2.8
### 複選題處理方式同上：
# 1. 先篩選出年齡層、確認假新聞方式的相關題項
names(tcs2019)## [1] "id" "type" "a1" "a2" "a3" "a3.a"
## [7] "a4" "a5.1" "a6" "a6.a" "a7" "a7.a"
## [13] "a8" "a8.a" "a9" "a9.a" "b1" "b2a"
## [19] "b3a" "b3b" "b3c" "b3d" "b3e" "b3f"
## [25] "b4.1.a.1" "b4.1.a.2" "b4.1.b.1" "b4.1.b.2" "b4.2.a.1" "b4.2.a.2"
## [31] "b4.2.b.1" "b4.2.b.2" "b4.3.a.1" "b4.3.a.2" "b4.3.b.1" "b4.3.b.2"
## [37] "c1a" "c1b.1" "c1b.2" "c1c.1" "c1c.2" "c1c.3"
## [43] "c1c.4" "c1c.5" "c1c.6" "c1c.7" "c1c.13" "c1c.12"
## [49] "c1c.36" "c1c.10" "c1c.14" "c1c.17" "c1c.11" "c1c.15"
## [55] "c1c.19" "c1c.41" "c1c.42" "c1c.43" "c1c.28" "c1c.35"
## [61] "c1c.16" "c1c.20" "c1c.21" "c1c.22" "c1c.26" "c1c.30"
## [67] "c1c.31" "c1c.32" "c1c.33" "c1c.34" "c1c.37" "c1c.38"
## [73] "c1c.40" "c1c.44" "c1c.88" "c1c.a" "c3a" "c3b.1"
## [79] "c3b.2" "c3c.24" "c3c.28" "c3c.21" "c3c.26" "c3c.6"
## [85] "c3c.1" "c3c.2" "c3c.4" "c3c.5" "c3c.18" "c3c.8"
## [91] "c3c.17" "c3c.19" "c3c.9" "c3c.23" "c3c.16" "c3c.13"
## [97] "c3c.22" "c3c.11" "c3c.15" "c3c.14" "c3c.20" "c3c.12"
## [103] "c3c.10" "c3c.25" "c3c.27" "c3c.7" "c3c.29" "c3c.30"
## [109] "c3c.32" "c3c.33" "c3c.34" "c3c.35" "c3c.36" "c3c.37"
## [115] "c3c.38" "c3c.39" "c3c.40" "c3c.41" "c3c.42" "c3c.43"
## [121] "c3c.44" "c3c.45" "c3c.46" "c3c.47" "c3c.48" "c3c.49"
## [127] "c3c.50" "c3c.51" "c3c.52" "c3c.53" "c3c.54" "c3c.55"
## [133] "c3c.56" "c3c.57" "c3c.58" "c3c.59" "c3c.60" "c3c.61"
## [139] "c3c.88" "c3c.a" "d1a" "d1b.1" "d1b.2" "d2a"
## [145] "d2b.1" "d2b.2" "e1" "e2.1" "e2.2" "f1"
## [151] "f2.1" "f2.2" "f3" "f4.1" "f4.2" "f5"
## [157] "f6.1" "f6.2" "f7" "f7.a" "g1" "g2.1"
## [163] "g2.2" "g3.1" "g3.2" "g3.3" "g3.4" "g3.5"
## [169] "g3.6" "g3.7" "g3.8" "g3.9" "g3.10" "g3.11"
## [175] "g3.12" "g3.13" "g3.14" "g3.15" "g3.16" "g3.17"
## [181] "g3.18" "g3.19" "g3.20" "g3.21" "g3.22" "g3.23"
## [187] "g3.24" "g3.25" "g3.26" "g3.27" "g3.28" "g3.29"
## [193] "g3.30" "g3.31" "g3.32" "g3.33" "g3.34" "g3.35"
## [199] "g3.36" "g3.88" "g3.a" "g4.1" "g4.1.a" "g4.2"
## [205] "g4.2.a" "g5.0.1" "g5.0.2" "g5.0.3" "g5.0.4" "g5.0.5"
## [211] "g5.0.6" "g5.0.7" "g5.0.8" "g5.0.9" "g5.0.10" "g5.0.11"
## [217] "g5.0.12" "g5.0.13" "g5.0.14" "g5.0.15" "g5.0.88" "g5.0.a"
## [223] "g5.5" "g5.6" "g5.7" "g5.8" "g5.9" "g5.10"
## [229] "g5.11" "g5.12" "g5.14" "h1" "h2" "h3"
## [235] "h4.1.a.1" "h4.1.a.2" "h4.1.b.1" "h4.1.b.2" "h4.2.a.1" "h4.2.a.2"
## [241] "h4.2.b.1" "h4.2.b.2" "h4.3.a.1" "h4.3.a.2" "h4.3.b.1" "h4.3.b.2"
## [247] "h5.1" "h5.2" "h5.3" "h5.4" "h5.5" "h5.6"
## [253] "h5.7" "h5.8" "ha1" "ha2" "ha3a.1" "ha3a.2"
## [259] "ha3a.3" "ha3a.4" "ha3a.5" "ha3a.6" "ha3a.7" "ha3a.99"
## [265] "ha3b.1" "ha3b.2" "ha3b.3" "ha3b.4" "ha3b.5" "ha3b.6"
## [271] "ha3b.7" "ha3b.99" "ha4" "ha5a.1" "ha5a.2" "ha5a.3"
## [277] "ha5a.4" "ha5a.5" "ha5a.6" "ha5a.99" "ha5b.1" "ha5b.2"
## [283] "ha5b.3" "ha5b.4" "ha5b.5" "ha5b.6" "ha5b.99" "ha5c.1"
## [289] "ha5c.2" "ha5c.3" "ha5c.4" "ha5c.5" "ha5c.6" "ha5c.99"
## [295] "ha6.1" "ha6.2" "ha6.3" "ha6.4" "ha6.5" "ha6.6"
## [301] "ha6.7" "ha6.99" "ha7.1" "ha7.2" "ha7.3" "ha7.4"
## [307] "ha7.5" "ha7.6" "ha7.7" "ha7.99" "i1" "i1.a"
## [313] "i2" "i2.a" "i3" "i3.a" "i4.1" "i4.2"
## [319] "i4.3" "i4.4" "i4.5" "i5a.1" "i5a.2" "i5a.3"
## [325] "i5a.4" "i5a.5" "i5a.6" "i5a.7" "i5a.8" "i5a.9"
## [331] "i5a.10" "i5a.88" "i5a.a" "i5a.90" "i5b.1" "i5b.2"
## [337] "i5b.3" "i5b.4" "i5b.5" "i5b.6" "i5b.88" "i5b.a"
## [343] "i5b.90" "i6.1" "i6.2" "i6.3" "i6.4" "i6.5"
## [349] "i6.90" "i7a" "i7b" "i7c" "i8.1" "i8.2"
## [355] "i8.3" "i8.4" "i8.5" "i8.6" "i8.7" "i8.8"
## [361] "i8.88" "i8.a" "i9.1.1" "i9.1.2" "i9.1.3" "i9.1.4"
## [367] "i9.1.5" "i9.1.6" "i9.1.7" "i9.1.8" "i9.1.9" "i9.1.10"
## [373] "i9.1.88" "i9.1.a" "i9.2.1" "i9.2.2" "i9.2.3" "i9.2.4"
## [379] "i9.2.5" "i9.2.6" "i9.2.7" "i9.2.8" "i9.2.88" "i9.2.a"
## [385] "i10.1" "i10.2" "i10.3" "i10.4" "i10.5" "i10.6"
## [391] "i10.7" "i10.8" "i10.88" "i10.a" "i11.1" "i11.2"
## [397] "i11.3" "i11.4" "i11.5" "i11.6" "i11.7" "i11.8"
## [403] "i11.88" "i11.a" "i12.1" "i12.2.1" "i12.2.2" "i12.2.3"
## [409] "i12.2.4" "i12.2.5" "i12.2.6" "i12.2.7" "i12.2.8" "i12.2.88"
## [415] "i12.2.a" "n1.1" "n1.2" "n1.3" "n1.4" "n1.5"
## [421] "n1.6" "n1.7" "n1.8" "n1.9" "n1.10" "n2.1"
## [427] "n2.2" "n2.3" "n2.4" "n2.5" "n2.6" "n2.7"
## [433] "n2.8" "n2.9" "n2.10" "n2.11" "n2.12" "n2.13"
## [439] "n2.14" "j1a" "j1b.1" "j1b.2" "j1c.1" "j1c.2"
## [445] "j1c.3" "j1c.4" "j1c.5" "j1c.6" "j1c.8" "j1c.9"
## [451] "j1c.10" "j1c.11" "j1c.12" "j1c.13" "j1c.88" "j1c.a"
## [457] "j2.1" "j2.2" "j2.3" "j2.4" "j2.5" "j2.6"
## [463] "j2.7" "j2.8" "j2.9" "k1" "k2.1" "k2.2"
## [469] "k3.1" "k3.3" "k3.4" "k3.6" "k3.7" "k3.8"
## [475] "k3.88" "k3.a" "k4.1" "k4.2" "k4.3" "k4.4"
## [481] "k4.5" "k4.6" "k4.7" "k4.8" "k4.9" "k4.10"
## [487] "k4.11" "k4.12" "k4.13" "k4.14" "k4.15" "k4.88"
## [493] "k4.a" "k5.1" "k5.2" "k5.3" "k5.4" "k5.5"
## [499] "k5.6" "k6.1" "k6.2" "k6.3" "k6.4" "k7"
## [505] "k9.1" "k9.2" "k9.3" "k9.4" "k9.5" "k10"
## [511] "k11.1" "k11.2" "k11.3" "k11.4" "k11.5" "k12"
## [517] "k13" "k14" "k15.1" "k15.2" "k15.3" "k15.4"
## [523] "k15.5" "k15.6" "k15.7" "k15.88" "k15.a" "k16.1"
## [529] "k16.2" "l1a" "l1b" "l3a" "l3b" "l5.1"
## [535] "l5.2" "l6" "l7" "l8" "l9a" "l9b.1"
## [541] "l9b.2" "l9b.3" "l9b.4" "l10a" "l10b.1" "l10b.2"
## [547] "l10b.3" "l10b.4" "l11a" "l11b.1" "l11b.2" "l11b.3"
## [553] "l11b.4" "l12" "l13" "l14" "l14.a" "l15"
## [559] "m1.1" "m1.2" "m1.3" "m1.4" "m1.5" "m1.6"
## [565] "m1.7" "m1.8" "m1.9" "m2a.1" "m2a.2" "m2a.3"
## [571] "m2a.4" "m2a.5" "m2a.6" "m2a.7" "m2a.8" "m2a.9"
## [577] "n3a.1" "n3a.2" "n3a.3" "n3a.4" "n3a.5" "n3b"
## [583] "n4" "n5" "n6" "n7" "n8a" "n8b"
## [589] "n9.1" "n9.2" "n9.3" "n9.4" "n10a" "n10b"
## [595] "n11a" "n11b" "o1" "o1.a" "o2" "o2.a"
## [601] "o3a" "o3a.a" "o3b" "o3b.a" "o4" "ra2"
## [607] "rra2" "rcity" "ra9" "rb3a" "rb3b" "rb3c"
## [613] "rb3e" "rb4.1.a" "rrb4.1.a" "rb4.1.b" "rrb4.1.b" "rb4.2.a"
## [619] "rrb4.2.a" "rb4.2.b" "rrb4.2.b" "rb4.3.a" "rrb4.3.a" "rb4.3.b"
## [625] "rrb4.3.b" "rc1b" "rrc1b" "rc3b" "rrc3b" "rd1b"
## [631] "rrd1b" "rd2b" "rrd2b" "re2" "rre2" "rf2"
## [637] "rrf2" "rf4" "rrf4" "rf6" "rrf6" "rg2"
## [643] "rrg2" "rh4.1.a" "rrh4.1.a" "rh4.1.b" "rrh4.1.b" "rh4.2.a"
## [649] "rrh4.2.a" "rh4.2.b" "rrh4.2.b" "rh4.3.a" "rrh4.3.a" "rh4.3.b"
## [655] "rrh4.3.b" "rh5.8" "ri4.1" "ri4.2" "ri4.3" "ri4.4"
## [661] "ri4.5" "rj1b" "rrj1b" "rk2" "rrk2" "rl6"
## [667] "rl7" "ro3b.a" "weight" "agegroup"df <- data.frame(tcs2019[,c(670, 406:413)])
# 2. 需填補遺漏值為1
df[is.na(df)] <- 0
# 3. 透過tidyr套件中的gather將寬格式轉為長格式(詳見ch12)
# install.packages("tidyr")
library(tidyr)
df1 <- gather(df, key = "cope", value = "count", i12.2.1,i12.2.2,i12.2.3,
i12.2.4,i12.2.5,i12.2.6,i12.2.7,i12.2.8)## Warning: attributes are not identical across measure variables;
## they will be dropped# 可以不必理會警告訊息
# 4. 篩選出count==1的資料框
df2 <- subset(df1, count==1)
### (3)回答RQ
## 製表
# install.packages("sjPlot")
library(sjPlot)
sjt.xtab(DF2$agegroup, DF2$identify,encoding = "big-5",
show.cell.prc = T,show.row.prc = T,show.col.prc = T)| agegroup | identify | Total | |||||||
|---|---|---|---|---|---|---|---|---|---|
| i11.1 | i11.2 | i11.3 | i11.4 | i11.5 | i11.6 | i11.7 | i11.8 | ||
| 18至35歲 |
233 19.5 % 16.5 % 4.3 % |
226 18.9 % 16.8 % 4.2 % |
156 13 % 22.3 % 2.9 % |
112 9.4 % 21.1 % 2.1 % |
147 12.3 % 43.8 % 2.7 % |
44 3.7 % 24 % 0.8 % |
167 14 % 32.6 % 3.1 % |
111 9.3 % 32.9 % 2.1 % |
1196 100 % 22.3 % 22.2 % |
| 36至49歲 |
378 24.1 % 26.7 % 7 % |
344 21.9 % 25.5 % 6.4 % |
184 11.7 % 26.3 % 3.4 % |
159 10.1 % 29.9 % 3 % |
117 7.5 % 34.8 % 2.2 % |
77 4.9 % 42.1 % 1.4 % |
188 12 % 36.6 % 3.5 % |
122 7.8 % 36.2 % 2.3 % |
1569 100 % 29.3 % 29.2 % |
| 50至64歲 |
424 28.8 % 29.9 % 7.9 % |
403 27.3 % 29.9 % 7.5 % |
198 13.4 % 28.3 % 3.7 % |
160 10.9 % 30.1 % 3 % |
49 3.3 % 14.6 % 0.9 % |
42 2.8 % 23 % 0.8 % |
120 8.1 % 23.4 % 2.2 % |
78 5.3 % 23.1 % 1.5 % |
1474 100 % 27.5 % 27.5 % |
| 65歲以上 |
381 33.9 % 26.9 % 7.1 % |
374 33.3 % 27.8 % 7 % |
161 14.3 % 23 % 3 % |
100 8.9 % 18.8 % 1.9 % |
23 2 % 6.8 % 0.4 % |
20 1.8 % 10.9 % 0.4 % |
38 3.4 % 7.4 % 0.7 % |
26 2.3 % 7.7 % 0.5 % |
1123 100 % 20.9 % 21 % |
| Total |
1416 26.4 % 100 % 26.4 % |
1347 25.1 % 100 % 25.1 % |
699 13 % 100 % 13 % |
531 9.9 % 100 % 9.9 % |
336 6.3 % 100 % 6.3 % |
183 3.4 % 100 % 3.4 % |
513 9.6 % 100 % 9.6 % |
337 6.3 % 100 % 6.3 % |
5362 100 % 100 % 100 % |
χ2=396.879 · df=21 · Cramer’s V=0.157 · p=0.000 |
sjt.xtab(df2$agegroup,df2$cope,encoding = "big-5",show.cell.prc = T,
show.row.prc = T,
show.col.prc = T)| agegroup | cope | Total | |||||||
|---|---|---|---|---|---|---|---|---|---|
| i12.2.1 | i12.2.2 | i12.2.3 | i12.2.4 | i12.2.5 | i12.2.6 | i12.2.7 | i12.2.8 | ||
| 18至35歲 |
121 17.4 % 15.6 % 3.7 % |
167 24.1 % 20.8 % 5.1 % |
105 15.1 % 20.9 % 3.2 % |
27 3.9 % 29.7 % 0.8 % |
37 5.3 % 21.4 % 1.1 % |
12 1.7 % 19.7 % 0.4 % |
128 18.4 % 22.4 % 3.9 % |
97 14 % 30.7 % 2.9 % |
694 100 % 21.1 % 21.1 % |
| 36至49歲 |
192 20.8 % 24.7 % 5.8 % |
221 24 % 27.6 % 6.7 % |
139 15.1 % 27.7 % 4.2 % |
36 3.9 % 39.6 % 1.1 % |
61 6.6 % 35.3 % 1.9 % |
17 1.8 % 27.9 % 0.5 % |
175 19 % 30.6 % 5.3 % |
80 8.7 % 25.3 % 2.4 % |
921 100 % 28 % 27.9 % |
| 50至64歲 |
251 25.1 % 32.3 % 7.6 % |
235 23.5 % 29.3 % 7.1 % |
157 15.7 % 31.3 % 4.8 % |
22 2.2 % 24.2 % 0.7 % |
55 5.5 % 31.8 % 1.7 % |
22 2.2 % 36.1 % 0.7 % |
181 18.1 % 31.7 % 5.5 % |
77 7.7 % 24.4 % 2.3 % |
1000 100 % 30.4 % 30.4 % |
| 65歲以上 |
214 31.5 % 27.5 % 6.5 % |
179 26.4 % 22.3 % 5.4 % |
101 14.9 % 20.1 % 3.1 % |
6 0.9 % 6.6 % 0.2 % |
20 2.9 % 11.6 % 0.6 % |
10 1.5 % 16.4 % 0.3 % |
87 12.8 % 15.2 % 2.6 % |
62 9.1 % 19.6 % 1.9 % |
679 100 % 20.6 % 20.6 % |
| Total |
778 23.6 % 100 % 23.6 % |
802 24.3 % 100 % 24.3 % |
502 15.2 % 100 % 15.2 % |
91 2.8 % 100 % 2.8 % |
173 5.3 % 100 % 5.3 % |
61 1.9 % 100 % 1.9 % |
571 17.3 % 100 % 17.3 % |
316 9.6 % 100 % 9.6 % |
3294 100 % 100 % 100 % |
χ2=92.639 · df=21 · Cramer’s V=0.097 · p=0.000 |
## 製圖
# 1. 變數處理
# (1) 將要繪製的變數變成類別變數或先進行排序
class(DF2$agegroup)## [1] "factor"class(DF2$identify)## [1] "character"DF2$identify <- as.factor(DF2$identify)
class(DF2$agegroup)## [1] "factor"class(df2$cope)## [1] "character"df2$cope <- as.factor(df2$cope)
# 2. 安裝並載入 ggplot2
# install.packages("ggplot2")
# 載入 ggplot2
library(ggplot2)
# 解決Rstudio cloud圖形中文顯示問題
# install.packages("showtext")
library(showtext)
showtext_auto()
# 3. 以圖層疊加的方式繪圖
### a. 請以長條圖繪製「台灣民眾各年齡層確認假新聞方式的比較」一圖
### 可自行選擇堆疊、標準化、並排或多張圖合併等4種長條圖
## 基本要求：
# 1. 要有主標題、x,y軸名稱及刻度名稱
# 2. 要有圖例說明
# 3. 圖上須注記作者姓名及資料來源
# 堆疊的長條圖
ggplot(DF2,
aes(identify, fill=agegroup))+
geom_bar()+
labs(title = "台灣民眾各年齡層確認假新聞方式的比較",
x="確認假新聞方式",y="次數",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
scale_x_discrete("確認假新聞方式",labels = c("i11.1" = "經驗判斷","i11.2" = "不輕信",
"i11.3" = "與親友討論", "i11.4" = "搜尋相關訊息",
"i11.5" = "聽專業判斷","i11.6" = "參考新聞留言",
"i11.7" = "搜尋澄清訊息", "i11.8" = "使用事實查核"))+
scale_fill_manual("年齡層",values=c("lightskyblue1", "rosybrown2", "steelblue1","tomato1"))+
geom_text(stat="count",aes(label=..count..),
position = position_stack(vjust = 0.5),size=3)
# 並排的長條圖 ##與電子報一致 #易懂
ggplot(DF2,
aes(identify, fill=agegroup))+
geom_bar(position = "dodge")+
labs(title = "台灣民眾各年齡層確認假新聞方式的比較",
x="確認假新聞方式",y="次數",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
geom_text(stat="count",aes(label=..count..),size=3,
position = position_dodge(width = 1))+
scale_x_discrete("確認假新聞方式",labels = c("i11.1" = "經驗判斷","i11.2" = "不輕信",
"i11.3" = "與親友討論", "i11.4" = "搜尋相關訊息",
"i11.5" = "聽專業判斷","i11.6" = "參考新聞留言",
"i11.7" = "搜尋澄清訊息", "i11.8" = "使用事實查核"))+
scale_fill_manual("年齡層",values=c("lightskyblue1", "rosybrown2", "steelblue1","tomato1"))
# 標準化的長條圖
library(plyr)
ess2 = ddply(DF2,.(identify),function(.){
res = prop.table(table(factor(.$agegroup)))
res2 = table(factor(.$agegroup))
data.frame(lab=names(res), y=c(res),yy =c(res2))
})
ggplot(ess2,aes(x = identify,y=y,fill = lab))+
geom_bar(stat = "identity")+
geom_text(mapping = aes(label = sprintf("%.2f%%",y*100)),
size = 3, colour = 'black', vjust = 2, hjust = .5, position = position_stack())+
labs(title = "台灣民眾各年齡層確認假新聞方式的比較",
x="確認假新聞方式",y="比例",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
scale_y_continuous(breaks = c(0,0.25,0.5,0.75,1) ,labels =c("0%","25%","50%","75%","100%"))+
scale_x_discrete("確認假新聞方式",labels = c("i11.1" = "經驗判斷","i11.2" = "不輕信",
"i11.3" = "與親友討論", "i11.4" = "搜尋相關訊息",
"i11.5" = "聽專業判斷","i11.6" = "參考新聞留言",
"i11.7" = "搜尋澄清訊息", "i11.8" = "使用事實查核"))+
scale_fill_manual("年齡層",values=c("lightskyblue1", "rosybrown2", "steelblue1","tomato1"))
# 不同年齡層各繪製一張直方圖
ggplot(DF2,aes(x=identify, fill=agegroup))+geom_bar()+ #+geom_bar()預設為+geom_bar(position="stack")
facet_grid(.~agegroup)+
labs(title = "台灣民眾各年齡層確認假新聞方式的比較",
x="確認假新聞方式",y="次數",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
geom_text(stat="count",aes(label=..count..),size=3,
position = position_dodge(width = 1))+
scale_x_discrete("確認假新聞方式",labels = c("i11.1" = "經驗判斷","i11.2" = "不輕信",
"i11.3" = "與親友討論", "i11.4" = "搜尋相關訊息",
"i11.5" = "聽專業判斷","i11.6" = "參考新聞留言",
"i11.7" = "搜尋澄清訊息", "i11.8" = "使用事實查核"))+
scale_fill_manual("年齡層",values=c("lightskyblue1", "rosybrown2", "steelblue1","tomato1"))+
theme(axis.text.x = element_text(vjust = 0.9,hjust = 1, angle=30))
### b. 請以長條圖繪製「台灣民眾各年齡層處理假新聞方式的比較」一圖
### 可自行選擇堆疊、標準化、並排或多張圖合併等4種長條圖
## 基本要求：
# 1. 要有主標題、x,y軸名稱及刻度名稱
# 2. 要有圖例說明
# 3. 圖上須注記作者姓名及資料來源
# 堆疊的長條圖
ggplot(df2,
aes(cope, fill=agegroup))+
geom_bar()+
labs(title = "台灣民眾各年齡層處理假新聞方式的比較",
x="確認假新聞方式",y="次數",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
scale_x_discrete("處理假新聞方式",labels = c("i12.2.1" = "不再看該新聞","i12.2.2" = "沒有任何處理",
"i12.2.3" = "提醒親友", "i12.2.4" = "不再看該來源",
"i12.2.5" = "與親友討論","i12.2.6" = "分享澄清文",
"i12.2.7" = "留言舉發", "i12.2.8" = "聯絡發布者刪除"))+
scale_fill_manual("年齡層",values=c("lightskyblue1", "rosybrown2", "steelblue1","tomato1"))+
geom_text(stat="count",aes(label=..count..),
position = position_stack(vjust = 0.5),size=3)
# 並排的長條圖 ##與電子報一致 #易懂
ggplot(df2,
aes(cope, fill=agegroup))+
geom_bar(position = "dodge")+
labs(title = "台灣民眾各年齡層處理假新聞方式的比較",
x="確認假新聞方式",y="次數",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
geom_text(stat="count",aes(label=..count..),size=3,
position = position_dodge(width = 1))+
scale_x_discrete("處理假新聞方式",labels = c("i12.2.1" = "不再看該新聞","i12.2.2" = "沒有任何處理",
"i12.2.3" = "提醒親友", "i12.2.4" = "不再看該來源",
"i12.2.5" = "與親友討論","i12.2.6" = "分享澄清文",
"i12.2.7" = "留言舉發", "i12.2.8" = "聯絡發布者刪除"))+
scale_fill_manual("年齡層",values=c("lightskyblue1", "rosybrown2", "steelblue1","tomato1"))
# 標準化的長條圖
library(plyr)
ess2 = ddply(df2,.(cope),function(.){
res = prop.table(table(factor(.$agegroup)))
res2 = table(factor(.$agegroup))
data.frame(lab=names(res), y=c(res),yy =c(res2))
})
ggplot(ess2,aes(x = cope,y=y,fill = lab))+
geom_bar(stat = "identity")+
geom_text(mapping = aes(label = sprintf("%.2f%%",y*100)),
size = 3, colour = 'black', vjust = 2, hjust = .5, position = position_stack())+
labs(title = "台灣民眾各年齡層處理假新聞方式的比較",
x="確認假新聞方式",y="比例",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
scale_y_continuous(breaks = c(0,0.25,0.5,0.75,1) ,labels =c("0%","25%","50%","75%","100%"))+
scale_x_discrete("處理假新聞方式",labels = c("i12.2.1" = "不再看該新聞","i12.2.2" = "沒有任何處理",
"i12.2.3" = "提醒親友", "i12.2.4" = "不再看該來源",
"i12.2.5" = "與親友討論","i12.2.6" = "分享澄清文",
"i12.2.7" = "留言舉發", "i12.2.8" = "聯絡發布者刪除"))+
scale_fill_manual("年齡層",values=c("lightskyblue1", "rosybrown2", "steelblue1","tomato1"))
# 不同年齡層各繪製一張直方圖
ggplot(df2,aes(x=cope, fill=agegroup))+geom_bar()+ #+geom_bar()預設為+geom_bar(position="stack")
facet_grid(.~agegroup)+
labs(title = "台灣民眾各年齡層處理假新聞方式的比較",
x="確認假新聞方式",y="次數",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
geom_text(stat="count",aes(label=..count..),size=3,
position = position_dodge(width = 1))+
scale_x_discrete("處理假新聞方式",labels = c("i12.2.1" = "不再看該新聞","i12.2.2" = "沒有任何處理",
"i12.2.3" = "提醒親友", "i12.2.4" = "不再看該來源",
"i12.2.5" = "與親友討論","i12.2.6" = "分享澄清文",
"i12.2.7" = "留言舉發", "i12.2.8" = "聯絡發布者刪除"))+
scale_fill_manual("年齡層",values=c("lightskyblue1", "rosybrown2", "steelblue1","tomato1"))+
theme(axis.text.x = element_text(vjust = 0.9,hjust = 1, angle=30))
### 說明：
# 1. 本語法可透過繪製長條圖，了解兩個類別變項間的關係(如本例為不同年齡層、確認假新聞的方式)
# 2. 可結合次數分配表與繪圖結果，進行結果的說明(目前課程未涉及統計觀念)
# 解釋範例如下：
# RQ3:對假新聞的判斷和處理，是否有年齡層的差異存在呢？
# 2019年的調查中，詢問不同年齡層民眾如何確認假新聞與如何處置假新聞。
# 從分析結果與圖三可看出台灣民眾在確認假新聞的方式上，
# 最多人會以「依自己的知識經驗來判斷」或「不會輕易相信，保持觀望」為主，
# 分別佔整體民眾的26.4%及25.1%，
# 除此之外，民眾也會採取多樣的方式來判斷假新聞，
# 例如：與親朋好友討論(13%)、搜尋相關訊息(9.9%)、聽取專業人士判斷(6.3%)、
# 參考新聞下方留言(3.4%)、搜尋澄清資訊(9.6%)、使用事實查核機制(6.3%)等。
# 但根據調查結果得知，65+熟齡族相較於其他年齡層的民眾比較少會採用多樣化的方式來辨別假新聞，
# 仍停留在相信自己的知識經驗或保持觀望的狀態，
# 其中，36至49歲民眾相對於其他年齡層而言，
# 最常參考新聞留言、搜尋澄清訊息與使用事實查核等積極的方式來確認假新聞，
# 分別所有年齡層的42.1%、36.6%及36.2%。
# 整體而言，年紀愈輕，愈多人會使用各種不同的方法來反覆確認訊息真偽。
#
# 同時，在遇到假新聞以後，各個年齡層的處理方式也不盡相同（如圖四所示）。
# 根據資料顯示：
# 整體而言，所有民眾對於假新聞的處理多採取比較消極的處理方式，
# 有將近5成的民眾已不再看該則新聞(23.6%)和沒有任何處置作為(24.3%)來因應，
# 尤其是65+熟齡族最為明顯，有高達57.9%的民眾表示不再看及不處置。
# 而資料也發現通常是年輕族群較容易採取積極的方式來處置假新聞。
# 例如，18至35歲是所有年齡層中最常聯絡發布者刪除該則貼文(佔30.7%)，
# 36至49歲是所有年齡層當中，最常使用不再看該來源的新聞(39.6%)及與親友討論(35.3%)兩種方式來處置假新聞，
# 而50至64歲則是所有年齡層中，最常採用留言舉發(31.7%)的積極方式處理假新聞。
# 推論65+熟齡族也許是因為對於網路的使用還不甚熟悉，對於假新聞的處理多採取比較消極的處理方式。
# RQ4: 台灣各年齡層對假新聞普遍性的感受有何差異?
# 使用變項：各年齡層(類別變項)、對假新聞普遍性的感受(連續變項)
# 將連續變項變成平均數來進行比較
## 1. 輸入資料：將輸入的sav檔案命名為tcs2019
# install.packages("sjlabelled")
library(sjlabelled)
library(haven)
tcs2019 <- read_spss("tcs2019.sav")
## 2. 變數處理
## (1)年齡「變數重新分類」為4類：18-35,36-49,50-64,65UP
# 備註：break的值(x,y,z)是指: group1 >x & <=y; group2 >y & <=z
tcs2019$agegroup <- cut(tcs2019$ra2, breaks = c(17,35,49,64,Inf),
labels = c("18至35歲", "36至49歲","50至64歲","65歲以上"))
ncol(tcs2019)## [1] 670# 檢視各類別有多少人?
table(tcs2019$agegroup)##
## 18至35歲 36至49歲 50至64歲 65歲以上
## 343 534 583 540# 另一種方法：製作次數分配表
# install.packages("sjmisc")
library(sjmisc)
frq(tcs2019$agegroup, encoding = "big-5", out="v")| val | label | frq | raw.prc | valid.prc | cum.prc | |
|---|---|---|---|---|---|---|
|
18 |
|
343 | 17.15 | 17.15 | 17.15 | |
|
36 |
|
534 | 26.70 | 26.70 | 43.85 | |
|
50 |
|
583 | 29.15 | 29.15 | 73.00 | |
| 65甇脖誑銝<8a> |
|
540 | 27.00 | 27.00 | 100.00 | |
| NA | NA | 0 | 0.00 | NA | NA | |
| total N=2000 · valid N=2000 · x̄=2.66 · σ=1.05 | ||||||
## (2)對假新聞普遍性的感受程度(i7a)
## 將要繪製的連續變數轉換成各類別變數的平均數
# a.檢視i7a變項的次數表
library(sjmisc)
frq(tcs2019$i7a, encoding = "big-5", out="v")| val | label | frq | raw.prc | valid.prc | cum.prc | |
|---|---|---|---|---|---|---|
| 1 |
|
18 | 0.90 | 0.90 | 0.90 | |
| 2 |
|
178 | 8.90 | 8.90 | 9.80 | |
| 3 |
|
444 | 22.20 | 22.20 | 32.00 | |
| 4 |
|
771 | 38.55 | 38.55 | 70.55 | |
| 5 |
|
452 | 22.60 | 22.60 | 93.15 | |
| 97 |
|
134 | 6.70 | 6.70 | 99.85 | |
| 98 |
|
3 | 0.15 | 0.15 | 100.00 | |
| NA | NA | 0 | 0.00 | NA | NA | |
| total N=2000 · valid N=2000 · x̄=10.17 · σ=23.58 | ||||||
# b.將97不知道、98拒答設為遺漏值NA
library(sjmisc)
tcs2019 <- set_na(tcs2019, na=c(97:98, "NA"))
# c.檢視年齡層與i7a變項的交叉表
library(sjPlot)
sjt.xtab(tcs2019$i7a,tcs2019$agegroup,encoding = "utf-8",show.cell.prc = T,
show.row.prc = T,
show.col.prc = T)|
I7a.雿死敺<81> |
agegroup | Total | |||
|---|---|---|---|---|---|
|
18 |
36 |
50 |
65甇脖誑銝<8a> | ||
|
|
3 16.7 % 0.9 % 0.2 % |
3 16.7 % 0.6 % 0.2 % |
4 22.2 % 0.7 % 0.2 % |
8 44.4 % 1.8 % 0.4 % |
18 100 % 1 % 1 % |
|
銝 |
13 7.3 % 3.8 % 0.7 % |
37 20.8 % 7 % 2 % |
60 33.7 % 10.8 % 3.2 % |
68 38.2 % 15.4 % 3.7 % |
178 100 % 9.6 % 9.6 % |
|
|
72 16.2 % 21 % 3.9 % |
151 34 % 28.8 % 8.1 % |
126 28.4 % 22.8 % 6.8 % |
95 21.4 % 21.5 % 5.1 % |
444 100 % 23.8 % 23.9 % |
|
|
143 18.5 % 41.7 % 7.7 % |
206 26.7 % 39.2 % 11.1 % |
238 30.9 % 43 % 12.8 % |
184 23.9 % 41.6 % 9.9 % |
771 100 % 41.4 % 41.5 % |
|
|
112 24.8 % 32.7 % 6 % |
128 28.3 % 24.4 % 6.9 % |
125 27.7 % 22.6 % 6.7 % |
87 19.2 % 19.7 % 4.7 % |
452 100 % 24.3 % 24.3 % |
| Total |
343 18.4 % 100 % 18.4 % |
525 28.2 % 100 % 28.2 % |
553 29.7 % 100 % 29.7 % |
442 23.7 % 100 % 23.7 % |
1863 100 % 100 % 100 % |
χ2=59.700 · df=12 · Cramer’s V=0.103 · Fisher’s p=0.000 |
# d.使用dplyr套件的summarise函數另建一個新的資料框df1
# df1包含平均數、標準差、最小值、最大值、個數
library(dplyr)
df1 <- tcs2019 %>%
group_by(agegroup) %>%
summarise(feel = mean(i7a, na.rm=T), sd = sd(i7a, na.rm=T),
min = min(i7a, na.rm=T), max= max(i7a, na.rm=T),
n = n())
View(df1)
## 3. 製圖
# 載入 ggplot2
library(ggplot2)
# 解決Rstudio cloud圖形中文顯示問題
# install.packages("showtext")
library(showtext)
showtext_auto()
ggplot(df1,aes(x=agegroup, y=feel))+
geom_bar(stat = "identity", fill="#5A99B3",width=0.5)+
#stat = "identity" 強調y等同於feel變數，不須另外計算
#fill在此為選擇顏色(或使用不同顏色，如c("#FA7482", "#FF81BC","#FFF674","#12D6BE")),width是指長條圖的寬度
geom_text(mapping = aes(label = sprintf("%.2f",feel)), #取feel小數點第2位
size = 3, colour = 'black', vjust = 2, hjust = .5, position = position_stack())+
labs(title = "台灣民眾各年齡層對假新聞普遍性的感受比較",
x="各年齡層",y="程度",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
scale_y_continuous(limits=c(0, 5))+ #凸顯量尺為5點量表, y軸的範圍為0-5
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
guides(fill=FALSE) #隱藏圖例名稱
# 如果要透過顏色特別強調某個重點，可在fill內設定ifelse
ggplot(df1,aes(x=agegroup, y=feel))+
geom_bar(stat = "identity", fill = ifelse(df1$feel <= 4, "#FFF587", "#FF8C64"),width=0.5)+
#stat = "identity" 強調y等同於feel變數，不須另外計算
#fill可透過不同顏色強調想要凸顯的重點,width是指長條圖的寬度
geom_text(mapping = aes(label = sprintf("%.2f",feel)), #取feel小數點第2位
size = 3, colour = 'black', vjust = 2, hjust = .5, position = position_stack())+
labs(title = "台灣民眾各年齡層對假新聞普遍性的感受比較",
x="各年齡層",y="程度",
subtitle="65+熟齡族與其他年齡有差異?",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
scale_y_continuous(limits=c(0, 5))+ #凸顯量尺為5點量表, y軸的範圍為0-5
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))
# RQ5: 台灣民眾確認假新聞的方式以何者為主?
# 使用變項：# 確認你接觸到的新聞是不是假新聞? i11.1-i11.8
# 須將複選題整合為一個變數
## 1. 輸入資料：將輸入的sav檔案命名為tcs2019
# install.packages("sjlabelled")
library(sjlabelled)
library(haven)
tcs2019 <- read_spss("tcs2019.sav")
## 2. 變數處理
# a.年齡「變數重新分類」為4類：18-35,36-49,50-64,65UP
tcs2019$agegroup <- cut(tcs2019$ra2, breaks = c(17,35,49,64,Inf),
labels = c("18至35歲", "36至49歲","50至64歲","65歲以上"))
# 製作次數分配表
# install.packages("sjmisc")
library(sjmisc)
frq(tcs2019$agegroup, encoding = "big-5", out="v")| val | label | frq | raw.prc | valid.prc | cum.prc | |
|---|---|---|---|---|---|---|
|
18 |
|
343 | 17.15 | 17.15 | 17.15 | |
|
36 |
|
534 | 26.70 | 26.70 | 43.85 | |
|
50 |
|
583 | 29.15 | 29.15 | 73.00 | |
| 65甇脖誑銝<8a> |
|
540 | 27.00 | 27.00 | 100.00 | |
| NA | NA | 0 | 0.00 | NA | NA | |
| total N=2000 · valid N=2000 · x̄=2.66 · σ=1.05 | ||||||
# b.確認你接觸到的新聞是不是假新聞? i11.1-i11.8
### 複選題處理方式：
# 1. 先篩選出確認假新聞方式的相關題項
names(tcs2019)## [1] "id" "type" "a1" "a2" "a3" "a3.a"
## [7] "a4" "a5.1" "a6" "a6.a" "a7" "a7.a"
## [13] "a8" "a8.a" "a9" "a9.a" "b1" "b2a"
## [19] "b3a" "b3b" "b3c" "b3d" "b3e" "b3f"
## [25] "b4.1.a.1" "b4.1.a.2" "b4.1.b.1" "b4.1.b.2" "b4.2.a.1" "b4.2.a.2"
## [31] "b4.2.b.1" "b4.2.b.2" "b4.3.a.1" "b4.3.a.2" "b4.3.b.1" "b4.3.b.2"
## [37] "c1a" "c1b.1" "c1b.2" "c1c.1" "c1c.2" "c1c.3"
## [43] "c1c.4" "c1c.5" "c1c.6" "c1c.7" "c1c.13" "c1c.12"
## [49] "c1c.36" "c1c.10" "c1c.14" "c1c.17" "c1c.11" "c1c.15"
## [55] "c1c.19" "c1c.41" "c1c.42" "c1c.43" "c1c.28" "c1c.35"
## [61] "c1c.16" "c1c.20" "c1c.21" "c1c.22" "c1c.26" "c1c.30"
## [67] "c1c.31" "c1c.32" "c1c.33" "c1c.34" "c1c.37" "c1c.38"
## [73] "c1c.40" "c1c.44" "c1c.88" "c1c.a" "c3a" "c3b.1"
## [79] "c3b.2" "c3c.24" "c3c.28" "c3c.21" "c3c.26" "c3c.6"
## [85] "c3c.1" "c3c.2" "c3c.4" "c3c.5" "c3c.18" "c3c.8"
## [91] "c3c.17" "c3c.19" "c3c.9" "c3c.23" "c3c.16" "c3c.13"
## [97] "c3c.22" "c3c.11" "c3c.15" "c3c.14" "c3c.20" "c3c.12"
## [103] "c3c.10" "c3c.25" "c3c.27" "c3c.7" "c3c.29" "c3c.30"
## [109] "c3c.32" "c3c.33" "c3c.34" "c3c.35" "c3c.36" "c3c.37"
## [115] "c3c.38" "c3c.39" "c3c.40" "c3c.41" "c3c.42" "c3c.43"
## [121] "c3c.44" "c3c.45" "c3c.46" "c3c.47" "c3c.48" "c3c.49"
## [127] "c3c.50" "c3c.51" "c3c.52" "c3c.53" "c3c.54" "c3c.55"
## [133] "c3c.56" "c3c.57" "c3c.58" "c3c.59" "c3c.60" "c3c.61"
## [139] "c3c.88" "c3c.a" "d1a" "d1b.1" "d1b.2" "d2a"
## [145] "d2b.1" "d2b.2" "e1" "e2.1" "e2.2" "f1"
## [151] "f2.1" "f2.2" "f3" "f4.1" "f4.2" "f5"
## [157] "f6.1" "f6.2" "f7" "f7.a" "g1" "g2.1"
## [163] "g2.2" "g3.1" "g3.2" "g3.3" "g3.4" "g3.5"
## [169] "g3.6" "g3.7" "g3.8" "g3.9" "g3.10" "g3.11"
## [175] "g3.12" "g3.13" "g3.14" "g3.15" "g3.16" "g3.17"
## [181] "g3.18" "g3.19" "g3.20" "g3.21" "g3.22" "g3.23"
## [187] "g3.24" "g3.25" "g3.26" "g3.27" "g3.28" "g3.29"
## [193] "g3.30" "g3.31" "g3.32" "g3.33" "g3.34" "g3.35"
## [199] "g3.36" "g3.88" "g3.a" "g4.1" "g4.1.a" "g4.2"
## [205] "g4.2.a" "g5.0.1" "g5.0.2" "g5.0.3" "g5.0.4" "g5.0.5"
## [211] "g5.0.6" "g5.0.7" "g5.0.8" "g5.0.9" "g5.0.10" "g5.0.11"
## [217] "g5.0.12" "g5.0.13" "g5.0.14" "g5.0.15" "g5.0.88" "g5.0.a"
## [223] "g5.5" "g5.6" "g5.7" "g5.8" "g5.9" "g5.10"
## [229] "g5.11" "g5.12" "g5.14" "h1" "h2" "h3"
## [235] "h4.1.a.1" "h4.1.a.2" "h4.1.b.1" "h4.1.b.2" "h4.2.a.1" "h4.2.a.2"
## [241] "h4.2.b.1" "h4.2.b.2" "h4.3.a.1" "h4.3.a.2" "h4.3.b.1" "h4.3.b.2"
## [247] "h5.1" "h5.2" "h5.3" "h5.4" "h5.5" "h5.6"
## [253] "h5.7" "h5.8" "ha1" "ha2" "ha3a.1" "ha3a.2"
## [259] "ha3a.3" "ha3a.4" "ha3a.5" "ha3a.6" "ha3a.7" "ha3a.99"
## [265] "ha3b.1" "ha3b.2" "ha3b.3" "ha3b.4" "ha3b.5" "ha3b.6"
## [271] "ha3b.7" "ha3b.99" "ha4" "ha5a.1" "ha5a.2" "ha5a.3"
## [277] "ha5a.4" "ha5a.5" "ha5a.6" "ha5a.99" "ha5b.1" "ha5b.2"
## [283] "ha5b.3" "ha5b.4" "ha5b.5" "ha5b.6" "ha5b.99" "ha5c.1"
## [289] "ha5c.2" "ha5c.3" "ha5c.4" "ha5c.5" "ha5c.6" "ha5c.99"
## [295] "ha6.1" "ha6.2" "ha6.3" "ha6.4" "ha6.5" "ha6.6"
## [301] "ha6.7" "ha6.99" "ha7.1" "ha7.2" "ha7.3" "ha7.4"
## [307] "ha7.5" "ha7.6" "ha7.7" "ha7.99" "i1" "i1.a"
## [313] "i2" "i2.a" "i3" "i3.a" "i4.1" "i4.2"
## [319] "i4.3" "i4.4" "i4.5" "i5a.1" "i5a.2" "i5a.3"
## [325] "i5a.4" "i5a.5" "i5a.6" "i5a.7" "i5a.8" "i5a.9"
## [331] "i5a.10" "i5a.88" "i5a.a" "i5a.90" "i5b.1" "i5b.2"
## [337] "i5b.3" "i5b.4" "i5b.5" "i5b.6" "i5b.88" "i5b.a"
## [343] "i5b.90" "i6.1" "i6.2" "i6.3" "i6.4" "i6.5"
## [349] "i6.90" "i7a" "i7b" "i7c" "i8.1" "i8.2"
## [355] "i8.3" "i8.4" "i8.5" "i8.6" "i8.7" "i8.8"
## [361] "i8.88" "i8.a" "i9.1.1" "i9.1.2" "i9.1.3" "i9.1.4"
## [367] "i9.1.5" "i9.1.6" "i9.1.7" "i9.1.8" "i9.1.9" "i9.1.10"
## [373] "i9.1.88" "i9.1.a" "i9.2.1" "i9.2.2" "i9.2.3" "i9.2.4"
## [379] "i9.2.5" "i9.2.6" "i9.2.7" "i9.2.8" "i9.2.88" "i9.2.a"
## [385] "i10.1" "i10.2" "i10.3" "i10.4" "i10.5" "i10.6"
## [391] "i10.7" "i10.8" "i10.88" "i10.a" "i11.1" "i11.2"
## [397] "i11.3" "i11.4" "i11.5" "i11.6" "i11.7" "i11.8"
## [403] "i11.88" "i11.a" "i12.1" "i12.2.1" "i12.2.2" "i12.2.3"
## [409] "i12.2.4" "i12.2.5" "i12.2.6" "i12.2.7" "i12.2.8" "i12.2.88"
## [415] "i12.2.a" "n1.1" "n1.2" "n1.3" "n1.4" "n1.5"
## [421] "n1.6" "n1.7" "n1.8" "n1.9" "n1.10" "n2.1"
## [427] "n2.2" "n2.3" "n2.4" "n2.5" "n2.6" "n2.7"
## [433] "n2.8" "n2.9" "n2.10" "n2.11" "n2.12" "n2.13"
## [439] "n2.14" "j1a" "j1b.1" "j1b.2" "j1c.1" "j1c.2"
## [445] "j1c.3" "j1c.4" "j1c.5" "j1c.6" "j1c.8" "j1c.9"
## [451] "j1c.10" "j1c.11" "j1c.12" "j1c.13" "j1c.88" "j1c.a"
## [457] "j2.1" "j2.2" "j2.3" "j2.4" "j2.5" "j2.6"
## [463] "j2.7" "j2.8" "j2.9" "k1" "k2.1" "k2.2"
## [469] "k3.1" "k3.3" "k3.4" "k3.6" "k3.7" "k3.8"
## [475] "k3.88" "k3.a" "k4.1" "k4.2" "k4.3" "k4.4"
## [481] "k4.5" "k4.6" "k4.7" "k4.8" "k4.9" "k4.10"
## [487] "k4.11" "k4.12" "k4.13" "k4.14" "k4.15" "k4.88"
## [493] "k4.a" "k5.1" "k5.2" "k5.3" "k5.4" "k5.5"
## [499] "k5.6" "k6.1" "k6.2" "k6.3" "k6.4" "k7"
## [505] "k9.1" "k9.2" "k9.3" "k9.4" "k9.5" "k10"
## [511] "k11.1" "k11.2" "k11.3" "k11.4" "k11.5" "k12"
## [517] "k13" "k14" "k15.1" "k15.2" "k15.3" "k15.4"
## [523] "k15.5" "k15.6" "k15.7" "k15.88" "k15.a" "k16.1"
## [529] "k16.2" "l1a" "l1b" "l3a" "l3b" "l5.1"
## [535] "l5.2" "l6" "l7" "l8" "l9a" "l9b.1"
## [541] "l9b.2" "l9b.3" "l9b.4" "l10a" "l10b.1" "l10b.2"
## [547] "l10b.3" "l10b.4" "l11a" "l11b.1" "l11b.2" "l11b.3"
## [553] "l11b.4" "l12" "l13" "l14" "l14.a" "l15"
## [559] "m1.1" "m1.2" "m1.3" "m1.4" "m1.5" "m1.6"
## [565] "m1.7" "m1.8" "m1.9" "m2a.1" "m2a.2" "m2a.3"
## [571] "m2a.4" "m2a.5" "m2a.6" "m2a.7" "m2a.8" "m2a.9"
## [577] "n3a.1" "n3a.2" "n3a.3" "n3a.4" "n3a.5" "n3b"
## [583] "n4" "n5" "n6" "n7" "n8a" "n8b"
## [589] "n9.1" "n9.2" "n9.3" "n9.4" "n10a" "n10b"
## [595] "n11a" "n11b" "o1" "o1.a" "o2" "o2.a"
## [601] "o3a" "o3a.a" "o3b" "o3b.a" "o4" "ra2"
## [607] "rra2" "rcity" "ra9" "rb3a" "rb3b" "rb3c"
## [613] "rb3e" "rb4.1.a" "rrb4.1.a" "rb4.1.b" "rrb4.1.b" "rb4.2.a"
## [619] "rrb4.2.a" "rb4.2.b" "rrb4.2.b" "rb4.3.a" "rrb4.3.a" "rb4.3.b"
## [625] "rrb4.3.b" "rc1b" "rrc1b" "rc3b" "rrc3b" "rd1b"
## [631] "rrd1b" "rd2b" "rrd2b" "re2" "rre2" "rf2"
## [637] "rrf2" "rf4" "rrf4" "rf6" "rrf6" "rg2"
## [643] "rrg2" "rh4.1.a" "rrh4.1.a" "rh4.1.b" "rrh4.1.b" "rh4.2.a"
## [649] "rrh4.2.a" "rh4.2.b" "rrh4.2.b" "rh4.3.a" "rrh4.3.a" "rh4.3.b"
## [655] "rrh4.3.b" "rh5.8" "ri4.1" "ri4.2" "ri4.3" "ri4.4"
## [661] "ri4.5" "rj1b" "rrj1b" "rk2" "rrk2" "rl6"
## [667] "rl7" "ro3b.a" "weight" "agegroup"DF <- data.frame(tcs2019[,c(395:402)])
# 2. 需填補遺漏值為1
DF[is.na(DF)] <- 0
# 3. 透過tidyr套件中的gather將寬格式轉為長格式(詳見ch12)
# install.packages("tidyr")
library(tidyr)
DF1 <- gather(DF, key = "identify", value = "count", i11.1,i11.2,i11.3,
i11.4,i11.5,i11.6,i11.7,i11.8)## Warning: attributes are not identical across measure variables;
## they will be dropped# 可以不必理會警告訊息
# 4. 篩選出count==1的資料框
DF2 <- subset(DF1, count==1)
# 5. 建新的資料框，
library(dplyr)
DF3 <- DF2 %>%
group_by(identify)%>% #運用dplyr套件中的group_by函數，以identify做分類
summarise(n = n())%>% #運用dplyr套件中的summarise函數，計算各類別的次數
arrange(n) #運用dplyr套件中的arrange函數，透過desc變成遞減排序
### (3)回答RQ
## 製表
# 製作次數分配表
# install.packages("sjmisc")
library(sjmisc)
frq(DF2$identify, encoding = "big-5", out="v") #使用DF2資料框| val | label | frq | raw.prc | valid.prc | cum.prc | |
|---|---|---|---|---|---|---|
| i11.1 |
|
1416 | 26.41 | 26.41 | 26.41 | |
| i11.2 |
|
1347 | 25.12 | 25.12 | 51.53 | |
| i11.3 |
|
699 | 13.04 | 13.04 | 64.57 | |
| i11.4 |
|
531 | 9.90 | 9.90 | 74.47 | |
| i11.5 |
|
336 | 6.27 | 6.27 | 80.73 | |
| i11.6 |
|
183 | 3.41 | 3.41 | 84.15 | |
| i11.7 |
|
513 | 9.57 | 9.57 | 93.72 | |
| i11.8 |
|
337 | 6.28 | 6.28 | 100.00 | |
| NA | NA | 0 | 0.00 | NA | NA | |
| total N=5362 · valid N=5362 · x̄=3.24 · σ=2.24 | ||||||
## 製圖
# 1. 變數處理
# (1) 將要繪製的變數變成類別變數或進行排序
class(DF3$identify)## [1] "character"DF3$identify <- as.factor(DF3$identify)
# 亦可進行排序(升冪)
DF3$identify <- factor(DF3$identify, ordered = TRUE,
levels = c("i11.6", "i11.5","i11.8","i11.7",
"i11.4", "i11.3","i11.2","i11.1"))
# 2. 安裝並載入 ggplot2
# install.packages("ggplot2")
# 載入 ggplot2
library(ggplot2)
# 解決Rstudio cloud圖形中文顯示問題
# install.packages("showtext")
library(showtext)
showtext_auto()
# 如果要透過顏色特別強調某個重點，可在fill內設定ifelse
ggplot(DF3,aes(x=identify, y=n))+
geom_bar(stat = "identity", fill = ifelse(DF3$n <= 1000, "#FFF587", "#FF8C64"),width=0.5)+
labs(title = "台灣民眾確認假新聞方式以何者為主?",
x="確認假新聞方式",y="次數",
caption="金寶製 資料來源：台灣傳播調查資料庫")+
theme(axis.title.y = element_text(vjust = 0.5, hjust = 0.5, angle = 0))+
theme(panel.background = element_blank())+
theme(plot.title = element_text(hjust = 0.5))+
geom_text(mapping = aes(label = sprintf("%.0f",n)), #取n小數點第0位
size = 3, colour = 'black', vjust = 2, hjust = .5, position = position_stack())+
scale_x_discrete("確認假新聞方式",labels = c("i11.1" = "經驗判斷","i11.2" = "不輕信",
"i11.3" = "與親友討論", "i11.4" = "搜尋相關訊息",
"i11.5" = "聽專業判斷","i11.6" = "參考新聞留言",
"i11.7" = "搜尋澄清訊息", "i11.8" = "使用事實查核"))