民調作業

Quarto

TikTok最早於2016年在中國以「抖音」的形式上線，並於2017年推出國際版，迅速在全球各地獲得爆炸性的流行。這款短影音平台以其演算法推播機制、創新的影音剪輯功能與社群互動特性，成功吸引大量使用者，尤其是年輕族群。然而，隨著TikTok使用人口的急遽上升，其所引發的社會問題也逐漸浮現。

其中一項引人關注的現象，是部分TikTok影片帶來的「負面模仿效應」。使用者為了追求觀看數與社群關注，往往會模仿甚至誇大危險、暴力或違法的挑戰行為。像是近年社會上出現的「抖音挑戰」相關事件——例如「乾哥割喉案」——即顯示出影音內容對特定族群行為的潛在影響力。這類事件引發社會輿論對TikTok的批評，也促使學界思考短影音文化與社會行為之間的關係。

基於此，本研究計畫希望聚焦於以下幾個面向進行探討：首先，TikTok的使用者結構是否呈現出「學歷較低」與「社會地位較低」的特徵？這樣的社會分層現象可能與平台的內容風格、演算法推播機制，以及使用者的娛樂需求密切相關。其次，研究將探討這些使用者是否因缺乏足夠的「媒體識讀能力」，而難以區辨真實與虛構、理性行為與危險挑戰之間的界線。最後，本研究也將延伸分析，TikTok的資訊傳播方式是否可能加劇「群體極化」現象，使特定觀點、行為或文化價值在同溫層中被不斷強化，進而影響社會的整體輿論結構與公共理性。

換言之，本研究不僅關注TikTok作為一種新興媒介的娛樂功能，更希望理解它如何在特定社會階層中運作、如何形塑個體的媒體行為，以及它可能對社會秩序與公共意識帶來的挑戰。透過對使用者特質、媒體識讀能力與社會影響的系統性分析，期望能更全面地揭示TikTok現象背後的社會心理與階級文化意涵。

因為上述所要研究的專題是TikTok使用者是否呈現「學歷較低」與「社會地位較低」的特徵？因此其變數為教育程度、社會地位、、年齡、性別。將變數列出來後，再去根據媒體釋讀的能力、、負面模仿效應、群體極化的現象等研究問題去做深入探討是否結果會跟我所做的假設相關。

研究假設

H1：學歷與社會地位越低的受訪者，其TikTok使用頻率與使用時長越高。

H2：TikTok使用強度越高的受訪者，其政治或社會議題態度越極端。

H3：感到生活不公平或生活水準較低者，其對民主與政府的滿意度也較低。

變數選擇與關聯性

H1變數選擇：

自變項（社會結構變數）：教育程度（Q45.new）、收入（Q47.new，作為社會地位指標）、控制變項：年齡（S0.new）、性別（Q44.new）

依變項（使用行為變數）：TikTok使用頻率（S1.new）、單次使用時長（S2.new）、綜合指標：TikTok使用強度（use_intensity=平均S1＋S2）

關聯性：

本假設認為教育與社會地位較低者，往往擁有較少的文化資本與媒體識讀能力，對資訊內容的篩選較弱，傾向使用娛樂導向與短時間刺激的媒介平台（如 TikTok）。

預期關係：

教育程度、社會地位越低 → TikTok 使用強度越高。

H2變數選擇：

自變項：TikTok使用強度（use_intensity）

依變項（政治態度與極化指標）：對執政黨的好惡（Q12.new）、是否同意全面禁止抖音（Q32.new）、對我國民主運作的滿意度（Q15.new）

關聯性：

研究假設TikTok 的演算法推播機制會根據使用者偏好強化特定立場的內容，讓使用者長期接觸相同觀點而形成意見極化。使用頻率與時長越高者，越可能陷入單一價值框架，導致政治態度或社會議題立場出現極端化傾向。例如，長期接收偏頗訊息的使用者，可能對執政黨產生過度支持或厭惡，並在國家安全議題上表現出激烈立場。

預期關係：

TikTok 使用強度越高 → 政治態度極端化程度越強。

H3變數選擇：

自變項（社會心理變數）：生活與努力的公平感（Q42.new）

依變項（政治滿意度）：對民主運作的滿意度（Q15.new）

關聯性理由：

研究假設當個體主觀感受到生活水準不如他人、努力與回報不成比例時，容易對社會制度與政府運作產生不信任感，進而降低對民主制度及政府績效的滿意度。

預期關係：

生活與努力公平感越低→ 對民主的滿意度越低

https://quarto.org.

Running Code

When you click the Render button a document will be generated that includes both content and the output of embedded code. You can embed code like this:

library(readxl)
library(dplyr)

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

library(tidyr)
library(sjmisc)

Install package "strengejacke" from GitHub (`devtools::install_github("strengejacke/strengejacke")`) to load all sj-packages at once!

Attaching package: 'sjmisc'

The following object is masked from 'package:tidyr':

    replace_na

library(sjlabelled)

Attaching package: 'sjlabelled'

The following object is masked from 'package:dplyr':

    as_label

library(gmodels)
library(sjPlot)
library(ggplot2)

Attaching package: 'ggplot2'

The following object is masked from 'package:sjPlot':

    set_theme

The following object is masked from 'package:sjlabelled':

    as_label

library(stringr)
sjPlot::set_theme(theme.font = "PingFang Tc")
tiktok <- read_excel("民主實驗室TikTok使用者網路調查_資料檔0326.xlsx",
                     col_names = TRUE)

Warning: Expecting logical in AD1361 / R1361C30: got '社會民主黨'

Warning: Expecting logical in AD1975 / R1975C30: got '不一定'

Warning: Expecting logical in AD2298 / R2298C30: got '勞工黨'

str(tiktok$S0)

 num [1:2612] 8 27 14 23 21 39 20 26 52 26 ...

head(tiktok$S0)

[1]  8 27 14 23 21 39

#H1自變項（社會結構程度）：教育程度（45.new）、收入（Q47.new，作為社會地位指標）、控制變項：年齡（S0.new）、性別（Q44.new）

#Q45請問您的教育程度是什麼？
tiktok$Q45.new <- rec(
  tiktok$Q45,
  rec = "1=1 [不識字];
         2=2 [自修/小學];
         3=3 [國中/初職];
         4=4 [高中職];
         5=5 [專科];
         6=6 [大學];
         7=7 [碩士];
         8=8 [博士];
         90=90 [其它];
         97=97 [不知道];
         98=98 [拒答];
         else=NA",
  var.label = "教育程度",
  as.num = TRUE
)
 frq(tiktok$Q45.new)

教育程度 (x) <numeric> 
# total N=2612 valid N=2612 mean=5.77 sd=0.98

Value |     Label |    N | Raw % | Valid % | Cum. %
---------------------------------------------------
    1 |    不識字 |    2 |  0.08 |    0.08 |   0.08
    2 | 自修/小學 |   16 |  0.61 |    0.61 |   0.69
    3 | 國中/初職 |   42 |  1.61 |    1.61 |   2.30
    4 |    高中職 |  274 | 10.49 |   10.49 |  12.79
    5 |      專科 |  325 | 12.44 |   12.44 |  25.23
    6 |      大學 | 1516 | 58.04 |   58.04 |  83.27
    7 |      碩士 |  409 | 15.66 |   15.66 |  98.93
    8 |      博士 |   28 |  1.07 |    1.07 | 100.00
   90 |      其它 |    0 |  0.00 |    0.00 | 100.00
   97 |    不知道 |    0 |  0.00 |    0.00 | 100.00
   98 |      拒答 |    0 |  0.00 |    0.00 | 100.00
 <NA> |      <NA> |    0 |  0.00 |    <NA> |   <NA>

# 檢視分布（不輸出於報告中）
invisible(frq(tiktok$Q45.new))

# 長條圖：教育程度分布
plot_frq(
  tiktok$Q45.new,
  title = "受訪者教育程度分布圖",
  axis.title = "教育程度",
  show.mean = FALSE,
  show.n = TRUE,
  show.prc = TRUE
)

# Q44 請問您的性別
 tiktok$Q44.new <- rec(
  tiktok$Q44,
  rec = "
    1=1 [男];
    2=2 [女];
    else=NA",
  var.label = "性別",
  as.num = TRUE
)
 frq(tiktok$Q44.new)

性別 (x) <numeric> 
# total N=2612 valid N=2612 mean=1.50 sd=0.50

Value | Label |    N | Raw % | Valid % | Cum. %
-----------------------------------------------
    1 |    男 | 1308 | 50.08 |   50.08 |  50.08
    2 |    女 | 1304 | 49.92 |   49.92 | 100.00
 <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>

 invisible(frq(tiktok$Q44.new))

# 長條圖：受訪者性別分布
plot_frq(
  tiktok$Q44.new,
  title = "受訪者性別分布圖",
  axis.title = "性別（男 / 女）",
  show.mean = FALSE,
  show.n = TRUE,
  show.prc = TRUE
)

# Q47 請問您個人平均每個月所有的（稅前）收入差不多有多少？
 tiktok$Q47.new <- rec(
  tiktok$Q47,
  rec = "
    1=1 [無收入];
    2=2 [1萬元以下];
    3=3 [1萬元以上，不到2萬元];
    4=4 [2萬元以上，不到3萬元];
    5=5 [3萬元以上，不到4萬元];
    6=6 [4萬元以上，不到5萬元];
    7=7 [5萬元以上，不到6萬元];
    8=8 [6萬元以上，不到7萬元];
    9=9 [7萬元以上，不到8萬元];
    10=10 [8萬元以上，不到9萬元];
    11=11 [9萬元以上，不到10萬元];
    12=12 [10萬元以上，不到11萬元];
    13=13 [11萬元以上，不到12萬元];
    14=14 [12萬元以上，不到13萬元];
    15=15 [13萬元以上，不到14萬元];
    16=16 [14萬元以上，不到15萬元];
    17=17 [15萬元以上，不到16萬元];
    18=18 [16萬元以上，不到17萬元];
    19=19 [17萬元以上，不到18萬元];
    20=20 [18萬元以上，不到19萬元];
    21=21 [19萬元以上，不到20萬元];
    22=22 [20萬元以上，不到30萬元];
    23=23 [30萬元以上];
    97=97 [不知道];
    98=98 [拒答];
    else=NA",
  var.label = "每個月的收入多少",
  as.num = TRUE
)
 frq(tiktok$Q47.new)

每個月的收入多少 (x) <numeric> 
# total N=2612 valid N=2612 mean=8.91 sd=16.45

Value |                  Label |   N | Raw % | Valid % | Cum. %
---------------------------------------------------------------
    1 |                 無收入 |  88 |  3.37 |    3.37 |   3.37
    2 |              1萬元以下 |  67 |  2.57 |    2.57 |   5.93
    3 |   1萬元以上，不到2萬元 | 105 |  4.02 |    4.02 |   9.95
    4 |   2萬元以上，不到3萬元 | 314 | 12.02 |   12.02 |  21.98
    5 |   3萬元以上，不到4萬元 | 705 | 26.99 |   26.99 |  48.97
    6 |   4萬元以上，不到5萬元 | 499 | 19.10 |   19.10 |  68.07
    7 |   5萬元以上，不到6萬元 | 326 | 12.48 |   12.48 |  80.55
    8 |   6萬元以上，不到7萬元 | 142 |  5.44 |    5.44 |  85.99
    9 |   7萬元以上，不到8萬元 |  97 |  3.71 |    3.71 |  89.70
   10 |   8萬元以上，不到9萬元 |  54 |  2.07 |    2.07 |  91.77
   11 |  9萬元以上，不到10萬元 |  27 |  1.03 |    1.03 |  92.80
   12 | 10萬元以上，不到11萬元 |  31 |  1.19 |    1.19 |  93.99
   13 | 11萬元以上，不到12萬元 |   7 |  0.27 |    0.27 |  94.26
   14 | 12萬元以上，不到13萬元 |  23 |  0.88 |    0.88 |  95.14
   15 | 13萬元以上，不到14萬元 |   1 |  0.04 |    0.04 |  95.18
   16 | 14萬元以上，不到15萬元 |   6 |  0.23 |    0.23 |  95.41
   17 | 15萬元以上，不到16萬元 |  11 |  0.42 |    0.42 |  95.83
   18 | 16萬元以上，不到17萬元 |   3 |  0.11 |    0.11 |  95.94
   19 | 17萬元以上，不到18萬元 |   5 |  0.19 |    0.19 |  96.13
   20 | 18萬元以上，不到19萬元 |   0 |  0.00 |    0.00 |  96.13
   21 | 19萬元以上，不到20萬元 |   2 |  0.08 |    0.08 |  96.21
   22 | 20萬元以上，不到30萬元 |   8 |  0.31 |    0.31 |  96.52
   23 |             30萬元以上 |   7 |  0.27 |    0.27 |  96.78
   97 |                 不知道 |  14 |  0.54 |    0.54 |  97.32
   98 |                   拒答 |  70 |  2.68 |    2.68 | 100.00
 <NA> |                   <NA> |   0 |  0.00 |    <NA> |   <NA>

# 檢視分布（不輸出於報告中）
invisible(frq(tiktok$Q47.new))

# 長條圖：月收入分布
plot_frq(
  tiktok$Q47.new,
  title = "受訪者個人每月稅前收入分布",
  axis.title = "月收入（新台幣）",
  show.mean = FALSE,
  show.n = TRUE,
  show.prc = TRUE
)

# S0 請問您的西元出生年份
frq(tiktok$S0)

x <numeric> 
# total N=2612 valid N=2612 mean=26.08 sd=10.91

Value |   N | Raw % | Valid % | Cum. %
--------------------------------------
    2 |   3 |  0.11 |    0.11 |   0.11
    3 |   4 |  0.15 |    0.15 |   0.27
    4 |   3 |  0.11 |    0.11 |   0.38
    5 |   2 |  0.08 |    0.08 |   0.46
    6 |  11 |  0.42 |    0.42 |   0.88
    7 |  15 |  0.57 |    0.57 |   1.45
    8 |  28 |  1.07 |    1.07 |   2.53
    9 |  28 |  1.07 |    1.07 |   3.60
   10 |  21 |  0.80 |    0.80 |   4.40
   11 |  40 |  1.53 |    1.53 |   5.93
   12 |  90 |  3.45 |    3.45 |   9.38
   13 |  55 |  2.11 |    2.11 |  11.49
   14 |  65 |  2.49 |    2.49 |  13.97
   15 |  53 |  2.03 |    2.03 |  16.00
   16 |  81 |  3.10 |    3.10 |  19.10
   17 |  97 |  3.71 |    3.71 |  22.82
   18 |  72 |  2.76 |    2.76 |  25.57
   19 |  83 |  3.18 |    3.18 |  28.75
   20 |  83 |  3.18 |    3.18 |  31.93
   21 | 111 |  4.25 |    4.25 |  36.18
   22 |  95 |  3.64 |    3.64 |  39.82
   23 |  91 |  3.48 |    3.48 |  43.30
   24 | 125 |  4.79 |    4.79 |  48.09
   25 | 105 |  4.02 |    4.02 |  52.11
   26 |  89 |  3.41 |    3.41 |  55.51
   27 | 112 |  4.29 |    4.29 |  59.80
   28 |  84 |  3.22 |    3.22 |  63.02
   29 |  98 |  3.75 |    3.75 |  66.77
   30 |  84 |  3.22 |    3.22 |  69.98
   31 | 109 |  4.17 |    4.17 |  74.16
   32 |  91 |  3.48 |    3.48 |  77.64
   33 |  66 |  2.53 |    2.53 |  80.17
   34 |  72 |  2.76 |    2.76 |  82.92
   35 |  45 |  1.72 |    1.72 |  84.65
   36 |  39 |  1.49 |    1.49 |  86.14
   37 |  22 |  0.84 |    0.84 |  86.98
   38 |  21 |  0.80 |    0.80 |  87.79
   39 |  33 |  1.26 |    1.26 |  89.05
   40 |  17 |  0.65 |    0.65 |  89.70
   41 |  25 |  0.96 |    0.96 |  90.66
   42 |  23 |  0.88 |    0.88 |  91.54
   43 |  12 |  0.46 |    0.46 |  92.00
   44 |  19 |  0.73 |    0.73 |  92.73
   45 |  15 |  0.57 |    0.57 |  93.30
   46 |   8 |  0.31 |    0.31 |  93.61
   47 |  18 |  0.69 |    0.69 |  94.30
   48 |  15 |  0.57 |    0.57 |  94.87
   49 |  15 |  0.57 |    0.57 |  95.44
   50 |  12 |  0.46 |    0.46 |  95.90
   51 |  10 |  0.38 |    0.38 |  96.29
   52 |  18 |  0.69 |    0.69 |  96.98
   53 |  14 |  0.54 |    0.54 |  97.51
   54 |  10 |  0.38 |    0.38 |  97.89
   55 |   9 |  0.34 |    0.34 |  98.24
   56 |  15 |  0.57 |    0.57 |  98.81
   57 |   8 |  0.31 |    0.31 |  99.12
   58 |  23 |  0.88 |    0.88 | 100.00
 <NA> |   0 |  0.00 |    <NA> |   <NA>

tiktok$thisyear <- 2025
tiktok$ages <- tiktok$thisyear - tiktok$S0

tiktok$S0.new <- rec(tiktok$S0, rec = "else=copy")
tiktok$S0.enw <- rec(tiktok$S0,
                     rec = "1:12=1 [2000s]; 13:22=2 [1990s]; 23:32=3[1980s]; 33:42=4[1970s]; 43:52=5[1960s]; else=6")
frq(tiktok$S0.enw)

x <numeric> 
# total N=2612 valid N=2612 mean=2.85 sd=1.13

Value | Label |   N | Raw % | Valid % | Cum. %
----------------------------------------------
    1 | 2000s | 245 |  9.38 |    9.38 |   9.38
    2 | 1990s | 795 | 30.44 |   30.44 |  39.82
    3 | 1980s | 988 | 37.83 |   37.83 |  77.64
    4 | 1970s | 363 | 13.90 |   13.90 |  91.54
    5 | 1960s | 142 |  5.44 |    5.44 |  96.98
    6 |     6 |  79 |  3.02 |    3.02 | 100.00
 <NA> |  <NA> |   0 |  0.00 |    <NA> |   <NA>

# 加入圖表
plot_frq(
  tiktok$S0.enw,
  title = "出生世代分布圖",
  axis.title = "世代（2000s、1990s、1980s及以前）",
  show.n = TRUE,     # 顯示人數
  show.prc = TRUE,   # 顯示百分比
  show.mean = FALSE  # 不顯示平均線
)

#H1依變項（使用行為變數）：TikTok使用頻率（S1.new） 、單次使用時長（S2.new）、TikTok使用強度（平均S1+S2）

# S1 請問您最近一年有多常使用 TikTok 抖音？
tiktok$S1.new <- rec(
  tiktok$S1,
  rec = "
    1=1 [從來沒有];
    2=2 [很少使用];
    3=3 [每週數次];
    4=4 [每天一次];
    5=5 [每天好幾次];
    else=NA",
  var.label = "最近一年使用 TikTok 頻率",
  as.num = TRUE
)
 frq(tiktok$S1.new)

最近一年使用 TikTok 頻率 (x) <numeric> 
# total N=2612 valid N=2612 mean=2.93 sd=1.41

Value |      Label |   N | Raw % | Valid % | Cum. %
---------------------------------------------------
    1 |   從來沒有 | 477 | 18.26 |   18.26 |  18.26
    2 |   很少使用 | 689 | 26.38 |   26.38 |  44.64
    3 |   每週數次 | 579 | 22.17 |   22.17 |  66.81
    4 |   每天一次 | 286 | 10.95 |   10.95 |  77.76
    5 | 每天好幾次 | 581 | 22.24 |   22.24 | 100.00
 <NA> |       <NA> |   0 |  0.00 |    <NA> |   <NA>

# 長條圖：使用頻率分布
plot_frq(
  tiktok$S1.new,
  title = "最近一年使用 TikTok 頻率分布圖",
  axis.title = "使用頻率（1=從來沒有，5=每天好幾次）",
  show.n = TRUE,     # 顯示人數
  show.prc = TRUE,   # 顯示百分比
  show.mean = TRUE   # 顯示平均線
)

# S2 請問您平常單次使用 TikTok 抖音大概的時間長度？
tiktok$S2.new <- rec(
  tiktok$S2,
  rec = "
    1=1 [10 分鐘以內];
    2=2 [10–30 分鐘以內];
    3=3 [30 分鐘至 1 小時以內];
    4=4 [1–3 小時以內];
    5=5 [3 小時以上];
    else=NA",
  var.label = "單次使用 TikTok 時長",
  as.num = TRUE
)

# 檢視分布（顯示樣本數與百分比）
frq(tiktok$S2.new)

單次使用 TikTok 時長 (x) <numeric> 
# total N=2612 valid N=2135 mean=2.38 sd=1.10

Value |                Label |   N | Raw % | Valid % | Cum. %
-------------------------------------------------------------
    1 |          10 分鐘以內 | 531 | 20.33 |   24.87 |  24.87
    2 |       10–30 分鐘以內 | 687 | 26.30 |   32.18 |  57.05
    3 | 30 分鐘至 1 小時以內 | 579 | 22.17 |   27.12 |  84.17
    4 |         1–3 小時以內 | 255 |  9.76 |   11.94 |  96.11
    5 |           3 小時以上 |  83 |  3.18 |    3.89 | 100.00
 <NA> |                 <NA> | 477 | 18.26 |    <NA> |   <NA>

# 視覺化：單次使用時長分布
plot_frq(
  tiktok$S2.new,
  title = "單次使用 TikTok 時長分布圖",
  axis.title = "使用時長（1=10分鐘以內，5=3小時以上）",
  show.n = TRUE,     # 顯示人數
  show.prc = TRUE,   # 顯示百分比
  show.mean = TRUE   # 顯示平均值線
)

# 建立「抖音使用強度」指標（平均值）
tiktok$use_intensity <- rowMeans(tiktok[, c("S1.new", "S2.new")], na.rm = TRUE)

# 檢視分布（不輸出於報告中）
invisible(frq(tiktok$use_intensity))
# 長條圖：TikTok 使用強度分布
plot_frq(
  tiktok$use_intensity,
  title = "TikTok 使用強度分布",
  axis.title = "使用強度（頻率 + 時長）",
  show.mean = TRUE
)

#H2自變項：TikTok使用強度
# 使用頻率（S1）
tiktok$S1.new <- rec(
  tiktok$S1,
  rec = "1=1 [從來沒有]; 
         2=2 [很少使用]; 
         3=3 [每週數次]; 
         4=4 [每天一次]; 
         5=5 [每天好幾次]",
  var.label = "最近一年使用 TikTok 頻率",
  as.num = TRUE
)
frq(tiktok$S1.new)

最近一年使用 TikTok 頻率 (x) <numeric> 
# total N=2612 valid N=2612 mean=2.93 sd=1.41

Value |      Label |   N | Raw % | Valid % | Cum. %
---------------------------------------------------
    1 |   從來沒有 | 477 | 18.26 |   18.26 |  18.26
    2 |   很少使用 | 689 | 26.38 |   26.38 |  44.64
    3 |   每週數次 | 579 | 22.17 |   22.17 |  66.81
    4 |   每天一次 | 286 | 10.95 |   10.95 |  77.76
    5 | 每天好幾次 | 581 | 22.24 |   22.24 | 100.00
 <NA> |       <NA> |   0 |  0.00 |    <NA> |   <NA>

# 單次使用時長（S2）
tiktok$S2.new <- rec(
  tiktok$S2,
  rec = "1=1 [10 分鐘以內];
         2=2 [10–30 分鐘以內];
         3=3 [30 分鐘至 1 小時以內];
         4=4 [1–3 小時以內];
         5=5 [3 小時以上]",
  var.label = "單次使用 TikTok 時長",
  as.num = TRUE
)
frq(tiktok$S2.new)

單次使用 TikTok 時長 (x) <numeric> 
# total N=2612 valid N=2135 mean=2.38 sd=1.10

Value |                Label |   N | Raw % | Valid % | Cum. %
-------------------------------------------------------------
    1 |          10 分鐘以內 | 531 | 20.33 |   24.87 |  24.87
    2 |       10–30 分鐘以內 | 687 | 26.30 |   32.18 |  57.05
    3 | 30 分鐘至 1 小時以內 | 579 | 22.17 |   27.12 |  84.17
    4 |         1–3 小時以內 | 255 |  9.76 |   11.94 |  96.11
    5 |           3 小時以上 |  83 |  3.18 |    3.89 | 100.00
 <NA> |                 <NA> | 477 | 18.26 |    <NA> |   <NA>

# 視覺化：單次使用時長分布
plot_frq(
  tiktok$S2.new,
  title = "單次使用 TikTok 時長分布圖",
  axis.title = "使用時長（1=10分鐘以內，5=3小時以上）",
  show.n = TRUE,     # 顯示人數
  show.prc = TRUE,   # 顯示百分比
  show.mean = TRUE   # 顯示平均值線
)

# 建立「抖音使用強度」指標（平均值）
tiktok$use_intensity <- rowMeans(tiktok[, c("S1.new", "S2.new")], na.rm = TRUE)

# 檢視分布（不輸出於報告中）
invisible(frq(tiktok$use_intensity))
# 長條圖：TikTok 使用強度分布
plot_frq(
  tiktok$use_intensity,
  title = "TikTok 使用強度分布",
  axis.title = "使用強度（頻率 + 時長）",
  show.mean = TRUE
)

#H2依變項（政治態度與極化指標）：對執政黨的好惡（Q12.new）、對我國民主運作的滿意度（Q15.new）

# Q12 請問整體而言您喜不喜歡現在的執政黨？
tiktok$Q12.new <- rec(
  tiktok$Q12,
  rec = "
    1=1 [非常不喜歡];
    2=2 [還滿不喜歡];
    3=3 [有點不喜歡];
    4=4 [有點喜歡];
    5=5 [還滿喜歡];
    6=6 [非常喜歡];
    else=NA",
  var.label = "喜不喜歡現在的政黨",
  as.num = TRUE
)
frq(tiktok$Q12.new)

喜不喜歡現在的政黨 (x) <numeric> 
# total N=2612 valid N=2612 mean=2.88 sd=1.43

Value |      Label |   N | Raw % | Valid % | Cum. %
---------------------------------------------------
    1 | 非常不喜歡 | 652 | 24.96 |   24.96 |  24.96
    2 | 還滿不喜歡 | 347 | 13.28 |   13.28 |  38.25
    3 | 有點不喜歡 | 720 | 27.57 |   27.57 |  65.81
    4 |   有點喜歡 | 559 | 21.40 |   21.40 |  87.21
    5 |   還滿喜歡 | 231 |  8.84 |    8.84 |  96.06
    6 |   非常喜歡 | 103 |  3.94 |    3.94 | 100.00
 <NA> |       <NA> |   0 |  0.00 |    <NA> |   <NA>

# Q15 整體來說，您對於我國民主的運作現況滿不滿意？
tiktok$Q15.new <- rec(
  tiktok$Q15,
  rec = "
    1=1 [非常不滿意];
    2=2 [還算不滿意];
    3=3 [有點不滿意];
    4=4 [有點滿意];
    5=5 [還算滿意];
    6=6 [非常滿意];
    else=NA",
  var.label = "對我國民主的運作現況滿不滿意",
  as.num = TRUE
)
frq(tiktok$Q15.new)

對我國民主的運作現況滿不滿意 (x) <numeric> 
# total N=2612 valid N=2612 mean=3.46 sd=1.30

Value |      Label |   N | Raw % | Valid % | Cum. %
---------------------------------------------------
    1 | 非常不滿意 | 257 |  9.84 |    9.84 |   9.84
    2 | 還算不滿意 | 305 | 11.68 |   11.68 |  21.52
    3 | 有點不滿意 | 739 | 28.29 |   28.29 |  49.81
    4 |   有點滿意 | 709 | 27.14 |   27.14 |  76.95
    5 |   還算滿意 | 492 | 18.84 |   18.84 |  95.79
    6 |   非常滿意 | 110 |  4.21 |    4.21 | 100.00
 <NA> |       <NA> |   0 |  0.00 |    <NA> |   <NA>

# 建立「政治態度指標」
tiktok$political_attitude <- rowMeans(
  tiktok[, c("Q12.new", "Q15.new" )],
  na.rm = TRUE
)

# 檢視分布（不輸出於報告中）
invisible(frq(tiktok$political_attitude))

# 長條圖：政治態度指標分布
plot_frq(
  tiktok$political_attitude,
  title = "政治態度指標分布圖",
  axis.title = "政治態度（執政黨喜好 + 民主滿意度 + 禁抖音傾向）",
  show.mean = TRUE
)

#H3自變項（社會心理變數）：生活與努力的公平感（Q42.new）

# Q42 個人而言，您認為您目前的生活水準和您的努力比起來公不公平？
 tiktok$Q42.new <- rec(
  tiktok$Q42,
  rec = "
    1=1 [很不公平];
    2=2 [不太公平];
    3=3 [還算公平];
    4=4 [公平];
    5=5 [很公平];
    else=NA",
  var.label = "目前的生活水準和努力比起來公不公平",
  as.num = TRUE
)
 frq(tiktok$Q42.new)

目前的生活水準和努力比起來公不公平 (x) <numeric> 
# total N=2612 valid N=2612 mean=2.81 sd=0.92

Value |    Label |    N | Raw % | Valid % | Cum. %
--------------------------------------------------
    1 | 很不公平 |  203 |  7.77 |    7.77 |   7.77
    2 | 不太公平 |  701 | 26.84 |   26.84 |  34.61
    3 | 還算公平 | 1192 | 45.64 |   45.64 |  80.25
    4 |     公平 |  425 | 16.27 |   16.27 |  96.52
    5 |   很公平 |   91 |  3.48 |    3.48 | 100.00
 <NA> |     <NA> |    0 |  0.00 |    <NA> |   <NA>

# 檢視分布（不輸出於報告中）
invisible(frq(tiktok$Q42.new))

# 長條圖：生活公平感分布
plot_frq(
  tiktok$Q42.new,
  title = "生活公平感分布圖",
  axis.title = "生活水準與努力的公平程度（1=很不公平，5=很公平）",
  show.mean = TRUE
)

#H3依變項（政治滿意度）：對民主運作的滿意度（Q15.new）

# Q15：民主滿意度
tiktok$Q15.new <- rec(
  tiktok$Q15,
  rec = "
    1=1 [非常不滿意];
    2=2 [還算不滿意];
    3=3 [有點不滿意];
    4=4 [有點滿意];
    5=5 [還算滿意];
    6=6 [非常滿意];
    else=NA",
  var.label = "對我國民主的運作現況滿不滿意",
  as.num = TRUE
)
# 檢視分布
frq(tiktok$Q15.new)

對我國民主的運作現況滿不滿意 (x) <numeric> 
# total N=2612 valid N=2612 mean=3.46 sd=1.30

Value |      Label |   N | Raw % | Valid % | Cum. %
---------------------------------------------------
    1 | 非常不滿意 | 257 |  9.84 |    9.84 |   9.84
    2 | 還算不滿意 | 305 | 11.68 |   11.68 |  21.52
    3 | 有點不滿意 | 739 | 28.29 |   28.29 |  49.81
    4 |   有點滿意 | 709 | 27.14 |   27.14 |  76.95
    5 |   還算滿意 | 492 | 18.84 |   18.84 |  95.79
    6 |   非常滿意 | 110 |  4.21 |    4.21 | 100.00
 <NA> |       <NA> |   0 |  0.00 |    <NA> |   <NA>

# 長條圖：民主滿意度分布
plot_frq(
  tiktok$Q15.new,
  title = "民主運作滿意度分布圖",
  axis.title = "民主運作滿意度（1=非常不滿意，6=非常滿意）",
  show.n = TRUE,      # 顯示樣本數
  show.prc = TRUE,    # 顯示百分比
  show.mean = TRUE    # 顯示平均值線
)

# 建立「公平感 × 民主滿意度」整合指標
tiktok$fairness_democracy <- rowMeans(
  tiktok[, c("Q42.new", "Q15.new")],   
  na.rm = TRUE
)

# 檢視分布
invisible(frq(tiktok$fairness_democracy))

# 長條圖：整合指標
plot_frq(
  tiktok$fairness_democracy,
  title = "生活公平感 × 民主運作滿意度整合指標分布圖",
  axis.title = "整合分數（公平感 + 民主滿意度 平均值）",
  show.mean = TRUE,
  show.n = TRUE,
  show.prc = TRUE
)

變數的相關性檢驗

load("tiktok.rda")
library(sjPlot)
library(sjmisc)
library(sjlabelled)
library(dplyr)
#H0：教育程度、社會地位與TikTok使用強度無相關。
#H1：教育程度、社會地位與TikTok使用強度呈正相關。

#建立教育、收入、使用強度變數

tiktok$Q45.new <- rec(
  tiktok$Q45,
  rec = "1:4=1[低教育];5:6=2[中等教育];7:8=3[高教育];else=NA",
  as.num = TRUE
)
tiktok$Q47.new <- rec(
  tiktok$Q47,
  rec = "1:5=1[低收入];6:11=2[中等收入];12:23=3[高收入];else=NA",
  as.num = TRUE
)

# 檢查欄位名稱
names(tiktok)

 [1] "編號"           "抖音活躍使用者" "S0"             "S0_AGE"        
 [5] "S1"             "S2"             "Q1_1"           "Q1_2"          
 [9] "Q1_3"           "Q1_4"           "Q1_5"           "Q1_O"          
[13] "Q2_1"           "Q2_2"           "Q2_3"           "Q2_O"          
[17] "Q3_1"           "Q3_2"           "Q3_3"           "Q3_O"          
[21] "Q4"             "Q4_O"           "Q5"             "Q6"            
[25] "Q7"             "Q8"             "Q9"             "Q9_O"          
[29] "Q10"            "Q10_O"          "Q11"            "Q11_O"         
[33] "Q12"            "Q13"            "Q13_O"          "Q14"           
[37] "Q15"            "Q16"            "Q17"            "Q18"           
[41] "Q19"            "Q20"            "Q21"            "Q22"           
[45] "Q23"            "Q23_O"          "Q24"            "Q25"           
[49] "Q26"            "Q27"            "Q28"            "Q29"           
[53] "Q30"            "Q31"            "Q32"            "Q33"           
[57] "Q34"            "Q35"            "Q36"            "Q37"           
[61] "Q38"            "Q39"            "Q40"            "Q41"           
[65] "Q42"            "Q43"            "Q44"            "Q45"           
[69] "Q45_O"          "Q46"            "Q47"            "Q48"           
[73] "SEX"            "AGE"            "EDU"            "AREA"          
[77] "WT"             "Q45.new"        "Q47.new"       

tiktok$S1.new <- rec(
  tiktok$S1,
  rec = "1=1 [從來沒有]; 2=2 [很少使用]; 3=3 [每週數次]; 4=4 [每天一次]; 5=5 [每天好幾次]; else=NA",
  as.num = TRUE
)
tiktok$S2.new <- rec(
  tiktok$S2,
  rec = "1=1 [10分鐘以內]; 2=2 [10–30分鐘]; 3=3 [30分鐘至1小時]; 4=4 [1–3小時]; 5=5 [3小時以上]; else=NA",
  as.num = TRUE
)

# 檢查變數是否建立成功
frq(tiktok$S1.new)

年齡 (x) <numeric> 
# total N=2612 valid N=2612 mean=2.93 sd=1.41

Value |      Label |   N | Raw % | Valid % | Cum. %
---------------------------------------------------
    1 |   從來沒有 | 477 | 18.26 |   18.26 |  18.26
    2 |   很少使用 | 689 | 26.38 |   26.38 |  44.64
    3 |   每週數次 | 579 | 22.17 |   22.17 |  66.81
    4 |   每天一次 | 286 | 10.95 |   10.95 |  77.76
    5 | 每天好幾次 | 581 | 22.24 |   22.24 | 100.00
 <NA> |       <NA> |   0 |  0.00 |    <NA> |   <NA>

frq(tiktok$S2.new)

x <numeric> 
# total N=2612 valid N=2135 mean=2.38 sd=1.10

Value |         Label |   N | Raw % | Valid % | Cum. %
------------------------------------------------------
    1 |    10分鐘以內 | 531 | 20.33 |   24.87 |  24.87
    2 |     10–30分鐘 | 687 | 26.30 |   32.18 |  57.05
    3 | 30分鐘至1小時 | 579 | 22.17 |   27.12 |  84.17
    4 |       1–3小時 | 255 |  9.76 |   11.94 |  96.11
    5 |     3小時以上 |  83 |  3.18 |    3.89 | 100.00
 <NA> |          <NA> | 477 | 18.26 |    <NA> |   <NA>

#建立強度指標
tiktok$use_intensity <- rowMeans(tiktok[, c("S1.new", "S2.new")], na.rm = TRUE)

# 分組


# 教育程度（手動三分類）
tiktok$edu.cat <- factor(
  tiktok$Q45.new,
  levels = c(1, 2, 3),
  labels = c("低教育", "中等教育", "高教育")
)

# 收入（手動三分類）
tiktok$income.cat <- factor(
  tiktok$Q47.new,
  levels = c(1, 2, 3),
  labels = c("低收入", "中等收入", "高收入")
)

# 抖音使用強度（手動三分類）
tiktok$use_intensity.cat <- cut(
  tiktok$use_intensity,
  breaks = c(0, 2.33, 3.66, 5),
  labels = c("低強度", "中強度", "高強度"),
  include.lowest = TRUE
)

# 教育 × 使用強度
tab_xtab(
  tiktok$edu.cat,
  tiktok$use_intensity.cat,
  encoding = "utf8",
  show.row.prc = TRUE,
  show.col.prc = TRUE,
  show.na = FALSE,
  show.legend = FALSE,
  title = "教育程度 × TikTok 使用強度之關聯"
)

教育程度 × TikTok 使用強度之關聯

edu.cat	use_intensity.cat			Total
	低強度	中強度	高強度
低教育	144 43.1 % 12.2 %	133 39.8 % 13.4 %	57 17.1 % 13 %	334 100 % 12.8 %
中等教育	833 45.2 % 70.5 %	716 38.9 % 72.2 %	292 15.9 % 66.7 %	1841 100 % 70.5 %
高教育	205 46.9 % 17.3 %	143 32.7 % 14.4 %	89 20.4 % 20.3 %	437 100 % 16.7 %
Total	1182 45.3 % 100 %	992 38 % 100 %	438 16.8 % 100 %	2612 100 % 100 %
χ2=8.779 · df=4 · Cramer's V=0.041 · p=0.067

chisq.test(table(tiktok$edu.cat, tiktok$use_intensity.cat))

    Pearson's Chi-squared test

data:  table(tiktok$edu.cat, tiktok$use_intensity.cat)
X-squared = 8.7788, df = 4, p-value = 0.06687

# 收入 × 使用強度
tab_xtab(
  tiktok$income.cat,
  tiktok$use_intensity.cat,
  encoding = "utf8",
  show.row.prc = TRUE,
  show.col.prc = TRUE,
  show.na = FALSE,
  show.legend = FALSE,
  title = "收入 × TikTok 使用強度之關聯"
)

收入 × TikTok 使用強度之關聯

income.cat	use_intensity.cat			Total
	低強度	中強度	高強度
低收入	551 43.1 % 48.5 %	530 41.4 % 55 %	198 15.5 % 46.2 %	1279 100 % 50.6 %
中等收入	541 47.2 % 47.7 %	402 35.1 % 41.7 %	202 17.6 % 47.1 %	1145 100 % 45.3 %
高收入	43 41.3 % 3.8 %	32 30.8 % 3.3 %	29 27.9 % 6.8 %	104 100 % 4.1 %
Total	1135 44.9 % 100 %	964 38.1 % 100 %	429 17 % 100 %	2528 100 % 100 %
χ2=19.809 · df=4 · Cramer's V=0.063 · p=0.001

chisq.test(table(tiktok$income.cat, tiktok$use_intensity.cat))

    Pearson's Chi-squared test

data:  table(tiktok$income.cat, tiktok$use_intensity.cat)
X-squared = 19.809, df = 4, p-value = 0.0005447

關於H1的卡方檢定結果

1.教育程度與TikTok使用強度的卡方檢定結果：根據卡方檢定結果，教育程度與抖音使用強度之間的關聯未達統計顯著（χ²=8.78, df=4, p=0.067）。這表示不同教育程度族群在使用 TikTok 的頻率與時長上，並未出現顯著差異。
因此，教育程度對抖音使用強度的影響在本樣本中不顯著，
雖有輕微的差異趨勢，但不足以支持「教育程度越低者使用強度越高」的假設。

2.收入（社會地位）與TikTok使用強度的卡方檢定結果：卡方檢定結果顯示，受訪者的收入層級與其 TikTok 使用強度之間存在顯著關聯（χ²=19.81, df=4, p<.001）。
這表示不同收入水準的族群在 TikTok 的使用頻率與時長上呈現顯著差異。
從交叉表分布可推測，低收入者在高使用強度群體中的比例明顯高於高收入者，
顯示 TikTok 使用強度可能與經濟條件呈負向關係，即社經地位越低者，抖音使用強度越高。

所以總結來看教育程度較低與抖音使用強度高的假設不成立但，收入較低的族群TikTok的使用強度越高這個假設成立。

#H0:抖音使用強度與政治極化態度無相關
#H2:抖音使用強度與政治極化態度呈正相關
# 建立「TikTok 使用強度」
# S1：使用頻率
tiktok$S1.new <- rec(
  tiktok$S1,
  rec = "1:2=1 [低使用]; 3=2 [中等使用]; 4:5=3 [高使用]; else=NA",
  as.num = TRUE
)

# S2：單次使用時間
tiktok$S2.new <- rec(
  tiktok$S2,
  rec = "1:2=1 [低使用]; 3=2 [中等使用]; 4:5=3 [高使用]; else=NA",
  as.num = TRUE
)

# 使用強度（平均值）
tiktok$use_intensity <- rowMeans(tiktok[, c("S1.new", "S2.new")], na.rm = TRUE)

# 手動三等份
tiktok$use_intensity.cat <- cut(
  tiktok$use_intensity,
  breaks = c(0, 1.66, 2.33, 3),
  labels = c("低使用", "中等使用", "高使用"),
  include.lowest = TRUE
)


# Step 2. 建立「政治態度」指標（Q12 + Q15）

# Q12：對執政黨好感度
tiktok$Q12.new <- rec(
  tiktok$Q12,
  rec = "1:3=1 [負向]; 4=2 [中性]; 5=3 [正向]; else=NA",
  as.num = TRUE
)

# Q15：對民主滿意度
tiktok$Q15.new <- rec(
  tiktok$Q15,
  rec = "1:3=1 [低滿意]; 4=2 [中滿意]; 5:6=3 [高滿意]; else=NA",
  as.num = TRUE
)

# 合成「政治態度指標」：取平均值（1–3）
tiktok$political_attitude <- rowMeans(
  tiktok[, c("Q12.new", "Q15.new")],
  na.rm = TRUE
)

# 政治態度分組（負／中／正）
tiktok$political_attitude.cat <- cut(
  tiktok$political_attitude,
  breaks = c(0, 1.66, 2.33, 3),
  labels = c("負向態度", "中性態度", "正向態度"),
  include.lowest = TRUE
)

# Step 3. 交叉表與卡方檢定
tab_xtab(
  tiktok$use_intensity.cat,
  tiktok$political_attitude.cat,
  encoding = "utf8",
  show.row.prc = TRUE,
  show.col.prc = TRUE,
  show.na = FALSE,
  show.legend = FALSE,
  title = "TikTok 使用強度 × 政治態度之關聯"
)

TikTok 使用強度 × 政治態度之關聯

use_intensity.cat	political_attitude.cat			Total
	負向態度	中性態度	正向態度
低使用	866 61.2 % 53.3 %	289 20.4 % 54.2 %	260 18.4 % 57.4 %	1415 100 % 54.2 %
中等使用	409 69.8 % 25.2 %	106 18.1 % 19.9 %	71 12.1 % 15.7 %	586 100 % 22.4 %
高使用	351 57.4 % 21.6 %	138 22.6 % 25.9 %	122 20 % 26.9 %	611 100 % 23.4 %
Total	1626 62.3 % 100 %	533 20.4 % 100 %	453 17.3 % 100 %	2612 100 % 100 %
χ2=23.365 · df=4 · Cramer's V=0.067 · p=0.000

chisq.test(table(tiktok$use_intensity.cat, tiktok$political_attitude.cat))

    Pearson's Chi-squared test

data:  table(tiktok$use_intensity.cat, tiktok$political_attitude.cat)
X-squared = 23.365, df = 4, p-value = 0.0001071

根據卡方檢定結果（χ² = 23.37, df = 4, p < .001）顯示，抖音使用強度與政治態度之間存在顯著關聯。
進一步觀察交叉表可發現，低使用強度族群中「負向政治態度」的比例最高，顯示使用抖音較少者普遍對生活公平感與民主運作的滿意度較低，可能代表政治冷感或體制疏離現象。
相對地，高使用強度者在「中性」與「正向」政治態度群的比例較高，可能顯示其政治涉入較深、對政治體制的態度更明確。
這樣來看的話，結果支持假設 H2，亦即抖音使用強度與政治態度之間呈現顯著正相關，高使用強度者的政治態度更趨明確與極化，而低使用者則傾向表現出不滿或疏離。

load("tiktok.rda")
library(sjPlot)
library(sjmisc)
library(sjlabelled)
library(dplyr)
# 研究假設
# H0：生活公平感與民主滿意度無關。
# H3：生活公平感與民主滿意度呈正相關。

tiktok$Q42.new <- rec(
  tiktok$Q42,
  rec = "1:2=1 [低公平]; 3=2 [中公平]; 4:5=3 [高公平]; else=NA",
  var.label = "生活公平感",
  as.num = TRUE
)

tiktok$Q15.new <- rec(
  tiktok$Q15,
  rec = "1:3=1 [低滿意]; 4=2 [中滿意]; 5:6=3 [高滿意]; else=NA",
  var.label = "民主滿意度",
  as.num = TRUE
)

tiktok$fairness.cat <- factor(
  tiktok$Q42.new,
  levels = c(1, 2, 3),
  labels = c("低公平", "中公平", "高公平")
)

tiktok$democracy_sat.cat <- factor(
  tiktok$Q15.new,
  levels = c(1, 2, 3),
  labels = c("低滿意", "中滿意", "高滿意")
)

#卡方檢定與視覺化交叉表
# 交叉表視覺化
tab_xtab(
  tiktok$fairness.cat,
  tiktok$democracy_sat.cat,
  encoding = "utf8",
  show.row.prc = TRUE,   # 顯示列百分比
  show.col.prc = TRUE,   # 顯示欄百分比
  show.na = FALSE,
  show.legend = FALSE,
  title = "生活公平感 × 民主滿意度之關聯"
)

生活公平感 × 民主滿意度之關聯

fairness.cat	democracy_sat.cat			Total
	低滿意	中滿意	高滿意
低公平	593 65.6 % 45.6 %	182 20.1 % 25.7 %	129 14.3 % 21.4 %	904 100 % 34.6 %
中公平	550 46.1 % 42.3 %	397 33.3 % 56 %	245 20.6 % 40.7 %	1192 100 % 45.6 %
高公平	158 30.6 % 12.1 %	130 25.2 % 18.3 %	228 44.2 % 37.9 %	516 100 % 19.8 %
Total	1301 49.8 % 100 %	709 27.1 % 100 %	602 23 % 100 %	2612 100 % 100 %
χ2=253.849 · df=4 · Cramer's V=0.220 · p=0.000

# 卡方檢定
chisq.test(table(tiktok$fairness.cat, tiktok$democracy_sat.cat))

    Pearson's Chi-squared test

data:  table(tiktok$fairness.cat, tiktok$democracy_sat.cat)
X-squared = 253.85, df = 4, p-value < 2.2e-16

根據跑完的數據，卡方檢定結果顯示，生活公平感與民主滿意度之間存在顯著正相關（χ² = 253.85, df = 4, p < .001）。
分析顯示，低公平感者多集中於低民主滿意度群，而高公平感者在高民主滿意度群的比例明顯較高，顯示受訪者對生活公平的主觀感受越高，越傾向對民主制度表現出滿意態度。這項結果支持假設：生活公平感與民主態度之間具有正向關聯。

options(warn = -1)
library(dplyr)
library(tidyr)
library(sjmisc)
library(sjlabelled)
library(FactoMineR)
library(factoextra)

Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

library(corrplot)

corrplot 0.95 loaded

library(ggplot2)
library(stringr)
sjPlot::set_theme(theme.font = "PingFang TC")  

#這是我選擇的變數（新＋舊）
#Q45請問您的教育程度是什麼？
tiktok$Q45.new <- rec(
  tiktok$Q45,
  rec = "1=1 [不識字];
         2=2 [自修/小學];
         3=3 [國中/初職];
         4=4 [高中職];
         5=5 [專科];
         6=6 [大學];
         7=7 [碩士];
         8=8 [博士];
         90=90 [其它];
         97=97 [不知道];
         98=98 [拒答];
         else=NA",
  var.label = "教育程度",
  as.num = TRUE
)


# Q44 請問您的性別
 tiktok$Q44.new <- rec(
  tiktok$Q44,
  rec = "
    1=1 [男];
    2=2 [女];
    else=NA",
  var.label = "性別",
  as.num = TRUE
)


# Q47 請問您個人平均每個月所有的（稅前）收入差不多有多少？
 tiktok$Q47.new <- rec(
  tiktok$Q47,
  rec = "
    1=1 [無收入];
    2=2 [1萬元以下];
    3=3 [1萬元以上，不到2萬元];
    4=4 [2萬元以上，不到3萬元];
    5=5 [3萬元以上，不到4萬元];
    6=6 [4萬元以上，不到5萬元];
    7=7 [5萬元以上，不到6萬元];
    8=8 [6萬元以上，不到7萬元];
    9=9 [7萬元以上，不到8萬元];
    10=10 [8萬元以上，不到9萬元];
    11=11 [9萬元以上，不到10萬元];
    12=12 [10萬元以上，不到11萬元];
    13=13 [11萬元以上，不到12萬元];
    14=14 [12萬元以上，不到13萬元];
    15=15 [13萬元以上，不到14萬元];
    16=16 [14萬元以上，不到15萬元];
    17=17 [15萬元以上，不到16萬元];
    18=18 [16萬元以上，不到17萬元];
    19=19 [17萬元以上，不到18萬元];
    20=20 [18萬元以上，不到19萬元];
    21=21 [19萬元以上，不到20萬元];
    22=22 [20萬元以上，不到30萬元];
    23=23 [30萬元以上];
    97=97 [不知道];
    98=98 [拒答];
    else=NA",
  var.label = "每個月的收入多少",
  as.num = TRUE
)


# S0 請問您的西元出生年份

tiktok$thisyear <- 2025
tiktok$ages <- tiktok$thisyear - tiktok$S0

tiktok$S0.new <- rec(tiktok$S0, rec = "else=copy")
tiktok$S0.enw <- rec(tiktok$S0,
                     rec = "1:12=1 [2000s]; 13:22=2 [1990s]; 23:32=3[1980s]; 33:42=4[1970s]; 43:52=5[1960s]; else=6")


# S1 請問您最近一年有多常使用 TikTok 抖音？
tiktok$S1.new <- rec(
  tiktok$S1,
  rec = "
    1=1 [從來沒有];
    2=2 [很少使用];
    3=3 [每週數次];
    4=4 [每天一次];
    5=5 [每天好幾次];
    else=NA",
  var.label = "最近一年使用 TikTok 頻率",
  as.num = TRUE
)




# S2 請問您平常單次使用 TikTok 抖音大概的時間長度？
tiktok$S2.new <- rec(
  tiktok$S2,
  rec = "
    1=1 [10 分鐘以內];
    2=2 [10–30 分鐘以內];
    3=3 [30 分鐘至 1 小時以內];
    4=4 [1–3 小時以內];
    5=5 [3 小時以上];
    else=NA",
  var.label = "單次使用 TikTok 時長",
  as.num = TRUE
)

# Q12 請問整體而言您喜不喜歡現在的執政黨？
tiktok$Q12.new <- rec(
  tiktok$Q12,
  rec = "
    1=1 [非常不喜歡];
    2=2 [還滿不喜歡];
    3=3 [有點不喜歡];
    4=4 [有點喜歡];
    5=5 [還滿喜歡];
    6=6 [非常喜歡];
    else=NA",
  var.label = "喜不喜歡現在的政黨",
  as.num = TRUE
)


# Q15 整體來說，您對於我國民主的運作現況滿不滿意？
tiktok$Q15.new <- rec(
  tiktok$Q15,
  rec = "
    1=1 [非常不滿意];
    2=2 [還算不滿意];
    3=3 [有點不滿意];
    4=4 [有點滿意];
    5=5 [還算滿意];
    6=6 [非常滿意];
    else=NA",
  var.label = "對我國民主的運作現況滿不滿意",
  as.num = TRUE
)


# Q42 個人而言，您認為您目前的生活水準和您的努力比起來公不公平？
 tiktok$Q42.new <- rec(
  tiktok$Q42,
  rec = "
    1=1 [很不公平];
    2=2 [不太公平];
    3=3 [還算公平];
    4=4 [公平];
    5=5 [很公平];
    else=NA",
  var.label = "目前的生活水準和努力比起來公不公平",
  as.num = TRUE
)

# Q1 請問您平時日常生活中主要使用下列哪些社群平台/社群軟體？（複選最多五個） 
tiktok_long_Q1 <- tiktok %>%
  pivot_longer(
    cols = Q1_1:Q1_5,
    names_to = "選擇次序",
    values_to = "平台代碼"
  ) %>%
  mutate(
    平台 = rec(
      平台代碼,
      rec = "
        1=1 [臉書(Facebook)];
        2=2 [YouTube];
        3=3 [Instagram];
        4=4 [推特(Twitter)];
        5=5 [Threads];
        6=6 [Dcard];
        7=7 [PTT];
        8=8 [微博];
        9=9 [TikTok抖音];
        10=10 [LINE];
        11=11 [臉書聊天室(Messenger)];
        12=12 [小紅書];
        13=13 [微信(WeChat)];
        90=90 [其它];
        else=NA",
      var.label = "平常主要使用哪些社群平台/軟體",
      as.num = TRUE
    )
  )


# Q2 請問您過去一年來，較常從哪些管道得知政治或公共議題相關訊息？（複選最多三個） 
tiktok_long_Q2 <- tiktok %>%
  pivot_longer(
    cols = Q2_1:Q2_3,
    names_to = "選擇次序",
    values_to = "訊息來源代碼"
  ) %>%
  mutate(
    訊息來源 = rec(
      訊息來源代碼,
      rec = "
        1=1 [臉書(Facebook)];
        2=2 [YouTube];
        3=3 [Instagram];
        4=4 [推特(Twitter)];
        5=5 [Threads];
        6=6 [Dcard];
        7=7 [PTT];
        8=8 [微博];
        9=9 [TikTok抖音];
        10=10 [LINE];
        11=11 [臉書聊天室(Messenger)];
        12=12 [小紅書];
        13=13 [微信(WeChat)];
        90=90 [其它];
        else=NA",
      var.label = "過去一年來常從哪些管道得知政治或公共議題相關訊息",
      as.num = TRUE
    )
  )


# Q3 您由（上一題所勾選之管道）接收的政治與公共相關資訊，大多是來自於誰的觀點？（複選最多三個） 
tiktok_long_Q3 <- tiktok %>%
  pivot_longer(
    cols = Q3_1:Q3_3,
    names_to = "選擇次序",
    values_to = "資訊來源代碼"
  ) %>%
  mutate(
    資訊來源 = rec(
      資訊來源代碼,
      rec = "
        1=1 [新聞媒體與新聞台];
        2=2 [社群平台的KOL(網紅)或粉專];
        3=3 [某政治人物本身];
        4=4 [名嘴或時事評論員];
        5=5 [親朋好友];
        6=6 [點頭之交];
        7=7 [通常不會注意訊息是由誰發布];
        90=90 [其它];
        else=NA",
      var.label = "政治與公共相關資訊主要來自誰的觀點",
      as.num = TRUE
    )
  )


# Q4 請問在上述這些政治與公共相關觀點來源中，哪一個是您最為信賴的？
tiktok$Q4.new <- rec(
  tiktok$Q4,
  rec = "
        1=1 [新聞媒體與新聞台];
        2=2 [社群平台的KOL(網紅)或粉專];
        3=3 [某政治人物本身];
        4=4 [名嘴或時事評論員];
        5=5 [親朋好友];
        6=6 [點頭之交];
        7=7 [沒有可以信賴的];
        90=90 [其它];
        else=NA",
      var.label = "最近賴哪一個政治與公共相關觀點來源",
      as.num = TRUE
)


# Q5 沒有辦法上網時，您會很想上網。
tiktok$Q5.new <- rec(
  tiktok$Q5,
  rec = "
    1=1 [非常不同意];
    2=2 [不同意];
    3=3 [普通];
    4=4 [同意];
    5=5 [非常同意];
    else=NA",
  var.label = "對網路的依賴性",
  as.num = TRUE
)


# Q6 您會因為不能使用網路而感到沮喪、心情不好、或覺得緊張，但是只要能上網，這些情況就會改善
tiktok$Q6.new <- rec(
  tiktok$Q6,
  rec = "
    1=1 [非常不同意];
    2=2 [不同意];
    3=3 [普通];
    4=4 [同意];
    5=5 [非常同意];
    else=NA",
  var.label = "經常藉由網路來擺脫生活中令人煩惱的事",
  as.num = TRUE
)

library(dplyr)
library(tidyr)
library(sjmisc)
library(sjlabelled)
library(FactoMineR)
library(factoextra)
library(corrplot)
library(ggplot2)
library(stringr)
sjPlot::set_theme(theme.font = "PingFang TC")
# ===== 1) 依範例挑變數 → 全部轉 factor → 去 NA =====
vars_mca <- c(
  # 原本的9題
  "Q45.new", "Q44.new", "Q47.new", "S0.new", "S1.new", "S2.new", "Q12.new","Q15.new","Q42.new",
  # 新增的6題
  "Q1.new", "Q2.new", "Q3.new", "Q4.new", "Q5.new", "Q6.new"
)

# 如果有缺欄位，不報錯、直接略過（保證能跑）
vars_use <- intersect(vars_mca, names(tiktok))

tiktok_MCA <- tiktok %>%
  dplyr::select(all_of(vars_use)) %>%
  mutate(across(everything(), as.factor)) %>%
  tidyr::drop_na()

# 小小安全閥：把只剩 1 個水準的欄位移除（避免 FactoMineR ventilation 錯誤）
keep_cols <- vapply(tiktok_MCA, function(x) nlevels(droplevels(x)) >= 2, logical(1))
tiktok_MCA <- tiktok_MCA[, keep_cols, drop = FALSE]

# ===== 2) 跑 MCA（依範例 ncp=5）=====
res <- MCA(tiktok_MCA, ncp = 5, graph = FALSE)

# ===== 3) Scree Plot =====
fviz_screeplot(res, ncp = 5) +
  ggtitle("MCA 各維度解釋量（Scree Plot）") +
  theme_minimal()

invisible(fviz_contrib(res, choice = "var", axes = 1))
invisible(fviz_contrib(res, choice = "var", axes = 2))
invisible(fviz_mca_var(res))

Dim1：人口背景（年齡、教育、收入）軸，這是整份問卷裡最能把受訪者區分開的方向。

Dim2：網路依賴程度軸（Q5、Q6），這是第二重要的分群方向。

由此可知，受訪者最大的差異不是 TikTok 使用量，也不是政治滿意度，而是人口背景（年齡、收入、教育）。第二大差異是受訪者是否依賴網路。

library(dplyr)
library(tidyr)
library(sjmisc)
library(sjlabelled)
library(FactoMineR)
library(factoextra)
library(corrplot)
library(ggplot2)
library(stringr)
sjPlot::set_theme(theme.font = "PingFang TC")
# ===== 1) 依範例挑變數 → 全部轉 factor → 去 NA =====
vars_mca <- c(
  # 原本的9題
  "Q45.new", "Q44.new", "Q47.new", "S0.new", "S1.new", "S2.new", "Q12.new","Q15.new","Q42.new",
  # 新增的6題
  "Q1.new", "Q2.new", "Q3.new", "Q4.new", "Q5.new", "Q6.new"
)

# 如果有缺欄位，不報錯、直接略過（保證能跑）
vars_use <- intersect(vars_mca, names(tiktok))

tiktok_MCA <- tiktok %>%
  dplyr::select(all_of(vars_use)) %>%
  mutate(across(everything(), as.factor)) %>%
  tidyr::drop_na()

# 小小安全閥：把只剩 1 個水準的欄位移除（避免 FactoMineR ventilation 錯誤）
keep_cols <- vapply(tiktok_MCA, function(x) nlevels(droplevels(x)) >= 2, logical(1))
tiktok_MCA <- tiktok_MCA[, keep_cols, drop = FALSE]
#跑 MCA
res <- MCA(tiktok_MCA, ncp = 5, graph = FALSE)

#維度描述：看每個變數在各維度上的代表性 
library(corrplot)
plot(
  res, axes = c(1, 2), new.plot = TRUE,
  col.var = "red", col.ind = "black", col.ind.sup = "black",
  col.quali.sup = "darkgreen", col.quanti.sup = "blue",
  label = c("var"), cex = 0.8,
  selectMod = "cos2 30",
  invisible = c("ind", "quali.sup"),
  xlim = c(-1.2, 1.2),
  ylim = c(-0.6, 0.5),
  autoLab = "yes",
  title = ""
)

從前面的圖可知Dim1是人口背景軸；Dim2是網路依賴程度軸。

而這張圖告訴我們：

右上：Q5.new_5（非常同意：不能上網會焦慮）、Q6.new_5（非常同意：上網可以舒緩情緒），這代表很依賴網路的人往往會同時選Q5.new_5和Q6.new_5，這群人就是高度網路依賴，且使用行為偏強的族群。

左上：Q15.new_4（有點滿意民主）、Q12.new_4（有點喜歡執政黨）、Q12.new_3（中性）、S2.new_1（單次使用時間很短）Q6.new_3、Q5.new_3（普通程度依賴），看到這些特質我們可以知道，這群人抖音滑不多（S2.new_1），但依然「需要網路」。他們不是重度使用者，但心理依賴程度不低

右下：Q47.new_5（較高收入區間）、Q42.new_2（覺得生活不太公平）、Q15.new_3（有點不滿意民主）、S1.new_5（每天好多次使用），我們可以看出有人收入較高，又是抖音重度使用者，但因為是Dim2是負的，表示「心理依賴不強」，因此可以得出一個結論是這邊的族群社經地位不低、有些人抖音用得很兇，但心情不會因為不能上網而受波動，並且對民主略不滿意（Q15.new_3）。

左下：Q15.new_3（對民主運作有點不滿意）、Q6.new_3（會因為不能上網而沮喪但只要能上網就會改善：普通）、S1.new_2（很少使用抖音）、Q5.new_3（沒法上網時會很想上網：普通），可以看出這群人不太滑抖音、不太依賴網路，也對民主沒有太正向的感受。

# 維次貢獻：哪些「變數類別」對各維度影響最大
library(factoextra)

# 第一維度的重要變數類別（Dim1）
fviz_contrib(res, choice = "var", axes = 1)

# 第二維度的重要變數類別（Dim2）
fviz_contrib(res, choice = "var", axes = 2)

## 受訪者在 Dim1 × Dim2 的分佈
plot(
  res, axes = c(1, 2), new.plot = TRUE, choix = "ind",
  col.var = "red", col.quali.sup = "darkgreen",
  label = c("var"),
  selectMod = "cos2 15",  # 只顯示 cos2 前 15% 的受訪者
  select = "cos2 1",      # 同時標出貢獻最高的個別點
  xlim = c(-1, 1),
  invisible = c("quali.sup", "var"),
  title = ""
)

前面的Dim1和Dim2變數貢獻度圖，只是要表達Dim1和Dim2是各被哪些變數給拉出來的（例如Dim1是被S1.new_5使用頻率高、Q5.new_5、Q6.new_5高網路依賴等；同樣的Dim2也會有它被什麼變數給推動出來）。

而最後一張散布圖會顯示前面所說的左、右、上、下等各個象限所代表的含義，而我們可以看到大部分的受訪者都是集中在中央，表示多數人不會非常極端的落在變數的某一端。層級與政治帶度的差異是一點一點分散的。