# 社會研究法：《美國影視文化對臺灣人對美態度的影響》調查問卷 #######
setwd("~/Desktop/社會研究法")
rm(list = ls())
# Packages ######
library(readxl)
library(car)
## Loading required package: carData
library(magrittr)
library(mediation)
## Loading required package: MASS
## Loading required package: Matrix
## Loading required package: mvtnorm
## Loading required package: sandwich
## mediation: Causal Mediation Analysis
## Version: 4.5.0
library(multilevel)
## Warning: package 'multilevel' was built under R version 4.0.5
## Loading required package: nlme
library(bda)
## Loading required package: boot
##
## Attaching package: 'boot'
## The following object is masked from 'package:car':
##
## logit
## bda v15 (Bin Wang, 2021)
library(equatiomatic)
## Warning: package 'equatiomatic' was built under R version 4.0.5
## This version of bslib is designed to work with shiny version 1.6.0 or higher.
library(Hmisc)
## Loading required package: lattice
##
## Attaching package: 'lattice'
## The following object is masked from 'package:boot':
##
## melanoma
## Loading required package: survival
##
## Attaching package: 'survival'
## The following object is masked from 'package:boot':
##
## aml
## Loading required package: Formula
## Loading required package: ggplot2
##
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:base':
##
## format.pval, units
# Import Data ######
df <- read_xlsx("《美國影視文化對臺灣人對美態度的影響》調查問卷 (回覆).xlsx")
# recode ######
# Sex
df$`1. 性別` <- recode(df$`1. 性別`,
"'男性' = 'male'; '女性' = 'female'")
#Income
df$`6. 個人每月收入` <- recode(df$`6. 個人每月收入`,
"'20,000元以下' = '10000'; '20,000 ~ 40,000元' = '30000';
'40,000 ~ 60,000元' = '50000'; '60,000 ~ 80,000元' = '70000';
'80,000 ~ 100,000元' = '90000'; '100,000元以上' = '100000'") %>%
as.numeric()
# Education
df$`4. 教育程度` <- recode(df$`4. 教育程度`,
"'國小' = 6; '國中' = 9; '高中/職' = 12;
'大專' = 16; '研究所' = 18; else = 0")
# Gone America
df$`7. 請問您是否去過美國？` <- recode(df$`7. 請問您是否去過美國？`,
"'是' = 'yes'; '否' = 'no'")
# Theater
df$`9. 請問您最近半年內，平均一個月至電影院觀賞美國電影的次數？` <-
recode(df$`9. 請問您最近半年內，平均一個月至電影院觀賞美國電影的次數？`,
"'1次以下' = 0.5; '1 ~ 2次' = 1.5; '2 ~ 3次' = 2.5;
'3 ~ 4次' = 3.5; '4次以上' = 4")
# Movie
df$`10. 請問您最近半年，平均一個月觀賞過幾部美國電影？(不限方式)` <-
recode(df$`10. 請問您最近半年，平均一個月觀賞過幾部美國電影？(不限方式)`,
"'1部以下' = 0.5; '1 ~ 2部' = 1.5; '2 ~ 3部' = 2.5;
'3 ~ 4部' = 3.5; '4部以上' = 4")
# Video
df$`11. 請問您最近半年內，平均一個月觀賞過幾部（季）美國影集？（不限方式）` <-
recode(df$`11. 請問您最近半年內，平均一個月觀賞過幾部（季）美國影集？（不限方式）`,
"'1部以下' = 0.5; '1 ~ 2部' = 1.5; '2 ~ 3部' = 2.5;
'3 ~ 4部' = 3.5; '4部以上' = 4")
# Interest
df$`13. 請問您平時對於美國的電影、影集、動畫的關注程度為何？` <-
recode(df$`13. 請問您平時對於美國的電影、影集、動畫的關注程度為何？`,
"'非常喜愛且深入認識' = 4; '經常關注' = 3;
'有時關注' = 2; '不太關注' = 1")
# Hot Movie
df$`15. 在以下電影清單中，您看過幾部？` <-
recode(df$`15. 在以下電影清單中，您看過幾部？`,
"'2部以下' = 1; '2 ~ 4部' = 3; '4 ~ 6部' = 5;
'6 ~ 8部' = 7; '8 ~ 10部' = 9")
# Adervise
df$`16. 您是否會因為某產品出現在美國影視作品，進而使用該產品？` <-
recode(df$`16. 您是否會因為某產品出現在美國影視作品，進而使用該產品？`,
"'經常' = 4; '有時' = 3; '很少' = 2; '幾乎不' = 1")
# Issue
df$`17. 您是否會因為美國影視作品中出現的現象，因此關注相關議題？` <-
recode(df$`17. 您是否會因為美國影視作品中出現的現象，因此關注相關議題？`,
"'經常' = 4; '有時' = 3; '很少' = 2; '幾乎不' = 1")
# Difference
df$`18. 您認為美國影視作品中呈現的美國社會和現實存在差異？` <-
recode(df$`18. 您認為美國影視作品中呈現的美國社會和現實存在差異？`,
"'差異很大' = 2; '有些差異' = 1; '幾乎無差異' = 0")
# Difference in Society
df$`19. 您認為美國影視作品中美化或醜化其社會現況的比例為何？` <-
recode(df$`19. 您認為美國影視作品中美化或醜化其社會現況的比例為何？`,
"c('幾乎美化', '幾乎醜化') = 2; c('較多美化', '較多醜化') = 1")
# Difference in Government
df$`20. 您認為在美國影視作品中美化或醜化美國政府的比例？` <-
recode(df$`20. 您認為在美國影視作品中美化或醜化美國政府的比例？`,
"c('幾乎美化', '幾乎醜化') = 2; c('較多美化', '較多醜化') = 1")
# Difference in Movie
df$`22. 您是否認為台灣影視作品的風格和美國影視作品相近？` <-
recode(df$`22. 您是否認為台灣影視作品的風格和美國影視作品相近？`,
"'非常相近' = 1;'逐漸相近' = 2; '逐漸相異' = 3; '非常相異' = 4")
# Relaitionship in Family
df$`23. 您是否認同美國影視作品中，家庭成員間的互動關係？` <-
recode(df$`23. 您是否認同美國影視作品中，家庭成員間的互動關係？`,
"'非常認同' = 4; '能夠認同' = 3; '不太認同' = 2; '非常不認同' = 1")
# Difference in Values
df$`24. 您認為美國影視作品中所傳達的價值觀和臺灣普遍價值觀存在差異？` <-
recode(df$`24. 您認為美國影視作品中所傳達的價值觀和臺灣普遍價值觀存在差異？`,
"'差異很大' = 4; '有些差異' = 3; '少許差異' = 2; '無差異' = 1")
# Values
df$`26. 您是否認同美國影視作品中所傳達的價值觀？` <-
recode(df$`26. 您是否認同美國影視作品中所傳達的價值觀？`,
"'幾乎認同' = 4; '部分認同' = 3; '不太認同' = 2; '非常不認同' = 1")
# International Leading
df$`28. 您是否認為美國在國際上佔有主導地位？` <-
recode(df$`28. 您是否認為美國在國際上佔有主導地位？`,
"'非常認同' = 4; '大致認同' = 3; '不太認同' = 2; '不認同' = 1")
# Go America
df$`30. 您是否嚮往或計劃前往美國求學或工作？` <-
recode(df$`30. 您是否嚮往或計劃前往美國求學或工作？`,
"'非常嚮往' = 4; '有些嚮往' = 3; '不嚮往' = 1; '無意見' = 2")
# Close to US or China
df$`31. 您認為臺灣政府的外交政策應親中或親美？` <-
recode(df$`31. 您認為臺灣政府的外交政策應親中或親美？`,
"'傾向中國' = 1; '傾向美國' = 4; '保持平衡' = 2.5; '中美以外' = 2.5")
# Follow Policy (deplomatic)
df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [b. 外交]` <-
recode(df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [b. 外交]`,
"'完全相同' = 4; '大部分相同' = 3; '少部分相同' = 2; '完全不參考' = 1")
# Follow Policy (trading)
df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [c. 貿易]` <-
recode(df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [c. 貿易]`,
"'完全相同' = 4; '大部分相同' = 3; '少部分相同' = 2; '完全不參考' = 1")
# Follow Policy (social welfare)
df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [d. 社會福利]` <-
recode(df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [d. 社會福利]`,
"'完全相同' = 4; '大部分相同' = 3; '少部分相同' = 2; '完全不參考' = 1")
# Follow Policy (health)
df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [e. 衛生健康]` <-
recode(df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [e. 衛生健康]`,
"'完全相同' = 4; '大部分相同' = 3; '少部分相同' = 2; '完全不參考' = 1")
# Follow Policy (education)
df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [f. 教育]` <-
recode(df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [f. 教育]`,
"'完全相同' = 4; '大部分相同' = 3; '少部分相同' = 2; '完全不參考' = 1")
# Election
df$`33. 請問您是否有參與上一次的選舉或是公投？` <-
recode(df$`33. 請問您是否有參與上一次的選舉或是公投？`,
"'是' = 1; '否' = 0; '無投票權' = 0")
# Joint Signature
df$`34. 請問您是否參與過連署活動？` <-
recode(df$`34. 請問您是否參與過連署活動？`,
"'是' = 1; '否' = 0")
# Procession
df$`35. 請問您是否參與過遊行示威或社會運動？` <-
recode(df$`35. 請問您是否參與過遊行示威或社會運動？`,
"'是' = 1; '否' = 0")
# Constructing Variables #####
# Sex
df$sex = factor(df$`1. 性別`, levels = c('male', 'female'))
# Education
df$education <- df$`4. 教育程度`
# Income
df$income <- df$`6. 個人每月收入`
# Gone America
df$gone <- factor(df$`7. 請問您是否去過美國？`,
levels = c("no", 'yes'))
# Degree of following American Movies
df$movie <- df$`9. 請問您最近半年內，平均一個月至電影院觀賞美國電影的次數？` +
df$`10. 請問您最近半年，平均一個月觀賞過幾部美國電影？(不限方式)` +
df$`11. 請問您最近半年內，平均一個月觀賞過幾部（季）美國影集？（不限方式）` +
df$`13. 請問您平時對於美國的電影、影集、動畫的關注程度為何？` +
df$`15. 在以下電影清單中，您看過幾部？`
# Movement By Movie
df$movement <- df$`16. 您是否會因為某產品出現在美國影視作品，進而使用該產品？` +
df$`17. 您是否會因為美國影視作品中出現的現象，因此關注相關議題？`
# Difference in American Movie
df$diff_movie <- df$`18. 您認為美國影視作品中呈現的美國社會和現實存在差異？` +
df$`19. 您認為美國影視作品中美化或醜化其社會現況的比例為何？` +
df$`20. 您認為在美國影視作品中美化或醜化美國政府的比例？`
# Identify Relationship
df$identify <- df$`23. 您是否認同美國影視作品中，家庭成員間的互動關係？` +
df$`26. 您是否認同美國影視作品中所傳達的價值觀？`
# Difference between Taiwan and US
df$diff_between <- df$`22. 您是否認為台灣影視作品的風格和美國影視作品相近？` +
df$`24. 您認為美國影視作品中所傳達的價值觀和臺灣普遍價值觀存在差異？`
# America is Good
df$goodness <- df$`28. 您是否認為美國在國際上佔有主導地位？` +
df$`30. 您是否嚮往或計劃前往美國求學或工作？` +
df$`31. 您認為臺灣政府的外交政策應親中或親美？`
# Follow Policy
df$policy <- df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [b. 外交]` +
df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [c. 貿易]` +
df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [d. 社會福利]` +
df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [e. 衛生健康]` +
df$`32. 您認為台灣政府在以下方面政策應和美國政府抱持相同立場？ [f. 教育]`
# Political Participation
df$participate <- df$`33. 請問您是否有參與上一次的選舉或是公投？` +
df$`34. 請問您是否參與過連署活動？` +
df$`35. 請問您是否參與過遊行示威或社會運動？`
variables <- c("sex", "education", "income", "gone",
"movie", "movement", "diff_movie",
"identify", "diff_between", "goodness",
"policy", "participate")
df[variables] %>%
dplyr::summarise(across(where(is.numeric), ~mean(.x, na.rm = TRUE))) %>%
tidyr::pivot_longer(cols = everything(), names_to = "Variables", values_to = "Mean") %>%
print
## # A tibble: 10 × 2
## Variables Mean
## <chr> <dbl>
## 1 education 15.1
## 2 income 20667.
## 3 movie 12.5
## 4 movement 4.58
## 5 diff_movie 3.28
## 6 identify 6.13
## 7 diff_between 6.36
## 8 goodness 9.39
## 9 policy 12.7
## 10 participate 1.70
# Modeling #######
# model1: Identify as Dependent variable
model1 <- lm(identify ~ sex + education + income +
gone + movie + movement + diff_movie + diff_between,
data = df)
summary(model1)
##
## Call:
## lm(formula = identify ~ sex + education + income + gone + movie +
## movement + diff_movie + diff_between, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.8303 -0.2831 -0.1058 0.3455 2.1352
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.498e+00 6.054e-01 10.733 <2e-16 ***
## sexfemale -4.357e-02 1.279e-01 -0.341 0.7339
## education -2.117e-02 1.499e-02 -1.412 0.1603
## income -2.219e-07 2.778e-06 -0.080 0.9364
## goneyes 6.458e-02 1.651e-01 0.391 0.6964
## movie 1.015e-02 1.475e-02 0.688 0.4928
## movement 1.060e-01 4.956e-02 2.138 0.0344 *
## diff_movie -1.989e-01 9.937e-02 -2.002 0.0475 *
## diff_between 1.767e-03 5.798e-02 0.030 0.9757
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6987 on 125 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.09702, Adjusted R-squared: 0.03923
## F-statistic: 1.679 on 8 and 125 DF, p-value: 0.1099
# model2: Follow Policy as Dependent
model2 <- lm(policy ~ sex + education + income +
gone + movie + movement + diff_movie + diff_between +
identify + participate,
data = df)
summary(model2)
##
## Call:
## lm(formula = policy ~ sex + education + income + gone + movie +
## movement + diff_movie + diff_between + identify + participate,
## data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.3747 -1.2592 0.0652 1.1710 6.5532
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.340e+01 2.738e+00 4.894 3.03e-06 ***
## sexfemale -1.637e-01 4.174e-01 -0.392 0.69564
## education 3.314e-04 4.972e-02 0.007 0.99469
## income 8.285e-06 9.120e-06 0.908 0.36543
## goneyes -3.447e-01 5.414e-01 -0.637 0.52554
## movie -5.383e-02 4.827e-02 -1.115 0.26698
## movement 4.651e-01 1.689e-01 2.754 0.00677 **
## diff_movie -9.972e-01 3.323e-01 -3.001 0.00326 **
## diff_between -2.132e-01 1.899e-01 -1.123 0.26357
## identify 3.997e-01 2.929e-01 1.364 0.17490
## participate 3.631e-02 2.128e-01 0.171 0.86477
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.279 on 123 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.1774, Adjusted R-squared: 0.1105
## F-statistic: 2.652 on 10 and 123 DF, p-value: 0.005779
# Test Mediation Effect ########
#Sobel test
sobel(df$movement, df$identify, df$policy)
## $`Mod1: Y~X`
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 10.6876759 0.7250599 14.740404 9.408128e-30
## pred 0.4501032 0.1521440 2.958403 3.661322e-03
##
## $`Mod2: Y~X+M`
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.7485057 1.7598579 4.402916 2.185744e-05
## pred 0.3923223 0.1540895 2.546068 1.204328e-02
## med 0.5229704 0.2858281 1.829668 6.955608e-02
##
## $`Mod3: M~X`
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.6201463 0.21804373 25.775317 1.425747e-53
## pred 0.1104858 0.04575351 2.414806 1.710340e-02
##
## $Indirect.Effect
## [1] 0.05778082
##
## $SE
## [1] 0.03962108
##
## $z.value
## [1] 1.458335
##
## $N
## [1] 135
mediation.test(df$identify, df$movement, df$policy)
## Sobel Aroian Goodman
## z.value 1.4583355 1.3848492 1.5449168
## p.value 0.1447481 0.1660986 0.1223664
# Bootstraping
fitM <- lm(identify ~ movement, data = df)
fitY <- lm(policy ~ identify + movement, data = df)
fitMed <- mediate(fitM, fitY, treat="movement", mediator="identify")
summary(fitMed)
##
## Causal Mediation Analysis
##
## Quasi-Bayesian Confidence Intervals
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME 0.0576 -0.0114 0.16 0.098 .
## ADE 0.3887 0.0907 0.70 0.020 *
## Total Effect 0.4463 0.1455 0.76 0.008 **
## Prop. Mediated 0.1208 -0.0305 0.48 0.106
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 135
##
##
## Simulations: 1000
plot(fitMed)
