關懷原則與道德判斷的關聯性探索
歐雅欣
2020/12/20
資料說明
## 資料說明
## 資料來源：微笑小熊調查小棧平台
## 問卷名稱：編號1351「十分鐘鍵盤法官」
## 調查期間：2020年7月20日至2020年8月18日
## 有效觀察值N=1,054初步處理資料檔
# 讀入資料檔並將變數名稱字串轉為變數標籤
library(readr)
x1351 <- read_csv("x1351.csv")## Warning: Duplicated column names deduplicated: '（非必填。如果有其它想法，歡迎
## 填寫在下方框框裡噢！）' => '（非必填。如果有其它想法，歡迎填寫在下方框框裡噢！）
## _1' [19], '（非必填。如果有其它想法，歡迎填寫在下方框框裡噢！）' => '（非必填。
## 如果有其它想法，歡迎填寫在下方框框裡噢！）_2' [25], '（非必填。如果有其它想法，
## 歡迎填寫在下方框框裡噢！）' => '（非必填。如果有其它想法，歡迎填寫在下方框框裡
## 噢！）_3' [32], '（非必填。如果有其它想法，歡迎填寫在下方框框裡噢！）' => '（非
## 必填。如果有其它想法，歡迎填寫在下方框框裡噢！）_4' [39]##
## -- Column specification --------------------------------------------------------
## cols(
## .default = col_double(),
## Residence = col_character(),
## Job = col_character(),
## `（非必填。如果有其它想法，歡迎填寫在下方框框裡噢！）` = col_character(),
## `（非必填。如果有其它想法，歡迎填寫在下方框框裡噢！）_1` = col_character(),
## `（非必填。如果有其它想法，歡迎填寫在下方框框裡噢！）_2` = col_character(),
## `（非必填。如果有其它想法，歡迎填寫在下方框框裡噢！）_3` = col_character(),
## `（非必填。如果有其它想法，歡迎填寫在下方框框裡噢！）_4` = col_character()
## )
## i Use `spec()` for the full column specifications.View(x1351)
nrow(x1351)## [1] 1043ncol(x1351)## [1] 41# 取出變數名稱當作變數標籤
varlabels <- colnames(x1351)
# 拿掉標籤之後的變數名稱重新命名為V1, V2, ...至v41
colnames(x1351)[1:41] <- paste("v", 1:41, sep="")
# 為變數名稱裝上標籤
sjlabelled::set_label(x1351) <- varlabels
# 批次處理無效值
x1351 <- sjmisc::set_na(x1351, na= "NA")變數編碼與描述
#列出每個變數的標籤
library(sjmisc)
library(sjPlot)## #refugeeswelcomenames(x1351)## [1] "v1" "v2" "v3" "v4" "v5" "v6" "v7" "v8" "v9" "v10" "v11" "v12"
## [13] "v13" "v14" "v15" "v16" "v17" "v18" "v19" "v20" "v21" "v22" "v23" "v24"
## [25] "v25" "v26" "v27" "v28" "v29" "v30" "v31" "v32" "v33" "v34" "v35" "v36"
## [37] "v37" "v38" "v39" "v40" "v41"## 依變數：「關懷原則對於衡量行為對與錯具相關性」
# (v7)想像有一個大型社會案件，對於這件事的對錯，「有沒有人在情感上受到傷害」，與你的判斷有多相關？
# (1)毫不相關 (2)不太相關 (3)只有一點相關 (4)一定程度相關 (5)特別相關 (6)絕對相關
table(x1351$v7)##
## 1 2 3 4 5 6
## 57 142 251 517 46 30x1351$v7r <- rec(x1351$v7, rec = "1:2=0; 3:6=1", as.num = F)
frq(x1351$v7)##
## 對於這件事的對錯，「有沒有人在情感上受到傷害」，與你的判斷有多相關？ (x) <numeric>
## # total N=1043 valid N=1043 mean=3.42 sd=1.05
##
## Value | N | Raw % | Valid % | Cum. %
## --------------------------------------
## 1 | 57 | 5.47 | 5.47 | 5.47
## 2 | 142 | 13.61 | 13.61 | 19.08
## 3 | 251 | 24.07 | 24.07 | 43.14
## 4 | 517 | 49.57 | 49.57 | 92.71
## 5 | 46 | 4.41 | 4.41 | 97.12
## 6 | 30 | 2.88 | 2.88 | 100.00
## <NA> | 0 | 0.00 | <NA> | <NA>frq(x1351$v7r)##
## 對於這件事的對錯，「有沒有人在情感上受到傷害」，與你的判斷有多相關？ (x) <categorical>
## # total N=1043 valid N=1043 mean=0.81 sd=0.39
##
## Value | N | Raw % | Valid % | Cum. %
## --------------------------------------
## 0 | 199 | 19.08 | 19.08 | 19.08
## 1 | 844 | 80.92 | 80.92 | 100.00
## <NA> | 0 | 0.00 | <NA> | <NA>plot_frq(x1351$v7r)
## 自變數
# 1.「關懷弱勢的人」
# (v14) 而在這個事件中的當事人，那他「有沒有展現過關懷弱勢、或關懷受到傷害的人」與你判斷此事的對錯，有多相關呢？
# (1)毫不相關 (2)不太相關 (3)只有一點相關 (4)一定程度相關 (5)特別相關 (6)絕對相關
table(x1351$v14)##
## 1 2 3 4 5 6
## 96 205 303 353 62 24x1351$v14r <- rec(x1351$v14, rec = "1=6; 2=5; 3=4; 4=3; 5=2; 6=1", as.num = F)
frq(x1351$v14r)##
## 那他「有沒有展現過關懷弱勢、或關懷受到傷害的人」與你判斷此事的對錯，有多相關呢？ (x) <categorical>
## # total N=1043 valid N=1043 mean=3.85 sd=1.15
##
## Value | N | Raw % | Valid % | Cum. %
## --------------------------------------
## 1 | 24 | 2.30 | 2.30 | 2.30
## 2 | 62 | 5.94 | 5.94 | 8.25
## 3 | 353 | 33.84 | 33.84 | 42.09
## 4 | 303 | 29.05 | 29.05 | 71.14
## 5 | 205 | 19.65 | 19.65 | 90.80
## 6 | 96 | 9.20 | 9.20 | 100.00
## <NA> | 0 | 0.00 | <NA> | <NA>plot_frq(x1351$v14r)
# 2.「做出殘忍的行為」
# (v20)對於這件事的對錯，他「有沒有做令人覺得慘忍的事」，與你的判斷有多相關？
# (1)毫不相關 (2)不太相關 (3)只有一點相關 (4)一定程度相關 (5)特別相關 (6)絕對相關
table(x1351$v20)##
## 1 2 3 4 5 6
## 30 60 153 388 228 184x1351$v20r <- rec(x1351$v20, rec = "1=6; 2=5; 3=4; 4=3; 5=2; 6=1", as.num = F)
frq(x1351$v20r)##
## 對於這件事的對錯，他「有沒有做令人覺得殘忍的事」，與你的判斷有多相關？ (x) <categorical>
## # total N=1043 valid N=1043 mean=2.78 sd=1.23
##
## Value | N | Raw % | Valid % | Cum. %
## --------------------------------------
## 1 | 184 | 17.64 | 17.64 | 17.64
## 2 | 228 | 21.86 | 21.86 | 39.50
## 3 | 388 | 37.20 | 37.20 | 76.70
## 4 | 153 | 14.67 | 14.67 | 91.37
## 5 | 60 | 5.75 | 5.75 | 97.12
## 6 | 30 | 2.88 | 2.88 | 100.00
## <NA> | 0 | 0.00 | <NA> | <NA>plot_frq(x1351$v20r)
# 3.「同情心」
# (v26)接下來的這些話，請你拉拉看，同意或不同意的程度。「對受害者展現同情，是最重要的美德。」
# (0)非常不同意 (1)算是不同意 (2)稍微偏向不同意 (3)稍微偏向同意 (4)算是同意 (5)非常同意
table(x1351$v26)##
## 0 1 2 3 4 5
## 53 118 213 408 191 60x1351$v26r <- rec(x1351$v26, rec = "0=6; 1=5; 2=4; 3=3; 4=2; 5=1", as.num = F)
frq(x1351$v26r)##
## 「對受害者展現同情，是最重要的美德。」 (x) <categorical>
## # total N=1043 valid N=1043 mean=3.28 sd=1.20
##
## Value | N | Raw % | Valid % | Cum. %
## --------------------------------------
## 1 | 60 | 5.75 | 5.75 | 5.75
## 2 | 191 | 18.31 | 18.31 | 24.07
## 3 | 408 | 39.12 | 39.12 | 63.18
## 4 | 213 | 20.42 | 20.42 | 83.60
## 5 | 118 | 11.31 | 11.31 | 94.92
## 6 | 53 | 5.08 | 5.08 | 100.00
## <NA> | 0 | 0.00 | <NA> | <NA>plot_frq(x1351$v26r)
# 4.「憐憫動物的心」
# (v31)接下來的這些話，請你拉拉看，同意或不同意的程度。「傷害毫無抵抗能力的動物，是件極為糟糕的事。」
# (0)非常不同意 (1)算是不同意 (2)稍微偏向不同意 (3)稍微偏向同意 (4)算是同意 (5)非常同意
table(x1351$v31)##
## 0 1 2 3 4 5
## 5 13 57 163 260 545x1351$v31r <- rec(x1351$v31, rec = "0=6; 1=5; 2=4; 3=3; 4=2; 5=1", as.num = F)
frq(x1351$v31r)##
## 「傷害毫無抵抗能力的動物，是件極為糟糕的事。」 (x) <categorical>
## # total N=1043 valid N=1043 mean=1.80 sd=1.02
##
## Value | N | Raw % | Valid % | Cum. %
## --------------------------------------
## 1 | 545 | 52.25 | 52.25 | 52.25
## 2 | 260 | 24.93 | 24.93 | 77.18
## 3 | 163 | 15.63 | 15.63 | 92.81
## 4 | 57 | 5.47 | 5.47 | 98.27
## 5 | 13 | 1.25 | 1.25 | 99.52
## 6 | 5 | 0.48 | 0.48 | 100.00
## <NA> | 0 | 0.00 | <NA> | <NA>plot_frq(x1351$v31r)
# 5.「包容殺人行為程度」
# (v37)接下來的這些話，請你拉拉看，同意或不同意的程度。「殺人無論如何都是不對的。」
# (0)非常不同意 (1)算是不同意 (2)稍微偏向不同意 (3)稍微偏向同意 (4)算是同意 (5)非常同意
table(x1351$v37)##
## 0 1 2 3 4 5
## 24 38 114 216 293 358x1351$v37r <- rec(x1351$v37, rec = "0=6; 1=5; 2=4; 3=3; 4=2; 5=1", as.num = F)
frq(x1351$v37r)##
## 「殺人無論如何都是不對的。」 (x) <categorical>
## # total N=1043 valid N=1043 mean=2.28 sd=1.27
##
## Value | N | Raw % | Valid % | Cum. %
## --------------------------------------
## 1 | 358 | 34.32 | 34.32 | 34.32
## 2 | 293 | 28.09 | 28.09 | 62.42
## 3 | 216 | 20.71 | 20.71 | 83.13
## 4 | 114 | 10.93 | 10.93 | 94.06
## 5 | 38 | 3.64 | 3.64 | 97.70
## 6 | 24 | 2.30 | 2.30 | 100.00
## <NA> | 0 | 0.00 | <NA> | <NA>plot_frq(x1351$v37r)
## 控制變數
# (v1)性別
# (1) 男 (2)女
table(x1351$v1)##
## 0 1
## 586 457x1351$v1r <- rec(x1351$v1, rec = "1=1; 2=0", as.num = F)
frq(x1351$v1r)##
## Gender (x) <categorical>
## # total N=1043 valid N=457 mean=1.00 sd=0.00
##
## Value | N | Raw % | Valid % | Cum. %
## --------------------------------------
## 1 | 457 | 43.82 | 100 | 100
## <NA> | 586 | 56.18 | <NA> | <NA># (v2)年齡，西元年age=(2020-x1351$v2)
frq(x1351$v2)##
## Born year (x) <numeric>
## # total N=1043 valid N=1043 mean=1983.87 sd=11.06
##
## Value | N | Raw % | Valid % | Cum. %
## -------------------------------------
## 1934 | 1 | 0.10 | 0.10 | 0.10
## 1939 | 1 | 0.10 | 0.10 | 0.19
## 1940 | 1 | 0.10 | 0.10 | 0.29
## 1941 | 1 | 0.10 | 0.10 | 0.38
## 1950 | 3 | 0.29 | 0.29 | 0.67
## 1951 | 1 | 0.10 | 0.10 | 0.77
## 1952 | 2 | 0.19 | 0.19 | 0.96
## 1953 | 1 | 0.10 | 0.10 | 1.05
## 1954 | 1 | 0.10 | 0.10 | 1.15
## 1955 | 8 | 0.77 | 0.77 | 1.92
## 1956 | 5 | 0.48 | 0.48 | 2.40
## 1957 | 3 | 0.29 | 0.29 | 2.68
## 1958 | 2 | 0.19 | 0.19 | 2.88
## 1959 | 1 | 0.10 | 0.10 | 2.97
## 1960 | 5 | 0.48 | 0.48 | 3.45
## 1961 | 5 | 0.48 | 0.48 | 3.93
## 1962 | 6 | 0.58 | 0.58 | 4.51
## 1963 | 9 | 0.86 | 0.86 | 5.37
## 1964 | 7 | 0.67 | 0.67 | 6.04
## 1965 | 6 | 0.58 | 0.58 | 6.62
## 1966 | 11 | 1.05 | 1.05 | 7.67
## 1967 | 8 | 0.77 | 0.77 | 8.44
## 1968 | 10 | 0.96 | 0.96 | 9.40
## 1969 | 9 | 0.86 | 0.86 | 10.26
## 1970 | 24 | 2.30 | 2.30 | 12.56
## 1971 | 15 | 1.44 | 1.44 | 14.00
## 1972 | 17 | 1.63 | 1.63 | 15.63
## 1973 | 22 | 2.11 | 2.11 | 17.74
## 1974 | 14 | 1.34 | 1.34 | 19.08
## 1975 | 18 | 1.73 | 1.73 | 20.81
## 1976 | 18 | 1.73 | 1.73 | 22.53
## 1977 | 14 | 1.34 | 1.34 | 23.87
## 1978 | 32 | 3.07 | 3.07 | 26.94
## 1979 | 28 | 2.68 | 2.68 | 29.63
## 1980 | 24 | 2.30 | 2.30 | 31.93
## 1981 | 37 | 3.55 | 3.55 | 35.47
## 1982 | 42 | 4.03 | 4.03 | 39.50
## 1983 | 31 | 2.97 | 2.97 | 42.47
## 1984 | 39 | 3.74 | 3.74 | 46.21
## 1985 | 44 | 4.22 | 4.22 | 50.43
## 1986 | 28 | 2.68 | 2.68 | 53.12
## 1987 | 37 | 3.55 | 3.55 | 56.66
## 1988 | 52 | 4.99 | 4.99 | 61.65
## 1989 | 34 | 3.26 | 3.26 | 64.91
## 1990 | 52 | 4.99 | 4.99 | 69.89
## 1991 | 33 | 3.16 | 3.16 | 73.06
## 1992 | 38 | 3.64 | 3.64 | 76.70
## 1993 | 39 | 3.74 | 3.74 | 80.44
## 1994 | 37 | 3.55 | 3.55 | 83.99
## 1995 | 43 | 4.12 | 4.12 | 88.11
## 1996 | 22 | 2.11 | 2.11 | 90.22
## 1997 | 34 | 3.26 | 3.26 | 93.48
## 1998 | 14 | 1.34 | 1.34 | 94.82
## 1999 | 20 | 1.92 | 1.92 | 96.74
## 2000 | 9 | 0.86 | 0.86 | 97.60
## 2001 | 18 | 1.73 | 1.73 | 99.33
## 2002 | 1 | 0.10 | 0.10 | 99.42
## 2003 | 3 | 0.29 | 0.29 | 99.71
## 2007 | 1 | 0.10 | 0.10 | 99.81
## 2019 | 2 | 0.19 | 0.19 | 100.00
## <NA> | 0 | 0.00 | <NA> | <NA> table(x1351$v2, exclude = NULL)##
## 1934 1939 1940 1941 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961
## 1 1 1 1 3 1 2 1 1 8 5 3 2 1 5 5
## 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977
## 6 9 7 6 11 8 10 9 24 15 17 22 14 18 18 14
## 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993
## 32 28 24 37 42 31 39 44 28 37 52 34 52 33 38 39
## 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2007 2019
## 37 43 22 34 14 20 9 18 1 3 1 2 x1351$age <- 2020-x1351$v2
hist(table(x1351$age))
plot_frq(x1351$age, type = "hist")
x1351$generation <- NA
x1351$generation[x1351$age>=(2020-1949)] <- 1
x1351$generation[x1351$age<=(2020-1950) & x1351$age>=(2020-1969)] <- 2
x1351$generation[x1351$age<=(2020-1970) & x1351$age>=(2020-1979)] <- 3
x1351$generation[x1351$age<=(2020-1980) & x1351$age>=(2020-1989)] <- 4
x1351$generation[x1351$age<=(2020-1990) & x1351$age>=(2020-1999)] <- 5
x1351$generation[x1351$age<=(2020-2000)] <- 6 #less than 20
table(x1351$generation)##
## 1 2 3 4 5 6
## 4 103 202 368 332 34## 為每個世代做虛擬變數
attach(x1351)
x1351$gen.1 <- ifelse(x1351$generation==1,1,0)
x1351$gen.2 <- ifelse(x1351$generation==2,1,0)
x1351$gen.3 <- ifelse(x1351$generation==3,1,0)
x1351$gen.4 <- ifelse(x1351$generation==4,1,0)
x1351$gen.5 <- ifelse(x1351$generation==5,1,0)
x1351$gen.6 <- ifelse(x1351$generation==6,1,0)
detach(x1351)
# (v3)教育程度
# (01)國小(或以下) (02)初中、國中 (03)高中、高職 (04)專科 (05)大學 (06)研究所(或以上)
table(x1351$v3)##
## 1 2 3 4 5 6
## 9 11 114 120 616 172x1351$v3r <- rec(x1351$v3, rec = "1:3=0; 4:6=1", as.num = F)
frq(x1351$v3r)##
## EDU (x) <categorical>
## # total N=1043 valid N=1042 mean=0.87 sd=0.33
##
## Value | N | Raw % | Valid % | Cum. %
## --------------------------------------
## 0 | 134 | 12.85 | 12.86 | 12.86
## 1 | 908 | 87.06 | 87.14 | 100.00
## <NA> | 1 | 0.10 | <NA> | <NA>#(v4)居住地
#(01)台北市 (02)新北市 (03)基隆市 (04)桃園市 (05)新竹市 (06)新竹縣 (07)苗栗縣 (08)台中市 (09)彰化縣 (10)南投縣 (11)雲林縣 (12)嘉義市 (13)嘉義縣 (14)台南市 (15)高雄市 (16)屏東縣 (17)台東縣 (18)花蓮縣 (19)宜蘭縣 (20)澎湖縣 (21)金門縣 (22)中國大陸(含香港、澳門)地區 (23)其他地區
table(x1351$v4)##
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 132 229 12 88 26 20 15 138 26 9 21 10 14 96 166 12 2 2 10 4
## 21 24
## 2 8x1351$v4r <- rec(x1351$v4, rec = "1:19=0; 20:23=1", as.num = F)
names(x1351)## [1] "v1" "v2" "v3" "v4" "v5"
## [6] "v6" "v7" "v8" "v9" "v10"
## [11] "v11" "v12" "v13" "v14" "v15"
## [16] "v16" "v17" "v18" "v19" "v20"
## [21] "v21" "v22" "v23" "v24" "v25"
## [26] "v26" "v27" "v28" "v29" "v30"
## [31] "v31" "v32" "v33" "v34" "v35"
## [36] "v36" "v37" "v38" "v39" "v40"
## [41] "v41" "v7r" "v14r" "v20r" "v26r"
## [46] "v31r" "v37r" "v1r" "age" "generation"
## [51] "gen.1" "gen.2" "gen.3" "gen.4" "gen.5"
## [56] "gen.6" "v3r" "v4r"save(x1351, file = "x1351.rda")
rm(list = ls())變數分布分析
## 變數分布分析
## 依變數
## 本研究的依變數為「一個社會事件的對錯，與有沒有人在情感上受到傷害有關」。資料顯示，有高達80.9%(844人)的受訪者認同關懷準則會影響評斷一個人(或一件事)的對或錯;只有19.1%(199人)認為毫不相關或不太相關，顯示大部分民眾會基於道德的關懷原則來判斷一個人或事件的對與錯。
## 自變數
## 5個自變數，分別是當事人「事件中當事人有無展現關懷弱勢」、「事件中當事人有無做出殘忍行為」、「對受害者展現同情是最重要美德」認同度、對「傷害無抵抗力的動物是糟糕」的認同度、對「殺人無論如何是不對」的認同度。
## 本研究雖然有33.8%(353人)認為變數「有無關懷弱勢」對評斷對錯有一定程度相關，但有29.0%(303人)表示只有一點相關、19.7%(205人)則認為不太相關。對變數「做出殘忍行為」有37.2%(388人)表示有一定程度相關、更有21.9%(228人)表示特別相關，17.6%(184人)是絕對相關。有39.1%(408人)對於變數「對受害者展現同情是最重要的美德認同度」稍微偏向同意、20.4%(213人)則是稍微偏向不同意，18.3%(191人)表示算是同意。對變數「認同傷害無抵抗力動物事件糟糕的事」有52.2%(545人)非常同意，也有24.9%(260人)算是同意。對於變數「包容殺人程度」，34.3%(358人)受訪者非常同意「殺人無論如何都是不對的」，也有28.1%(293人)算是同意。假設
## 假設
## *假設一(v14)：不關心弱勢的人不會以關懷原則去衡量一個人的對與錯
## *假設二(v20)：容忍殘忍行為的人就會降低以關懷原則去衡量一個人的對與錯
## 假設三(v26)：沒有同情心的人就會降低以關懷原則去衡量別人的對與錯
## 假設四(v31)：不具憐憫動物心的人不會以關懷原則去衡量一個人的對與錯
## *假設五(v37)：較能包容殺人行為的人會降低以關懷原則去衡量一個人的對與錯確認式分析
## 確認式分析，二元勝算對數模型
library(car)## Loading required package: carData## Registered S3 methods overwritten by 'car':
## method from
## influence.merMod lme4
## cooks.distance.influence.merMod lme4
## dfbeta.influence.merMod lme4
## dfbetas.influence.merMod lme4library(sjPlot)
load("x1351.rda")
## 模型一：包含所有自變數的原始模型
mod.1 <- glm(v7r ~ v14r+v20r+v26r+v31r+v37r,
data=x1351,
family=binomial)
summary(mod.1) ##
## Call:
## glm(formula = v7r ~ v14r + v20r + v26r + v31r + v37r, family = binomial,
## data = x1351)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.8004 0.2949 0.4143 0.5289 1.6723
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.08599 1.31676 3.103 0.00192 **
## v14r2 -1.74323 1.35154 -1.290 0.19712
## v14r3 -1.90442 1.29180 -1.474 0.14042
## v14r4 -1.98880 1.28957 -1.542 0.12302
## v14r5 -3.11209 1.28359 -2.425 0.01533 *
## v14r6 -3.73198 1.28537 -2.903 0.00369 **
## v20r2 -0.08236 0.33007 -0.250 0.80295
## v20r3 -0.17446 0.30031 -0.581 0.56129
## v20r4 -0.59801 0.35018 -1.708 0.08769 .
## v20r5 -1.89206 0.40042 -4.725 2.30e-06 ***
## v20r6 -3.77933 0.83461 -4.528 5.95e-06 ***
## v26r2 0.52882 0.52108 1.015 0.31017
## v26r3 -0.01042 0.47229 -0.022 0.98240
## v26r4 0.05576 0.49580 0.112 0.91046
## v26r5 -0.12410 0.52024 -0.239 0.81145
## v26r6 -0.28323 0.56956 -0.497 0.61900
## v31r2 -0.08914 0.23526 -0.379 0.70475
## v31r3 -0.02513 0.29204 -0.086 0.93142
## v31r4 -0.44214 0.39915 -1.108 0.26799
## v31r5 -0.57789 0.75297 -0.767 0.44280
## v31r6 0.29253 1.22323 0.239 0.81099
## v37r2 0.57797 0.24580 2.351 0.01870 *
## v37r3 0.43256 0.26672 1.622 0.10485
## v37r4 0.24129 0.31345 0.770 0.44142
## v37r5 0.55895 0.49823 1.122 0.26192
## v37r6 0.69226 0.62539 1.107 0.26833
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1016.66 on 1042 degrees of freedom
## Residual deviance: 794.57 on 1017 degrees of freedom
## AIC: 846.57
##
## Number of Fisher Scoring iterations: 6## 共線性檢定
vif(mod.1)## GVIF Df GVIF^(1/(2*Df))
## v14r 1.795326 5 1.060265
## v20r 1.865841 5 1.064357
## v26r 1.511413 5 1.042169
## v31r 1.886401 5 1.065524
## v37r 1.577276 5 1.046624summary(mod.1)##
## Call:
## glm(formula = v7r ~ v14r + v20r + v26r + v31r + v37r, family = binomial,
## data = x1351)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.8004 0.2949 0.4143 0.5289 1.6723
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.08599 1.31676 3.103 0.00192 **
## v14r2 -1.74323 1.35154 -1.290 0.19712
## v14r3 -1.90442 1.29180 -1.474 0.14042
## v14r4 -1.98880 1.28957 -1.542 0.12302
## v14r5 -3.11209 1.28359 -2.425 0.01533 *
## v14r6 -3.73198 1.28537 -2.903 0.00369 **
## v20r2 -0.08236 0.33007 -0.250 0.80295
## v20r3 -0.17446 0.30031 -0.581 0.56129
## v20r4 -0.59801 0.35018 -1.708 0.08769 .
## v20r5 -1.89206 0.40042 -4.725 2.30e-06 ***
## v20r6 -3.77933 0.83461 -4.528 5.95e-06 ***
## v26r2 0.52882 0.52108 1.015 0.31017
## v26r3 -0.01042 0.47229 -0.022 0.98240
## v26r4 0.05576 0.49580 0.112 0.91046
## v26r5 -0.12410 0.52024 -0.239 0.81145
## v26r6 -0.28323 0.56956 -0.497 0.61900
## v31r2 -0.08914 0.23526 -0.379 0.70475
## v31r3 -0.02513 0.29204 -0.086 0.93142
## v31r4 -0.44214 0.39915 -1.108 0.26799
## v31r5 -0.57789 0.75297 -0.767 0.44280
## v31r6 0.29253 1.22323 0.239 0.81099
## v37r2 0.57797 0.24580 2.351 0.01870 *
## v37r3 0.43256 0.26672 1.622 0.10485
## v37r4 0.24129 0.31345 0.770 0.44142
## v37r5 0.55895 0.49823 1.122 0.26192
## v37r6 0.69226 0.62539 1.107 0.26833
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1016.66 on 1042 degrees of freedom
## Residual deviance: 794.57 on 1017 degrees of freedom
## AIC: 846.57
##
## Number of Fisher Scoring iterations: 6## 模型二：為模型加入控制變數
mod.2 <-update(mod.1, .~. +v3r+v4r +
gen.1+gen.2+gen.3+gen.4+gen.5,
family = binomial,
data=x1351)
summary(mod.2)##
## Call:
## glm(formula = v7r ~ v14r + v20r + v26r + v31r + v37r + v3r +
## v4r + gen.1 + gen.2 + gen.3 + gen.4 + gen.5, family = binomial,
## data = x1351)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.8596 0.2853 0.4072 0.5509 1.6391
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.53215 1.47719 3.068 0.00215 **
## v14r2 -1.68306 1.38599 -1.214 0.22462
## v14r3 -1.75231 1.33066 -1.317 0.18788
## v14r4 -1.88142 1.32877 -1.416 0.15680
## v14r5 -2.96244 1.32392 -2.238 0.02525 *
## v14r6 -3.60646 1.32366 -2.725 0.00644 **
## v20r2 -0.20655 0.33564 -0.615 0.53831
## v20r3 -0.26465 0.30446 -0.869 0.38471
## v20r4 -0.66598 0.35503 -1.876 0.06068 .
## v20r5 -2.00023 0.41103 -4.866 1.14e-06 ***
## v20r6 -3.78298 0.84185 -4.494 7.00e-06 ***
## v26r2 0.51745 0.52864 0.979 0.32767
## v26r3 -0.05343 0.47921 -0.111 0.91123
## v26r4 -0.04686 0.50316 -0.093 0.92580
## v26r5 -0.19351 0.52738 -0.367 0.71367
## v26r6 -0.41251 0.57918 -0.712 0.47632
## v31r2 -0.13710 0.23736 -0.578 0.56354
## v31r3 -0.03226 0.29922 -0.108 0.91414
## v31r4 -0.39416 0.40853 -0.965 0.33463
## v31r5 -0.49464 0.75851 -0.652 0.51432
## v31r6 0.10080 1.22651 0.082 0.93450
## v37r2 0.51144 0.24826 2.060 0.03939 *
## v37r3 0.37041 0.27412 1.351 0.17660
## v37r4 0.14640 0.32185 0.455 0.64920
## v37r5 0.51950 0.50307 1.033 0.30176
## v37r6 0.60352 0.62628 0.964 0.33522
## v3r1 -0.07764 0.28903 -0.269 0.78823
## v4r1 -0.74861 0.94570 -0.792 0.42860
## gen.1 11.95911 507.44853 0.024 0.98120
## gen.2 -0.51175 0.64156 -0.798 0.42507
## gen.3 -0.81746 0.59942 -1.364 0.17265
## gen.4 -0.21370 0.59320 -0.360 0.71866
## gen.5 -0.06466 0.59657 -0.108 0.91369
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1010 on 1033 degrees of freedom
## Residual deviance: 779 on 1001 degrees of freedom
## (9 observations deleted due to missingness)
## AIC: 845
##
## Number of Fisher Scoring iterations: 13檢定結果說明
##由模型一得知，假設一、二、五得到支持，再以加入控制變數的模型二來檢定，假設一、二、五仍得到支持，控制變數為無效的控制變數。探索式分析
load("X1351.rda")
library(dplyr)##
## Attaching package: 'dplyr'## The following object is masked from 'package:car':
##
## recode## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(FactoMineR)
library(factoextra)## Loading required package: ggplot2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBax1351MCA <- select(x1351, v7r, v14r, v20r, v26r, v31r, v37r)
x1351MCA.nona <- na.omit(x1351MCA)
nrow(x1351MCA.nona)## [1] 1043names(x1351MCA.nona)## [1] "v7r" "v14r" "v20r" "v26r" "v31r" "v37r"res <- MCA(x1351MCA.nona, ncp = 5, graph = F)
fviz_screeplot(res, ncp=10)
# 變數類別關係圖
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",
invisible=c("ind", "quali.sup"),
autoLab = "yes",
title="") 
## MCA分析
## 從MCA圖，認為「當事人有無做出殘忍行為」與判斷對錯一定程度相關的人(v20r_3)和偏向同意「對受害者展現同情」的人(v26_3)是二個很鄰近的選項，顯示關心當事人有無做出殘忍行為和同意對受害者展現同情，是較為類似概念的關懷原則，可推論事件中當事人若有對受害者展現同情，會被視為比較沒有那麼殘忍。
## 另外非常同意「傷害毫無抵抗力的小動物事件糟糕的事」(v31r_1)和非常同意殺人無論如何都是不對(v37r_1)，這兩個選項也很接近，可推論越傾向憐憫小動物的人也愈無法容忍事件中當事人有作出殺人的行為，也就是傷害毫無抵抗力的小動物，會被認為就如同是一種殺人行為般令人氣憤。初步假設
## 用卡方檢定來進一步確認肉眼所預判潛在變數之間的相關性
##「當事人有無做出殘忍行為和判斷是否對錯相關」(V20r)與認同傷害毫無抵抗力的動物事件糟糕的事(v31r）二變數之間的關聯性。
library(sjPlot)
library(readr )
tab_xtab(x1351$v20r, x1351$v31r, encoding = "UTF-8",
show.row.prc = TRUE, # 顯示列百分比
show.col.prc = TRUE, # 顯示欄百分比
show.na=FALSE,
show.legend = FALSE,
show.exp = FALSE,
show.cell.prc = FALSE,
tdcol.col = "gray",
tdcol.row = "brown")|
撠 |
|
Total | |||||
|---|---|---|---|---|---|---|---|
| 1 | 2 | 3 | 4 | 5 | 6 | ||
| 1 |
149 81 % 27.3 % |
25 13.6 % 9.6 % |
9 4.9 % 5.5 % |
0 0 % 0 % |
0 0 % 0 % |
1 0.5 % 20 % |
184 100 % 17.6 % |
| 2 |
145 63.6 % 26.6 % |
54 23.7 % 20.8 % |
22 9.6 % 13.5 % |
5 2.2 % 8.8 % |
2 0.9 % 15.4 % |
0 0 % 0 % |
228 100 % 21.9 % |
| 3 |
184 47.4 % 33.8 % |
118 30.4 % 45.4 % |
67 17.3 % 41.1 % |
14 3.6 % 24.6 % |
4 1 % 30.8 % |
1 0.3 % 20 % |
388 100 % 37.2 % |
| 4 |
40 26.1 % 7.3 % |
45 29.4 % 17.3 % |
44 28.8 % 27 % |
22 14.4 % 38.6 % |
1 0.7 % 7.7 % |
1 0.7 % 20 % |
153 100 % 14.7 % |
| 5 |
12 20 % 2.2 % |
16 26.7 % 6.2 % |
16 26.7 % 9.8 % |
12 20 % 21.1 % |
4 6.7 % 30.8 % |
0 0 % 0 % |
60 100 % 5.8 % |
| 6 |
15 50 % 2.8 % |
2 6.7 % 0.8 % |
5 16.7 % 3.1 % |
4 13.3 % 7 % |
2 6.7 % 15.4 % |
2 6.7 % 40 % |
30 100 % 2.9 % |
| Total |
545 52.3 % 100 % |
260 24.9 % 100 % |
163 15.6 % 100 % |
57 5.5 % 100 % |
13 1.2 % 100 % |
5 0.5 % 100 % |
1043 100 % 100 % |
χ2=244.997 · df=25 · Cramer’s V=0.217 · Fisher’s p=0.000 |
製圖
library(ggplot2)
load("x1351.rda")
ggplot(data=x1351, aes(x=factor(v20r),
fill=factor(v31r)))+
geom_bar(width = .6, position = position_dodge())
ggplot(data=x1351, aes(x=factor(v14r),
fill=factor(v7r)))+
geom_bar(width = .6, position = position_dodge())
## 資料分析