# 主題:社群平台議題分析
# 任務：RQ2.使用社群平台的動機
# 組別：應用藝術學系 第一組
### 資料框處理
# 請至台灣傳播資料庫下載「2019年調查」的sav檔
# 網址:https://www.crctaiwan.nctu.edu.tw/AnnualSurvey.asp
## 1. 將輸入的sav檔案命名為tcs2019
library(sjlabelled)
tcs2019 <- read_spss("tcs2019.sav")
library(sjlabelled)
tcs2019 <- read_spss("tcs2019.sav")
# (2)變數整理
# 年齡「變數重新分類」為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歲以上"))
# 製作次數分配表
# install.packages("sjmisc")
library(sjmisc)
frq(tcs2019$agegroup, encoding = "big-5", out="v")
x <categorical>
val label frq raw.prc valid.prc cum.prc
18至35歲 343 17.15 17.15 17.15
36至49歲 534 26.70 26.70 43.85
50至64歲 583 29.15 29.15 73.00
65歲以上 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.確認使用社群平台動機分類? k4.1-k4.15
### 複選題處理方式：
# 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, 477:491)])
# 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_na
DF1 <- gather(DF, key = "identify", value = "count", k4.1,k4.2,k4.3,k4.4,k4.5,k4.6,k4.7,k4.8,k4.9,k4.10,k4.11,k4.12,k4.13,k4.14,k4.15)
## 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)
## Install package "strengejacke" from GitHub (`devtools::install_github("strengejacke/strengejacke")`) to load all sj-packages at once!
sjt.xtab(DF2$agegroup, DF2$identify,encoding = "big-5",
         show.cell.prc = T,show.row.prc = T,show.col.prc = T)
agegroup identify Total
k4.1 k4.10 k4.11 k4.12 k4.13 k4.14 k4.15 k4.2 k4.3 k4.4 k4.5 k4.6 k4.7 k4.8 k4.9
18至35歲 227
13.7 %
26.7 %
4.3 % 		207
12.5 %
29.5 %
3.9 % 		160
9.7 %
40.7 %
3 % 		141
8.5 %
33.7 %
2.6 % 		36
2.2 %
21.8 %
0.7 % 		144
8.7 %
33.4 %
2.7 % 		84
5.1 %
29.3 %
1.6 % 		47
2.8 %
32.2 %
0.9 % 		72
4.3 %
37.5 %
1.4 % 		149
9 %
25.5 %
2.8 % 		41
2.5 %
43.2 %
0.8 % 		38
2.3 %
45.2 %
0.7 % 		215
13 %
30.2 %
4 % 		88
5.3 %
34.8 %
1.7 % 		8
0.5 %
57.1 %
0.2 % 		1657
100 %
31.1 %
31.3 %
36至49歲 335
16.4 %
39.4 %
6.3 % 		264
13 %
37.7 %
5 % 		137
6.7 %
34.9 %
2.6 % 		162
7.9 %
38.8 %
3 % 		71
3.5 %
43 %
1.3 % 		160
7.9 %
37.1 %
3 % 		108
5.3 %
37.6 %
2 % 		54
2.6 %
37 %
1 % 		79
3.9 %
41.1 %
1.5 % 		216
10.6 %
37 %
4.1 % 		33
1.6 %
34.7 %
0.6 % 		33
1.6 %
39.3 %
0.6 % 		282
13.8 %
39.6 %
5.3 % 		99
4.9 %
39.1 %
1.9 % 		5
0.2 %
35.7 %
0.1 % 		2038
100 %
38.3 %
38.3 %
50至64歲 209
17.4 %
24.6 %
3.9 % 		169
14.1 %
24.1 %
3.2 % 		70
5.8 %
17.8 %
1.3 % 		79
6.6 %
18.9 %
1.5 % 		34
2.8 %
20.6 %
0.6 % 		95
7.9 %
22 %
1.8 % 		70
5.8 %
24.4 %
1.3 % 		32
2.7 %
21.9 %
0.6 % 		38
3.2 %
19.8 %
0.7 % 		161
13.4 %
27.6 %
3 % 		19
1.6 %
20 %
0.4 % 		7
0.6 %
8.3 %
0.1 % 		168
14 %
23.6 %
3.2 % 		50
4.2 %
19.8 %
0.9 % 		1
0.1 %
7.1 %
0 % 		1202
100 %
22.6 %
22.5 %
65歲以上 79
18.5 %
9.3 %
1.5 % 		61
14.3 %
8.7 %
1.1 % 		26
6.1 %
6.6 %
0.5 % 		36
8.4 %
8.6 %
0.7 % 		24
5.6 %
14.5 %
0.5 % 		32
7.5 %
7.4 %
0.6 % 		25
5.8 %
8.7 %
0.5 % 		13
3 %
8.9 %
0.2 % 		3
0.7 %
1.6 %
0.1 % 		58
13.6 %
9.9 %
1.1 % 		2
0.5 %
2.1 %
0 % 		6
1.4 %
7.1 %
0.1 % 		47
11 %
6.6 %
0.9 % 		16
3.7 %
6.3 %
0.3 % 		0
0 %
0 %
0 % 		428
100 %
8 %
8.1 %
Total 850
16 %
100 %
16 % 		701
13.2 %
100 %
13.2 % 		393
7.4 %
100 %
7.4 % 		418
7.8 %
100 %
7.8 % 		165
3.1 %
100 %
3.1 % 		431
8.1 %
100 %
8.1 % 		287
5.4 %
100 %
5.4 % 		146
2.7 %
100 %
2.7 % 		192
3.6 %
100 %
3.6 % 		584
11 %
100 %
11 % 		95
1.8 %
100 %
1.8 % 		84
1.6 %
100 %
1.6 % 		712
13.4 %
100 %
13.4 % 		253
4.8 %
100 %
4.8 % 		14
0.3 %
100 %
0.3 % 		5325
100 %
100 %
100 %
χ2=111.135 · df=42 · Cramer’s V=0.083 · Fisher’s p=0.000 
## 製圖
# 1. 變數處理
# (1) 將要繪製的變數變成類別變數或先進行排序
class(DF2$agegroup)              
## [1] "factor"
class(DF2$identify)
## [1] "character"
DF2$identify <- as.factor(DF2$identify)

# 2. 安裝並載入 ggplot2
#install.packages("ggplot2")
# 載入 ggplot2
library(ggplot2)
# 解決Rstudio cloud圖形中文顯示問題
#install.packages("showtext")
library(showtext)
## Loading required package: sysfonts
## Loading required package: showtextdb
showtext_auto()
ggplot(DF2, 
       aes(identify, fill=agegroup))+
        geom_bar(position = "dodge")+
        labs(title = "台灣民眾各年齡層社群平台使用動機",x="社群平台使用動機",y="人數",
             subtitle="年齡使用社群平台動機有差異?",
             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("k4.1" = "維持朋友的關係","k4.2" = "認識談心朋友", "k4.3" = "認識有幫助朋友",
                                              "k4.4" = "與朋友分享心情","k4.5" = "展現個人","k4.6" = "怕漏掉事情或話題","k4.7" = "查看有興趣的人","k4.8" = "分享發表評論","k4.9" = "逃避事情","k4.10" = "打發時間","k4.11" = "娛樂","k4.12" = "習慣","k4.13" = "安排活動行程","k4.14" = "獲得新聞訊息","k4.15" = "學習新事物"))+
        scale_fill_manual("年齡層",values=c("lightskyblue1", "rosybrown2", "steelblue1","tomato1"))+
        theme(axis.text.x = element_text(vjust = 0.9,hjust = 1, angle=30))