-
Notifications
You must be signed in to change notification settings - Fork 0
/
04_quality_checks.R
190 lines (163 loc) · 6.24 KB
/
04_quality_checks.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
#####################################################################################
##
## File Name: 03_quality_checks.R
## Date: 2020-03-22
## Author: Daniel Weitzel
## Email: [email protected]
## Purpose: Check quality of the data
## Date Used: 2020-05-03
## Data Used:
## Output File: (none)
## Data Output: (none)
## Data Webpage: (none)
## Log File: (none)
## Notes:
##
#####################################################################################
## Setting working directory
setwd(githubdir)
setwd("notwork_news/")
## Libraries
library("tidyverse")
library("tidycomm")
library("irr")
library("DescTools")
## Loading the coded data from F8
source("scripts/03_recode.R")
## Loading the gold standard data
df_gold <- read_csv("data/gold_standard/sample_questions_gold.csv")
df_f8_gold <- read_csv("data/coded/sample_coded.csv")
## Minimum number of gold standard questions coded by one coder
df_f8_gold %>%
dplyr::select(`_worker_id`) %>%
group_by(`_worker_id`) %>%
add_count()%>%
unique %>%
ungroup %>%
filter(n == min(n))
## Average number correct on gold standard questions
## Initial prep of the data, renaming, dropping of columns
df_f8_gold <-
df_f8_gold %>%
filter(`_golden` == "TRUE") %>%
dplyr::select(id, `_unit_id`, `_id`, `_worker_id`, year,
does_the_news_deal_with_a_concern_or_event_that_is_politically_consequential_or_not,
does_the_news_deal_with_a_local_national_or_international_concern_or_event) %>%
rename(news = does_the_news_deal_with_a_concern_or_event_that_is_politically_consequential_or_not,
geography = does_the_news_deal_with_a_local_national_or_international_concern_or_event,
sample_id = id,
f8_unit_id = `_unit_id`,
f8_id = `_id`,
f8_worker_id = `_worker_id`) %>%
group_by(sample_id) %>%
mutate(coder = "coder",
coder_n = row_number(),
news = str_replace_all(news, "_news", "")) %>%
unite(coder, coder, coder_n, remove = FALSE) %>%
dplyr::select(-coder_n)
df_gold <-
df_gold %>%
select(sample_id, hard_news_gold, geography_gold)
df_f8_gold <-
df_f8_gold %>%
left_join(df_gold, by = c("sample_id")) %>%
mutate(hard_correct = ifelse(hard_news_gold == "hard_news" & news == "hard", TRUE, FALSE),
geo_correct = ifelse(geography_gold == geography, TRUE, FALSE))
## Hard news correct
mean(df_f8_gold$hard_correct)
sd(df_f8_gold$hard_correct)
## Geography correct
mean(df_f8_gold$geo_correct)
sd(df_f8_gold$geo_correct)
## Number of majority codings for news (at least 2 coders agree)
df_f8_news <-
df_f8 %>%
filter(special == "FALSE") %>%
filter(channel %in% c("ABC", "CBS", "NBC")) %>%
dplyr::select(sample_id, starts_with("news_coder_"), starts_with("news")) %>%
filter(!is.na(news_majority))
## Number of majority codings for geography (at least 2 coders agree)
df_f8_geo <-
df_f8 %>%
filter(special == "FALSE") %>%
filter(channel %in% c("ABC", "CBS", "NBC")) %>%
dplyr::select(sample_id, starts_with("geography_coder_"), starts_with("geography")) %>%
filter(is.na(geography_majority))
## Coder quality checks
df_f8_sample <-
df_f8 %>%
select(sample_id:geography_majority) %>%
dplyr::select(sample_id, year, broadcast_abstract, abstract_length, broadcasts_in_year, broadcast_time)
# write_csv(df_f8_sample, "data/sample_questions.csv")
## Number of gold standard questions per worker
golden_numbers <-
df_f8 %>%
dplyr::select(f8_worker_id, golden) %>%
mutate(golden = ifelse(golden == TRUE, "golden", "notgolden")) %>%
group_by(f8_worker_id, golden) %>%
add_count() %>%
unique %>%
pivot_wider(id_cols = f8_worker_id, names_from = golden, values_from = n) %>%
drop_na() %>%
mutate(all = golden + notgolden,
share_golden = golden/all)
summary(golden_numbers$share_golden)
sd(golden_numbers$share_golden)
# Share of golden answers is between 15% and 94%. The mean is 44.17% and the SD is 15.8
summary(golden_numbers$all)
sd(golden_numbers$all)
#The number of questions coded by a given individual is between 12 and 347. The mean is 56.55 statements with a standard deviation of 49
## Data quality check
### Checking the coder quality
df_geography <-
df_f8 %>%
ungroup() %>%
dplyr::select(geography_coder_1, geography_coder_2, geography_coder_3) %>%
mutate_all(funs(ifelse(.=="not_clear", NA, .))) %>%
mutate_all(funs(ifelse(.=="international", 1, .))) %>%
mutate_all(funs(ifelse(.=="national", 2, .))) %>%
mutate_all(funs(ifelse(.=="local", 3, .))) %>%
mutate(geography_coder_1 = as.numeric(geography_coder_1),
geography_coder_2 = as.numeric(geography_coder_2),
geography_coder_3 = as.numeric(geography_coder_3),
same = ifelse(geography_coder_1 == geography_coder_2 & geography_coder_2 == geography_coder_3 | geography_coder_1 == geography_coder_2 | geography_coder_1 == geography_coder_3 | geography_coder_3 == geography_coder_2 , 1, 0))
# Absolute agreement between raters
agree(as.matrix(df_geography))
table(df_geography$same)
# Percentage agreement (Tolerance=0)
# Subjects = 5200
# Raters = 3
# %-agree = 50.1
# Fleiss' kappa
kappam.fleiss(df_geography)
kappam.fleiss(df_geography, exact=TRUE)
# value is 0.384 and hence in the "fair agreement" range (0.21 – 0.40)
### Examining data quality for news type coding
df_news <-
df_f8 %>%
ungroup() %>%
dplyr::select(news_coder_1, news_coder_2, news_coder_3) %>%
mutate_all(funs(ifelse(.=="not_clear", NA, .)))
# Absolute agreement between raters
agree(cbind(df_news))
# %-agree = 80.3
# Fleiss' kappa
kappam.fleiss(df_news)
kappam.fleiss(df_news, exact=TRUE)
# Kappa = 0.296 and hence in the "fair agreement" range (0.21 – 0.40)
table(df_news$news_coder_1)
table(df_news$news_coder_2)
table(df_news$news_coder_3)
matrix_news <- as.matrix(df_news)
kripp.alpha(matrix_news, method=c("ordinal"))
# alpha = 0.295
rm(df_geography, df_news)
## Some overview
## Years
table(df_f8$year)
## Hard vs soft news
table(df_f8$news, useNA = 'always')
table(df_f8$news_majority, useNA = 'always')
## Geography
table(df_f8$geography, useNA = 'always')
table(df_f8$geography_majority, useNA = 'always')