FYP Quantitative Analysis of Tagged Themes
Rebecca Tan
2024-04-05
library(tidyr)
library(dplyr)
library(ggplot2)
library(vcd)
library(reshape2)
library(stats)
library(png)
library(gridExtra)
library(kableExtra)
library(VennDiagram)
library(cowplot)
library(stringr)Part 1: Data Processing
#data path for file
path <- "C:/Users/rebec/OneDrive - Nanyang Technological University/2022 Documents/uni life/Y4 FYP/survey time LETS GOOO/"
data.file <- paste0(path,"all_tags_final.csv")
data <- read.csv(data.file)
# remove anything with interesting
data1 <- data[!grepl("interesting\\.", data$tag), ]
# remove only value.relational.care.not
data2 <- data1[!data1$tag == "value.relational.care.not", ]
# remove only value.relational.not
data3 <- data2[!data2$tag == "value.relational.not", ]
# remove only value.relational.spiritual.not
data4 <- data3[!data3$tag == "value.relational.spiritual.not", ]
#replace v.r.care.less to v.r.c
data4$tag <- gsub("value.relational.care.less", "value.relational.care", data4$tag)
#v.r.e.xyz to v.r.e
data4$tag <- gsub("value\\.relational\\.eudaimonia\\.\\w+", "value.relational.eudaimonia", data4$tag)
# Function to remove duplicates within each interview number
remove_duplicate_tags <- function(data) {
data[!duplicated(data$tag), ]
}
data4<-data4[,c('document','tag')]
# Apply the function by interview number
data.unique.tags <- do.call(rbind, lapply(split(data4, data4$document), remove_duplicate_tags))
rownames(data.unique.tags) <- NULL
data.unique.tags <- data.unique.tags[order(as.numeric(gsub("Interview ", "", data.unique.tags$document))), ]
# Print result
print(data.unique.tags)## document tag
## 1 Interview 1 nationality.sg
## 2 Interview 1 age.25to34
## 3 Interview 1 frequency.regular
## 4 Interview 1 activities.exercise
## 5 Interview 1 activities.hangout
## 6 Interview 1 activities.walk
## 7 Interview 1 usual.alone
## 8 Interview 1 household.wothers
## 9 Interview 1 value.instrumental.social
## 10 Interview 1 value.relational
## 11 Interview 1 value.instrumental.emotionsthinking
## 12 Interview 1 value.relational.spiritual
## 13 Interview 1 value.instrumental
## 14 Interview 1 value.relational.care
## 15 Interview 1 naturetype.managed.instrumental
## 16 Interview 1 naturetype.same.relational
## 159 Interview 2 nationality.nonsg
## 160 Interview 2 mentionsothercountry
## 161 Interview 2 age.45to54
## 162 Interview 2 frequency.frequent
## 163 Interview 2 activities.hangout
## 164 Interview 2 activities.walk
## 165 Interview 2 usual.wothers
## 166 Interview 2 household.wothers
## 167 Interview 2 value.instrumental.social
## 168 Interview 2 value.relational.spiritual
## 169 Interview 2 value.relational.eudaimonia
## 321 Interview 3 mentionsothercountry
## 322 Interview 3 nationality.nonsg
## 323 Interview 3 age.25to34
## 324 Interview 3 frequency.rare
## 325 Interview 3 activities.walk
## 326 Interview 3 usual.alone
## 327 Interview 3 household.alone
## 328 Interview 3 value.instrumental
## 329 Interview 3 value.instrumental.care
## 346 Interview 4 nationality.nonsg
## 347 Interview 4 mentionsothercountry
## 348 Interview 4 age.21to24
## 349 Interview 4 frequency.frequent
## 350 Interview 4 activities.relax
## 351 Interview 4 activities.hangout
## 352 Interview 4 usual.alone
## 353 Interview 4 household.wothers
## 354 Interview 4 value.instrumental
## 355 Interview 4 value.instrumental.emotionsthinking
## 356 Interview 5 nationality.sg
## 357 Interview 5 age.25to34
## 358 Interview 5 frequency.frequent
## 359 Interview 5 activities.exercise
## 360 Interview 5 activities.walk
## 361 Interview 5 activities.relax
## 362 Interview 5 usual.alone
## 363 Interview 5 household.wothers
## 364 Interview 5 value.instrumental
## 365 Interview 5 young.butdidntaffect
## 366 Interview 5 value.instrumental.social
## 367 Interview 5 value.relational.care
## 368 Interview 5 mentionsothercountry
## 369 Interview 5 value.relational.spiritual
## 370 Interview 5 value.instrumental.emotionsthinking
## 371 Interview 6 nationality.nonsg
## 372 Interview 6 mentionsothercountry
## 373 Interview 6 age.35to44
## 374 Interview 6 frequency.occasionally
## 375 Interview 6 activities.exercise
## 376 Interview 6 activities.hangout
## 377 Interview 6 usual.sameforboth
## 378 Interview 6 household.wothers
## 379 Interview 6 value.instrumental
## 380 Interview 6 young.young
## 381 Interview 6 value.instrumental.social
## 382 Interview 6 value.relational.spiritual
## 383 Interview 6 value.relational.care
## 384 Interview 6 value.relational.eudaimonia
## 385 Interview 7 mentionsothercountry
## 386 Interview 7 nationality.nonsg
## 387 Interview 7 age.25to34
## 388 Interview 7 frequency.frequent
## 389 Interview 7 activities.hangout
## 390 Interview 7 activities.walk
## 391 Interview 7 activities.relax
## 392 Interview 7 usual.wothers
## 393 Interview 7 household.wothers
## 394 Interview 7 value.instrumental
## 395 Interview 7 value.instrumental.social
## 396 Interview 7 young.young
## 397 Interview 7 value.relational.social
## 398 Interview 7 value.relational.spiritual
## 399 Interview 7 value.relational.eudaimonia
## 400 Interview 7 value.instrumental.emotionsthinking
## 401 Interview 8 mentionsothercountry
## 402 Interview 8 nationality.nonsg
## 403 Interview 8 age.45to54
## 404 Interview 8 frequency.frequent
## 405 Interview 8 activities.relax
## 406 Interview 8 activities.picnic
## 407 Interview 8 activities.exercise
## 408 Interview 8 usual.alone
## 409 Interview 8 household.wothers
## 410 Interview 8 value.relational.care
## 411 Interview 8 value.relational.social
## 412 Interview 8 value.relational.eudaimonia
## 413 Interview 8 young.young
## 414 Interview 8 value.instrumental
## 415 Interview 8 value.relational.spiritual
## 416 Interview 8 value.instrumental.emotionsthinking
## 417 Interview 9 nationality.sg
## 418 Interview 9 age.21to24
## 419 Interview 9 frequency.regular
## 420 Interview 9 activities.relax
## 421 Interview 9 activities.walk
## 422 Interview 9 activities.exercise
## 423 Interview 9 usual.alone
## 424 Interview 9 household.wothers
## 425 Interview 9 value.instrumental.emotionsthinking
## 426 Interview 9 young.young
## 427 Interview 9 value.instrumental.social
## 428 Interview 9 value.instrumental.care
## 429 Interview 9 value.relational.spiritual
## 430 Interview 9 value.relational.eudaimonia
## 17 Interview 10 nationality.sg
## 18 Interview 10 age.25to34
## 19 Interview 10 frequency.regular
## 20 Interview 10 activities.walk
## 21 Interview 10 activities.exercise
## 22 Interview 10 activities.relax
## 23 Interview 10 usual.sameforboth
## 24 Interview 10 household.wothers
## 25 Interview 10 value.instrumental.emotionsthinking
## 26 Interview 10 young.butdidntaffect
## 27 Interview 10 value.instrumental.social
## 28 Interview 10 value.instrumental
## 29 Interview 10 value.instrumental.care
## 30 Interview 10 naturetype.same
## 31 Interview 11 nationality.sg
## 32 Interview 11 age.65andabove
## 33 Interview 11 frequency.frequent
## 34 Interview 11 activities.relax
## 35 Interview 11 activities.exercise
## 36 Interview 11 usual.alone
## 37 Interview 11 household.alone
## 38 Interview 11 value.instrumental
## 39 Interview 11 value.instrumental.care
## 40 Interview 11 value.relational.spiritual
## 41 Interview 11 value.instrumental.emotionsthinking
## 42 Interview 11 value.relational.eudaimonia
## 43 Interview 12 nationality.sg
## 44 Interview 12 age.65andabove
## 45 Interview 12 frequency.frequent
## 46 Interview 12 activities.work
## 47 Interview 12 activities.walk
## 48 Interview 12 usual.alone
## 49 Interview 12 household.alone
## 50 Interview 12 young.young
## 51 Interview 12 value.instrumental.social
## 52 Interview 12 value.instrumental
## 53 Interview 12 value.instrumental.emotionsthinking
## 54 Interview 13 mentionsothercountry
## 55 Interview 13 nationality.nonsg
## 56 Interview 13 age.21to24
## 57 Interview 13 frequency.regular
## 58 Interview 13 activities.birdwatching
## 59 Interview 13 activities.hangout
## 60 Interview 13 activities.walk
## 61 Interview 13 activities.exercise
## 62 Interview 13 usual.alone
## 63 Interview 13 household.wothers
## 64 Interview 13 naturetype.unmanaged
## 65 Interview 13 value.instrumental
## 66 Interview 13 value.relational.social
## 67 Interview 13 value.instrumental.social
## 68 Interview 13 young.young
## 69 Interview 13 interesting
## 70 Interview 13 value.instrumental.care
## 71 Interview 13 value.relational.care
## 72 Interview 13 value.relational.eudaimonia
## 73 Interview 14 nationality.nonsg
## 74 Interview 14 mentionsothercountry
## 75 Interview 14 age.35to44
## 76 Interview 14 frequency.frequent
## 77 Interview 14 activities.hangout
## 78 Interview 14 activities.exercise
## 79 Interview 14 activities.relax
## 80 Interview 14 usual.sameforboth
## 81 Interview 14 household.wothers
## 82 Interview 14 value.instrumental.emotionsthinking
## 83 Interview 14 naturetype.same
## 84 Interview 14 young.young
## 85 Interview 14 value.relational.eudaimonia
## 86 Interview 14 value.instrumental.social
## 87 Interview 14 value.instrumental.care
## 88 Interview 14 value.instrumental
## 89 Interview 14 value.relational.spiritual
## 90 Interview 15 nationality.sg
## 91 Interview 15 age.65andabove
## 92 Interview 15 frequency.frequent
## 93 Interview 15 activities.walk
## 94 Interview 15 activities.relax
## 95 Interview 15 activities.exercise
## 96 Interview 15 activities.hangout
## 97 Interview 15 usual.wothers
## 98 Interview 15 household.wothers
## 99 Interview 15 value.instrumental.emotionsthinking
## 100 Interview 15 value.instrumental
## 101 Interview 15 value.relational.spiritual
## 102 Interview 15 value.instrumental.social
## 103 Interview 15 value.relational.eudaimonia
## 104 Interview 16 nationality.nonsg
## 105 Interview 16 mentionsothercountry
## 106 Interview 16 age.45to54
## 107 Interview 16 frequency.frequent
## 108 Interview 16 activities.walk
## 109 Interview 16 activities.relax
## 110 Interview 16 usual.alone
## 111 Interview 16 household.wothers
## 112 Interview 16 value.instrumental
## 113 Interview 16 young.not
## 114 Interview 16 value.instrumental.social
## 115 Interview 16 value.instrumental.care
## 116 Interview 16 value.instrumental.spiritual
## 117 Interview 16 value.relational.eudaimonia
## 118 Interview 17 nationality.sg
## 119 Interview 17 age.25to34
## 120 Interview 17 frequency.occasionally
## 121 Interview 17 activities.exercise
## 122 Interview 17 activities.walk
## 123 Interview 17 activities.hangout
## 124 Interview 17 usual.wothers
## 125 Interview 17 household.wothers
## 126 Interview 17 value.relational.spiritual
## 127 Interview 17 young.not
## 128 Interview 17 naturetype.same
## 129 Interview 17 value.relational.eudaimonia
## 130 Interview 18 nationality.nonsg
## 131 Interview 18 mentionsothercountry
## 132 Interview 18 age.35to44
## 133 Interview 18 frequency.frequent
## 134 Interview 18 activities.relax
## 135 Interview 18 activities.hangout
## 136 Interview 18 activities.walk
## 137 Interview 18 activities.exercise
## 138 Interview 18 usual.alone
## 139 Interview 18 household.wothers
## 140 Interview 18 value.instrumental.emotionsthinking
## 141 Interview 18 value.instrumental.social
## 142 Interview 18 value.instrumental.care
## 143 Interview 18 value.relational.spiritual
## 144 Interview 18 value.instrumental
## 145 Interview 18 value.relational.eudaimonia
## 146 Interview 19 mentionsothercountry
## 147 Interview 19 nationality.nonsg
## 148 Interview 19 age.35to44
## 149 Interview 19 frequency.frequent
## 150 Interview 19 activities.relax
## 151 Interview 19 activities.walk
## 152 Interview 19 usual.alone
## 153 Interview 19 household.wothers
## 154 Interview 19 value.instrumental
## 155 Interview 19 young.young
## 156 Interview 19 value.relational.care
## 157 Interview 19 value.instrumental.care
## 158 Interview 19 value.relational.spiritual
## 170 Interview 20 nationality.nonsg
## 171 Interview 20 mentionsothercountry
## 172 Interview 20 age.65andabove
## 173 Interview 20 frequency.frequent
## 174 Interview 20 activities.relax
## 175 Interview 20 activities.exercise
## 176 Interview 20 activities.walk
## 177 Interview 20 activities.hangout
## 178 Interview 20 usual.sameforboth
## 179 Interview 20 household.wothers
## 180 Interview 20 value.instrumental.social
## 181 Interview 20 young.not.butwanted
## 182 Interview 20 value.instrumental
## 183 Interview 20 naturetype.same
## 184 Interview 20 value.instrumental.care
## 185 Interview 20 value.relational.eudaimonia
## 186 Interview 21 nationality.nonsg
## 187 Interview 21 mentionsothercountry
## 188 Interview 21 age.25to34
## 189 Interview 21 frequency.frequent
## 190 Interview 21 activities.walk
## 191 Interview 21 activities.relax
## 192 Interview 21 activities.exercise
## 193 Interview 21 usual.alone
## 194 Interview 21 household.wothers
## 195 Interview 21 value.instrumental
## 196 Interview 21 value.instrumental.care
## 197 Interview 21 value.instrumental.emotionsthinking
## 198 Interview 21 young.butdidntaffect
## 199 Interview 21 naturetype.same
## 200 Interview 22 nationality.sg
## 201 Interview 22 age.55to64
## 202 Interview 22 frequency.frequent
## 203 Interview 22 activities.walk
## 204 Interview 22 activities.hangout
## 205 Interview 22 activities.exercise
## 206 Interview 22 usual.wothers
## 207 Interview 22 household.wothers
## 208 Interview 22 value.instrumental.social
## 209 Interview 22 value.instrumental
## 210 Interview 22 value.instrumental.care
## 211 Interview 22 naturetype.unmanaged
## 212 Interview 22 value.relational.eudaimonia
## 213 Interview 22 value.relational.care
## 214 Interview 23 nationality.sg
## 215 Interview 23 age.21to24
## 216 Interview 23 frequency.occasionally
## 217 Interview 23 activities.study
## 218 Interview 23 activities.relax
## 219 Interview 23 usual.alone
## 220 Interview 23 household.wothers
## 221 Interview 23 value.instrumental.spiritual
## 222 Interview 23 value.relational.spiritual
## 223 Interview 23 young.not
## 224 Interview 23 naturetype.same
## 225 Interview 23 value.relational.eudaimonia
## 226 Interview 23 value.instrumental.social
## 227 Interview 23 value.relational.care
## 228 Interview 23 value.instrumental
## 229 Interview 24 nationality.sg
## 230 Interview 24 age.35to44
## 231 Interview 24 frequency.regular
## 232 Interview 24 activities.birdwatching
## 233 Interview 24 activities.naturephotog
## 234 Interview 24 activities.hangout
## 235 Interview 24 activities.picnic
## 236 Interview 24 usual.wothers
## 237 Interview 24 household.wothers
## 238 Interview 24 value.instrumental
## 239 Interview 24 value.relational.undefined
## 240 Interview 24 young.not
## 241 Interview 24 value.instrumental.social
## 242 Interview 24 value.relational.eudaimonia
## 243 Interview 24 value.relational.social
## 244 Interview 25 nationality.sg
## 245 Interview 25 age.35to44
## 246 Interview 25 frequency.regular
## 247 Interview 25 activities.walk
## 248 Interview 25 activities.exercise
## 249 Interview 25 activities.hangout
## 250 Interview 25 usual.wothers
## 251 Interview 25 household.wothers
## 252 Interview 25 value.instrumental
## 253 Interview 25 value.instrumental.social
## 254 Interview 25 young.not
## 255 Interview 25 naturetype.same
## 256 Interview 25 value.relational.social
## 257 Interview 26 nationality.sg
## 258 Interview 26 age.35to44
## 259 Interview 26 frequency.occasionally
## 260 Interview 26 activities.exercise
## 261 Interview 26 activities.walk
## 262 Interview 26 activities.picnic
## 263 Interview 26 usual.sameforboth
## 264 Interview 26 household.wothers
## 265 Interview 26 value.instrumental
## 266 Interview 26 value.instrumental.social
## 267 Interview 26 young.young
## 268 Interview 26 naturetype.same
## 269 Interview 26 value.instrumental.care
## 270 Interview 26 value.relational.care
## 271 Interview 26 value.relational.eudaimonia
## 272 Interview 27 nationality.sg
## 273 Interview 27 age.35to44
## 274 Interview 27 frequency.regular
## 275 Interview 27 activities.exercise
## 276 Interview 27 activities.relax
## 277 Interview 27 activities.walk
## 278 Interview 27 activities.hangout
## 279 Interview 27 usual.sameforboth
## 280 Interview 27 household.wothers
## 281 Interview 27 value.instrumental.emotionsthinking
## 282 Interview 27 value.instrumental.social
## 283 Interview 27 value.instrumental
## 284 Interview 27 naturetype.same
## 285 Interview 27 value.instrumental.care
## 286 Interview 28 nationality.sg
## 287 Interview 28 age.21to24
## 288 Interview 28 frequency.frequent
## 289 Interview 28 activities.hangout
## 290 Interview 28 activities.walk
## 291 Interview 28 activities.exercise
## 292 Interview 28 activities.relax
## 293 Interview 28 usual.alone
## 294 Interview 28 household.wothers
## 295 Interview 28 value.instrumental
## 296 Interview 28 young.not.butwanted
## 297 Interview 28 naturetype.same
## 298 Interview 28 value.instrumental.social
## 299 Interview 28 value.instrumental.care
## 300 Interview 28 value.relational.care
## 301 Interview 28 value.relational.spiritual
## 302 Interview 28 value.instrumental.emotionsthinking
## 303 Interview 28 value.relational.eudaimonia
## 304 Interview 29 nationality.nonsg
## 305 Interview 29 age.55to64
## 306 Interview 29 frequency.frequent
## 307 Interview 29 activities.relax
## 308 Interview 29 activities.exercise
## 309 Interview 29 activities.walk
## 310 Interview 29 usual.sameforboth
## 311 Interview 29 household.wothers
## 312 Interview 29 value.relational.spiritual
## 313 Interview 29 young.not
## 314 Interview 29 mentionsothercountry
## 315 Interview 29 value.instrumental.spiritual
## 316 Interview 29 naturetype.unmanaged
## 317 Interview 29 value.instrumental.social
## 318 Interview 29 value.instrumental
## 319 Interview 29 value.instrumental.care
## 320 Interview 29 value.relational.eudaimonia
## 330 Interview 30 nationality.sg
## 331 Interview 30 age.25to34
## 332 Interview 30 frequency.regular
## 333 Interview 30 activities.walk
## 334 Interview 30 activities.relax
## 335 Interview 30 activities.hangout
## 336 Interview 30 usual.wothers
## 337 Interview 30 household.wothers
## 338 Interview 30 value.instrumental
## 339 Interview 30 young.young
## 340 Interview 30 value.instrumental.social
## 341 Interview 30 value.relational.social
## 342 Interview 30 naturetype.unmanaged
## 343 Interview 30 value.relational.care
## 344 Interview 30 value.relational.spiritual
## 345 Interview 30 value.relational.eudaimonia#test taking out specific data if want it for any reason
# count_age_21to24 <- nrow(data.unique.tags[data.unique.tags$tag == 'age.21to24', ])Part 2: Visualisation of v.r tags per interview
v.r.data <- data.unique.tags[grepl("value.relational", data.unique.tags$tag), ]
v.r.data <- v.r.data[!grepl('undefined',v.r.data$tag),]
v.r.data <- v.r.data[!v.r.data$tag == 'value.relational',]
v.r.data$document <- gsub("Interview ", "", v.r.data$document)
v.r.data$tag <- gsub("value.relational.", "", v.r.data$tag)
desired_order <- c("eudaimonia", "spiritual", "care", "social")
desired_labels <- c("Eudaimonia", "Spiritual", "Care", "Social")
tags.plot<-ggplot(v.r.data, aes(x = factor(document, levels = 1:30), y = factor(tag, levels = desired_order))) +
geom_point(size = 3, shape = 16, color = "grey35") +
labs(x = "Interview Number", y = "Relational Values", title = "Presence of RVs in each Interview") +
theme_minimal() +
theme(axis.text.x = element_text(hjust = 1),
axis.text.y = element_text(hjust = 1),
plot.title = element_text(face = "bold", hjust = 0.5)) +
scale_x_discrete(drop=FALSE)+
scale_y_discrete(labels = desired_labels)
tags.plot
Part 3
change this part if you want the fisher’s test results (see comments at the end)
data.format <- function (df,tag.var){
unique.tag.var <- unique(data.unique.tags$tag[grep(tag.var,data.unique.tags$tag)])
unique.tag <- unique(df$tag[grep(paste(tag.var,collapse='|'), df$tag)])
unique.tag <- unique.tag[order(unique.tag)]
v.r.<- c('value.relational.social','value.relational.care',
'value.relational.spiritual','value.relational.eudaimonia')
v.r.label <- c('Social','Care','Spiritual','Eudaimonia')
if (length(unique.tag)==1){
df.out <- data.frame(matrix(0, ncol = length(v.r.), nrow = (length(unique.tag) + 1)))
rownames(df.out)<-c(unique.tag,'opp')
colnames(df.out)<-v.r.label
}
else{
df.out <- data.frame(matrix(0, ncol = length(v.r.), nrow = length(unique.tag)))
rownames(df.out)<-unique.tag
colnames(df.out)<-v.r.label
}
int.num <- 1
while (int.num <=30) {
temp <- df[df$document==(paste0('Interview ',int.num)),]
temp <- temp %>% distinct(tag, .keep_all = TRUE)
if (length(unique.tag)<1){
tag.full <- c(temp$tag[grep(paste(tag.var,collapse='|'),temp$tag)],'opp')
}else{
tag.full <- temp$tag[grep(paste(tag.var,collapse='|'),temp$tag)]
}
if (length(tag.full)==0){
tag.full = 0
}
# tag.full <- ifelse(length(unique.tag)==1,
# c(temp$tag[grep(tag.var,temp$tag)],'opp'),
# temp$tag[grep(tag.var,temp$tag)])
for (x in 1:length(tag.full)){
if ((length(tag.full)!=0) && (!is.na(tag.full[x])) && sum(grepl(tag.full[x],temp$tag)) >=1){
for (i in 1:nrow(temp)){
for (j in 1:length(v.r.)){
if (v.r.[j]==temp$tag[i]){
df.out[tag.full[x],v.r.label[j]] = df.out[tag.full[x],v.r.label[j]]+1
}
}
}
}
else{
if (!'opp' %in% rownames(df.out)) {
new.row <- data.frame(matrix(0, ncol = length(v.r.), nrow = 1))
colnames(new.row) <- v.r.label
rownames(new.row) <- 'opp'
df.out <- rbind(df.out, new.row)
}
for (i in 1:nrow(temp)){
for (j in 1:length(v.r.)){
if (v.r.[j]==temp$tag[i]){
df.out['opp',v.r.label[j]] = df.out['opp',v.r.label[j]]+1
}
}
}
}
}
int.num = int.num+1
}
for (i in 1:length(unique.tag.var)){
count.tag <- nrow(data.unique.tags[grep(unique.tag.var[i],
data.unique.tags$tag),])
df.out[rownames(df.out)==unique.tag.var[i],] <- round(df.out[rownames(df.out)==unique.tag.var[i],]/count.tag,3)
}
return (df.out)
}
##
# https://www-jstor-org.remotexs.ntu.edu.sg/stable/2288652?seq=7
# proof that fisher test can be used outside of 2x2 --> limited only by computational limits but can with R (mostly)
data.age <- data.format(data4,'age\\.')
data.age.plot <- data.age;data.age.plot$Age.Group<-rownames(data.age)
data.age.all <- data.age; data.age.all$RVs <- rowSums(data.age.all)
data.age.all <- data.age.all[,'RVs',drop=F]
data.age.all.plot <- data.age.all;data.age.all.plot$Age.Group <- rownames(data.age.all)
data.freq <- data.format(data4,'frequency\\.')
data.freq <- data.freq[c('frequency.rare',
'frequency.occasionally',
'frequency.regular',
'frequency.frequent'),]
data.freq.plot <- data.freq;data.freq.plot$freq<-rownames(data.freq)
data.freq.all <- data.freq; data.freq.all$RVs <- rowSums(data.freq.all)
data.freq.all <- data.freq.all[,'RVs',drop=F]
data.freq.all.plot <- data.freq.all;data.freq.all.plot$freq <- rownames(data.freq.all)
data.usual <- data.format(data4,'usual\\.')
data.usual <- data.usual[c('usual.alone','usual.sameforboth','usual.wothers'),]
data.usual.plot <- data.usual;data.usual.plot$usual<-rownames(data.usual)
data.usual.all <- data.usual; data.usual.all$RVs <- rowSums(data.usual.all)
data.usual.all <- data.usual.all[,'RVs',drop=F]
data.usual.all.plot <- data.usual.all;data.usual.all.plot$usual <- rownames(data.usual.all)
data.household <- data.format(data4,'household\\.')
data.household <- data.household[c('household.alone','household.wothers'),]
data.household.plot <- data.household;data.household.plot$household<-rownames(data.household)
data.household.all <- data.household; data.household.all$RVs <- rowSums(data.household.all)
data.household.all <- data.household.all[,'RVs',drop=F]
data.household.all.plot <- data.household.all
data.household.all.plot$household <- rownames(data.household.all)
data.nationality <- data.format(data4,'nationality\\.')
data.nationality <- data.nationality[c('nationality.nonsg','nationality.sg'),]
data.nationality.plot <- data.nationality;data.nationality.plot$nationality<-rownames(data.nationality)
data.nationality.all <- data.nationality; data.nationality.all$RVs <- rowSums(data.nationality.all)
data.nationality.all <- data.nationality.all[,'RVs',drop=F]
data.nationality.all.plot <- data.nationality.all
data.nationality.all.plot$nationality <- rownames(data.nationality.all)
# for the activities; changed the categories to work (work+study),
# exercise (walk+other exercise), hangout with friends and family,
# relax and others (birdwatching+naturephotog + picnic)
# this is because there are too many categories which cannot be analysed
# this is the only one that will be analysed through chisq
# rather than fisher's test for this same reason
data.act <- data.format(data4,'activities\\.')
data.act['activities.work',] <- data.act['activities.work',]+data.act['activities.study',]
data.act <- data.act[!rownames(data.act)=='activities.study',,drop=F]
data.act['activities.exercise',] <- data.act['activities.exercise',]+data.act['activities.walk',]
data.act <- data.act[!rownames(data.act)=='activities.walk',,drop=F]
data.act['activities.others',] <- data.act['activities.birdwatching',]+
data.act['activities.naturephotog',]+data.act['activities.picnic',]
data.act <- data.act[!rownames(data.act)=='activities.birdwatching',,drop=F]
data.act <- data.act[!rownames(data.act)=='activities.naturephotog',,drop=F]
data.act <- data.act[!rownames(data.act)=='activities.picnic',,drop=F]
data.act <- data.act[c('activities.work',
'activities.exercise',
'activities.hangout',
'activities.relax',
'activities.others'),]
data.act.plot <- data.act;data.act.plot$act<-c('activities.1work',
'activities.2exercise',
'activities.3hangout',
'activities.4relax',
'activities.5others')
data.act.all <- data.act; data.act.all$RVs <- rowSums(data.act.all)
data.act.all <- data.act.all[,'RVs',drop=F]
data.act.all.plot <- data.act.all
data.act.all.plot$act <- c('activities.1work',
'activities.2exercise',
'activities.3hangout',
'activities.4relax',
'activities.5others')
# rejected using chisq test in the end; bc data points are too small:
# chisq.test(data.age)
# chisq.test(data.freq)
# chisq.test(data.usual)
# chisq.test(data.household)
# chisq.test(data.nationality)
# chisq.test(data.act)
# rejected using a poisson model as well because it overfits the data
# NOTE: stats test here may not be very useful due to sample size limitations
# but plotted raw data may already show some inkling of a storyPart 3.1.1: Age (Fisher’s Test)
# I just realised the fisher's test won't work on the normalised data
# because everything will be rounded to 0 or 1 (integer) when divided by the counts
# See bottom of document for fix
# Ignore this fisher test data
fisher.test(data.age)## Warning in fisher.test(data.age): 'x' has been rounded to integer: Mean
## relative difference: 0.7451409##
## Fisher's Exact Test for Count Data
##
## data: data.age
## p-value = 1
## alternative hypothesis: two.sidedplot.age <- ggplot(data.age.plot) +
geom_line(aes(x = Age.Group, y = Social + 0.05, group = 1, color = "Social"), alpha = 0.7) +
geom_line(aes(x = Age.Group, y = Care, group = 1, color = "Care")) +
geom_line(aes(x = Age.Group, y = Spiritual, group = 1, color = "Spiritual")) +
geom_line(aes(x = Age.Group, y = Eudaimonia, group = 1, color = "Eudaimonia")) +
labs(x = 'Age Group', y = 'Count of Each RV', color='RVs') +
scale_color_manual(values = c("Social" = "purple", "Care" = "pink", "Spiritual" = "lightblue", "Eudaimonia" = "lightgreen")) +
scale_x_discrete(labels = c("21-24", "25-34", "35-44", "45-54", "55-64","65+")) +
theme_minimal() +
theme(legend.position = "top",
legend.box='just',
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
guides(color=guide_legend(ncol=2))
plot.age.all <- ggplot(data.age.all.plot) +
geom_line(aes(x = Age.Group, y = RVs, group = 1, color = "RV")) +
geom_smooth(aes(x=Age.Group,y=RVs,group=1,color='Best Fit'),method = "lm",
se = T,linetype='dashed',fill='lightblue') +
scale_color_manual(values = c("RV" = "maroon", "Best Fit"="blue")) +
scale_x_discrete(labels = c("21-24", "25-34", "35-44", "45-54", "55-64","65+")) +
coord_cartesian(ylim = c(0, NA)) +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
labs(x='Age Group',y='Count of Combined RVs', color='Legend')+
guides(color = guide_legend(override.aes = list(linetype = c("dashed", "solid"),
fill = c("lightblue", "NA")),
ncol=2))
plot.age;plot.age.all
## `geom_smooth()` using formula = 'y ~ x'
Part 3.1.2: Frequency (Fisher’s Test)
# I just realised the fisher's test won't work on the normalised data
# because everything will be rounded to 0 or 1 (integer) when divided by the counts
# See bottom of document for fix
# Ignore this fisher test data
fisher.test(data.freq)## Warning in fisher.test(data.freq): 'x' has been rounded to integer: Mean
## relative difference: 0.6598205##
## Fisher's Exact Test for Count Data
##
## data: data.freq
## p-value = 1
## alternative hypothesis: two.sidedplot.freq <- ggplot(data.freq.plot) +
geom_line(aes(x = freq, y = Social + 0.05, group = 1, color = "Social"), alpha = 0.7) +
geom_line(aes(x = freq, y = Care, group = 1, color = "Care")) +
geom_line(aes(x = freq, y = Spiritual, group = 1, color = "Spiritual")) +
geom_line(aes(x = freq, y = Eudaimonia-0.05, group = 1, color = "Eudaimonia")) +
labs(x = 'Visit Frequency', y = 'Count of Each RV',
color='RVs') +
scale_color_manual(values = c("Social" = "purple", "Care" = "pink", "Spiritual" = "lightblue", "Eudaimonia" = "lightgreen")) +
scale_x_discrete(labels = c("Frequent", "Regular", "Occasional", "Rare")) +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
guides(color=guide_legend(ncol=2))
plot.freq.all <- ggplot(data.freq.all.plot) +
geom_line(aes(x = freq, y = RVs, group = 1, color = "RV")) +
geom_smooth(aes(x=freq,y=RVs,group=1,color='Best Fit'),method = "lm",
se = T,linetype='dashed',fill='lightblue') +
scale_color_manual(values = c("RV" = "maroon", "Best Fit"="blue")) +
scale_x_discrete(labels = c("Frequent", "Regular", "Occasional", "Rare")) +
coord_cartesian(ylim = c(0, NA)) +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
labs(x='Visit Frequency',y='Count of Combined RVs', color='Legend')+
guides(color = guide_legend(override.aes = list(linetype = c("dashed", "solid"),
fill = c("lightblue", "NA"))))
plot.freq;plot.freq.all
## `geom_smooth()` using formula = 'y ~ x'
Part 3.1.3: Usually with Others, Alone, or Both (Fisher’s Test)
# I just realised the fisher's test won't work on the normalised data
# because everything will be rounded to 0 or 1 (integer) when divided by the counts
# See bottom of document for fix
# Ignore this fisher test data
fisher.test(data.usual)## Warning in fisher.test(data.usual): 'x' has been rounded to integer: Mean
## relative difference: 0.6869919##
## Fisher's Exact Test for Count Data
##
## data: data.usual
## p-value = 1
## alternative hypothesis: two.sidedplot.usual <- ggplot(data.usual.plot) +
geom_line(aes(x = usual, y = Social + 0.05, group = 1, color = "Social"), alpha = 0.7) +
geom_line(aes(x = usual, y = Care, group = 1, color = "Care")) +
geom_line(aes(x = usual, y = Spiritual, group = 1, color = "Spiritual")) +
geom_line(aes(x = usual, y = Eudaimonia-0.05, group = 1, color = "Eudaimonia")) +
labs(x = 'Usual Company during Visit', y = 'Count of Each RV',
color='RVs') +
scale_color_manual(values = c("Social" = "purple", "Care" = "pink", "Spiritual" = "lightblue", "Eudaimonia" = "lightgreen")) +
scale_x_discrete(labels = c("Alone", "Both", "Others")) +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
guides(color=guide_legend(ncol=2))
plot.usual.all <- ggplot(data.usual.all.plot) +
geom_line(aes(x = usual, y = RVs, group = 1, color = "RV")) +
# removed best fit line
# geom_smooth(aes(x=usual,y=RVs,group=1,color='Best Fit'),method = "lm",
# se = T,linetype='dashed',fill='lightblue') +
scale_color_manual(values = c("RV" = "maroon")) +
# , "Best Fit"="blue"
scale_x_discrete(labels = c("Alone", "Both", "Others")) +
coord_cartesian(ylim = c(0, NA)) +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
labs(x='Usual Company during Visit',y='Count of Combined RVs',color='Legend')
# this was for best fit line
# guides(color = guide_legend(override.aes = list(linetype = c("dashed", #"solid"), fill = c("lightblue", #"NA"))))
plot.usual;plot.usual.all
Part 3.1.4: Household (Fisher’s Test)
# I just realised the fisher's test won't work on the normalised data
# because everything will be rounded to 0 or 1 (integer) when divided by the counts
# See bottom of document for fix
# Ignore this fisher test data
fisher.test(data.household)## Warning in fisher.test(data.household): 'x' has been rounded to integer: Mean
## relative difference: 0.7708333##
## Fisher's Exact Test for Count Data
##
## data: data.household
## p-value = 1
## alternative hypothesis: two.sideddata.household.plot <- data.household.plot %>%
pivot_longer(cols = c(Social, Care, Spiritual, Eudaimonia), names_to = "RV", values_to = "Counts")
plot.household<-ggplot(data.household.plot) +
geom_bar(aes(x = household, y = Counts+0.1, fill = RV),
position = 'dodge', width=0.5,stat = "identity") +
labs(x = 'Household Number', y = 'Count of Each RV',
fill = 'RVs') +
scale_fill_manual(values = c("Social" = "purple", "Care" = "pink", "Spiritual" = "lightblue", "Eudaimonia" = "lightgreen")) +
scale_x_discrete(labels = c("Alone", "Others")) +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
guides(fill=guide_legend(ncol=2))
plot.household;#plot.household.all
Part 3.1.5: Nationality (Fisher’s Test)
# Quite evenly split between nationalities
# I just realised the fisher's test won't work on the normalised data
# because everything will be rounded to 0 or 1 (integer) when divided by the counts
# See bottom of document for fix
# Ignore this fisher test data
fisher.test(data.nationality)## Warning in fisher.test(data.nationality): 'x' has been rounded to integer: Mean
## relative difference: 0.737632##
## Fisher's Exact Test for Count Data
##
## data: data.nationality
## p-value = 1
## alternative hypothesis: two.sideddata.nationality.plot <- data.nationality.plot %>%
pivot_longer(cols = c(Social, Care, Spiritual, Eudaimonia), names_to = "RV", values_to = "Counts")
plot.nationality<-ggplot(data.nationality.plot) +
geom_bar(aes(x = nationality, y = Counts+0.1, fill = RV),
position = 'dodge', width=0.5,stat = "identity") +
labs(x = 'Nationality', y = 'Count of Each RV',
fill = 'RVs') +
scale_fill_manual(values = c("Social" = "purple", "Care" = "pink", "Spiritual" = "lightblue", "Eudaimonia" = "lightgreen")) +
scale_x_discrete(labels = c("Non-SG", "SG")) +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
guides(fill=guide_legend(ncol=2))
plot.nationality;#plot.nationality.all
Part 3.1.5: Activities (Chisq Test)
data.act.plot$act <- factor(data.act.plot$act)
#fisher.test(data.act) # too big to do fishers test
chisq.test(data.act)## Warning in chisq.test(data.act): Chi-squared approximation may be incorrect##
## Pearson's Chi-squared test
##
## data: data.act
## X-squared = 4.0189, df = 12, p-value = 0.9831plot.act <- ggplot(data.act.plot) +
geom_line(aes(x = act, y = Social, group = 1, color = "Social",
), alpha = 0.7) +
geom_line(aes(x = act, y = Care, group = 1, color = "Care",
)) +
geom_line(aes(x = act, y = Spiritual, group = 1, color = "Spiritual",
)) +
geom_line(aes(x = act, y = Eudaimonia, group = 1, color = "Eudaimonia",
)) +
labs(x = 'Activity', y = 'Count of Each RV',
color='RVs') +
scale_color_manual(values = c("Social" = "purple", "Care" = "pink", "Spiritual" = "lightblue", "Eudaimonia" = "lightgreen")) +
scale_x_discrete(labels = c("Work", "Exercise",
'Hangout','Relax','Others')) +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
guides(color=guide_legend(ncol=2))
plot.act.all <- ggplot(data.act.all.plot) +
geom_line(aes(x = act, y = RVs, group = 1, color = "RV")) +
# removed best fit line
# geom_smooth(aes(x=act,y=RVs,group=1,color='Best Fit'),method = "lm",
# se = T,linetype='dashed',fill='lightblue') +
scale_color_manual(values = c("RV" = "maroon")) +
# for best fit: "Best Fit"="blue"
scale_x_discrete(labels = c("Work", "Exercise",
'Hangout','Relax','Others')) +
coord_cartesian(ylim = c(0, NA)) +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
labs(x='Activity',y='Count of Combined RVs', color='Legend')
# this was for best fit
# guides(color = guide_legend(override.aes = list(linetype = c("dashed", "solid"), fill = c("lightblue", "NA")), ncol=2))
plot.act;plot.act.all
Part 3.2: Association of mentionsothercountry with RVs (Fisher’s Test)
# count number that mentions other country
count_mentionsothercountry <- nrow(data.unique.tags[data.unique.tags$tag == 'mentionsothercountry', ])
count_doesntmention <- 30- count_mentionsothercountry
data.mot <- data.format(data4,'mentionsothercountry')
rownames(data.mot)[rownames(data.mot)=='opp']<- 'doesnotmentionsothercountry'
# have to divide manually bc doesntmention is not a tag in the original func
if("doesnotmentionsothercountry" %in% rownames(data.mot)){
# Divide the values for 'doesnotmentionsothercountry' by 'count_doesntmention'
data.mot["doesnotmentionsothercountry", ] <- data.mot["doesnotmentionsothercountry", ] / count_doesntmention
}
data.mot.plot <- data.mot;data.mot.plot$mot<-rownames(data.mot)
data.mot.all <- data.mot; data.mot.all$RVs <- rowSums(data.mot.all)
data.mot.all <- data.mot.all[,'RVs',drop=F]
data.mot.all.plot <- data.mot.all;data.mot.all.plot$mot <- rownames(data.mot.all)
# I just realised the fisher's test won't work on the normalised data
# because everything will be rounded to 0 or 1 (integer) when divided by the counts
# See bottom of document for fix
# Ignore this fisher test data
fisher.test(data.mot)## Warning in fisher.test(data.mot): 'x' has been rounded to integer: Mean
## relative difference: 0.7405556##
## Fisher's Exact Test for Count Data
##
## data: data.mot
## p-value = 1
## alternative hypothesis: two.sideddata.mot.plot <- data.mot.plot %>%
pivot_longer(cols = c(Social, Care, Spiritual, Eudaimonia), names_to = "RV", values_to = "Counts")
plot.mot<-ggplot(data.mot.plot) +
geom_bar(aes(x = mot, y = Counts, fill = RV),
position = 'dodge', width=0.5,stat = "identity") +
labs(x = 'Mentions Another Country', y = 'Count of Each RV',
fill = 'RVs') +
scale_fill_manual(values = c("Social" = "purple", "Care" = "pink", "Spiritual" = "lightblue", "Eudaimonia" = "lightgreen")) +
scale_x_discrete(labels = c("No", "Yes")) +
scale_y_continuous(breaks = seq(0, max(data.mot.plot$Counts+0.1), by = 2)) +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
guides(fill=guide_legend(ncol=2))
plot.mot
Part 3.3: Association of young factors with RVs (Fisher’s Test)
# count number that has data on young exposure or not
count_younghasdata <-
nrow(data.unique.tags[data.unique.tags$tag == 'young.not', ])+
nrow(data.unique.tags[data.unique.tags$tag == 'young.not.butwanted', ])+
nrow(data.unique.tags[data.unique.tags$tag == 'young.butdidntaffect', ])+
nrow(data.unique.tags[data.unique.tags$tag == 'young.young', ])
count_younguncertain <- 30- count_younghasdata
data.young <- data.format(data4,'young')
rownames(data.young)[rownames(data.young)=='opp']<- 'Uncertain'
if("Uncertain" %in% rownames(data.young)){
# Divide the values by 'count_younguncertain'
data.young["Uncertain", ] <- data.young["Uncertain", ] / count_younguncertain
}
data.young <- data.young[c('Uncertain','young.not',
'young.not.butwanted','young.butdidntaffect',
'young.young'),]
data.young.plot <- data.young;data.young.plot$young<-c('1Uncertain','2young.not',
'3young.not.butwanted','4young.butdidntaffect',
'5young.young')
data.young.all <- data.young; data.young.all$RVs <- rowSums(data.young.all)
data.young.all <- data.young.all[,'RVs',drop=F]
data.young.all.plot <- data.young.all;data.young.all.plot$young<-c('1Uncertain','2young.not',
'3young.not.butwanted','4young.butdidntaffect',
'5young.young')
# I just realised the fisher's test won't work on the normalised data
# because everything will be rounded to 0 or 1 (integer) when divided by the counts
# See bottom of document for fix
# Ignore this fisher test data
fisher.test(data.young)## Warning in fisher.test(data.young): 'x' has been rounded to integer: Mean
## relative difference: 0.7567441##
## Fisher's Exact Test for Count Data
##
## data: data.young
## p-value = 1
## alternative hypothesis: two.sidedplot.young <- ggplot(data.young.plot) +
geom_line(aes(x = young, y = Social + 0.05, group = 1, color = "Social"), alpha = 0.7) +
geom_line(aes(x = young, y = Care, group = 1, color = "Care")) +
geom_line(aes(x = young, y = Spiritual, group = 1, color = "Spiritual")) +
geom_line(aes(x = young, y = Eudaimonia-0.05, group = 1, color = "Eudaimonia")) +
labs(x = 'Exposure since Young', y = 'Count of Each RV',
color='RVs') +
scale_color_manual(values = c("Social" = "purple", "Care" = "pink", "Spiritual" = "lightblue", "Eudaimonia" = "lightgreen")) +
scale_x_discrete(labels = c('Uncertain','No','No but wanted','Yes but no effect',
'Yes')) +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
guides(color=guide_legend(ncol=2))
plot.young.all <- ggplot(data.young.all.plot) +
geom_line(aes(x = young, y = RVs, group = 1, color = "RV")) +
geom_smooth(aes(x=young,y=RVs,group=1,color='Best Fit'),method = "lm",
se = T,linetype='dashed',fill='lightblue') +
scale_color_manual(values = c("RV" = "maroon", "Best Fit"="blue")) +
scale_x_discrete(labels = c('Uncertain','No','No but wanted','Yes but no effect',
'Yes')) +
coord_cartesian(ylim = c(0, NA)) +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1))+
labs(x='Exposure since Young',y='Count of Combined RVs', color='Legend')+
guides(color = guide_legend(override.aes = list(linetype = c("dashed", "solid"),
fill = c("lightblue", "NA")),
ncol=2))
plot.young;plot.young.all
## `geom_smooth()` using formula = 'y ~ x'
Part 4: Venn Diagram of Instrumental & Relational
Also: % of instrumental that also has corresponding relational
v.inst=0;v.rel=0;v.inst.rel=0
v.inst.c=0;v.rel.c=0;v.inst.rel.c=0
v.inst.soc=0;v.rel.soc=0;v.inst.rel.soc=0
v.inst.spi=0;v.rel.spi=0;v.inst.rel.spi=0
v.inst.eud=0;v.rel.eud=0;v.inst.rel.eud=0
data4 <- data4[!grepl('value.instrumental.eudaimonia',data4$tag),]
for (i in seq(1,30,1)){
temp <- data4[data4$document==(paste0('Interview ',i)),]
temp <- temp %>% distinct(tag, .keep_all = TRUE)
if (sum(grepl('value.instrumental',temp$tag))>=1){
v.inst = v.inst+1
}
if (sum(grepl('value.relational',temp$tag))>=1){
v.rel = v.rel+1
}
if (sum(grepl('value.relational',temp$tag))>=1 && sum(grepl('value.instrumental',temp$tag))>=1){
v.inst.rel = v.inst.rel+1
}
# for .care
if (sum(grepl('value.instrumental.care',temp$tag))>=1){
v.inst.c = v.inst.c+1
}
if (sum(grepl('value.relational.care',temp$tag))>=1){
v.rel.c = v.rel.c+1
}
if (sum(grepl('value.relational.care',temp$tag))>=1 &&
sum(grepl('value.instrumental.care',temp$tag))>=1){
v.inst.rel.c = v.inst.rel.c+1
}
# for .soc
if (sum(grepl('value.instrumental.social',temp$tag))>=1){
v.inst.soc = v.inst.soc+1
}
if (sum(grepl('value.relational.social',temp$tag))>=1){
v.rel.soc = v.rel.soc+1
}
if (sum(grepl('value.relational.social',temp$tag))>=1 &&
sum(grepl('value.instrumental.social',temp$tag))>=1){
v.inst.rel.soc = v.inst.rel.soc+1
}
# for .spi
if (sum(grepl('value.instrumental.spiritual',temp$tag))>=1){
v.inst.spi = v.inst.spi+1
}
if (sum(grepl('value.relational.spiritual',temp$tag))>=1){
v.rel.spi = v.rel.spi+1
}
if (sum(grepl('value.relational.spiritual',temp$tag))>=1 &&
sum(grepl('value.instrumental.spiritual',temp$tag))>=1){
v.inst.rel.spi = v.inst.rel.spi+1
}
}
inst.rel.results <- data.frame(
Inst.Rel = (v.inst.rel/v.inst)*100,
Inst.Rel.c = (v.inst.rel.c/v.inst.c)*100,
Inst.Rel.soc = (v.inst.rel.soc/v.inst.soc)*100,
Inst.Rel.spi = (v.inst.rel.spi/v.inst.spi)*100
)
# venn for inst.rel
set1_elements <- seq(1,v.inst) # Set1 has v.inst elements
set2_elements <- seq(v.inst+1-v.inst.rel,v.inst+v.rel-v.inst.rel) # Set2 has v.rel elements
venn.plot <- venn.diagram(
x = list(Set1 = set1_elements, Set2 = set2_elements),
category.names = c("Instrumental", "Relational"),
filename = 'venn_plot_inst_rel.png',
main = "Instrumental and Relational",
main.cex = 1.5,
main.fontface = 'bold',
# main.fontfamily='arial',
# cat.fontfamily='arial',
cat.pos = c(340,30),
fill = c('pink', 'lightblue')
)
# venn for care
set1_elements <- seq(1,v.inst.c) # Set1 has v.inst elements
set2_elements <- seq(v.inst.c+1-v.inst.rel.c,v.inst.c+v.rel.c-v.inst.rel.c) # Set2 has v.rel elements
# Create the Venn diagram
venn.plot.c <- venn.diagram(
x = list(Set1 = set1_elements, Set2 = set2_elements),
category.names = c("Instrumental", "Relational"),
filename = 'venn_plot_c.png',
main = "Instrumental and Relational (Care)",
main.cex = 1.5,
main.fontface = 'bold',
# main.fontfamily='arial',
# cat.fontfamily='arial',
cat.pos = 2.5,
fill = c('pink', 'lightblue')
)
# venn for soc
set1_elements <- seq(1,v.inst.soc) # Set1 has v.inst elements
set2_elements <- seq(v.inst.soc+1-v.inst.rel.soc,
v.inst.soc+v.rel.soc-v.inst.rel.soc) # Set2 has v.rel elements
venn.plot.soc <- venn.diagram(
x = list(Set1 = set1_elements, Set2 = set2_elements),
category.names = c("Instrumental", "Relational"),
filename = 'venn_plot_soc.png',
main = "Instrumental and Relational (Social)",
main.cex = 1.5,
main.fontface = 'bold',
# main.fontfamily='arial',
# cat.fontfamily='arial',
cat.pos = c(0,35),
cat.dist = c(0.02,0.05),
fill = c('pink', 'lightblue')
)
# venn for spi
set1_elements <- seq(1,v.inst.spi) # Set1 has v.inst elements
set2_elements <- seq(v.inst.spi+1-v.inst.rel.spi,
v.inst.spi+v.rel.spi-v.inst.rel.spi) # Set2 has v.rel elements
venn.plot.spi <- venn.diagram(
x = list(Set1 = set1_elements, Set2 = set2_elements),
category.names = c("Instrumental", "Relational"),
filename = 'venn_plot_spi.png',
main = "Instrumental and Relational (Spiritual)",
main.cex = 1.5,
main.fontface = 'bold',
# main.fontfamily='arial',
# cat.fontfamily='arial',
cat.pos = c(210,180),
fill = c('pink', 'lightblue')
)
print(inst.rel.results)## Inst.Rel Inst.Rel.c Inst.Rel.soc Inst.Rel.spi
## 1 79.31034 31.25 21.73913 66.66667All Plots
# Scatter
ggsave("C:/Users/rebec/OneDrive - Nanyang Technological University/2022 Documents/uni life/Y4 FYP/survey time LETS GOOO/tags_plot.png", tags.plot,width = 12, height = 10,bg='white')
# Factors with RVs
empty_plot <- ggplot() +
theme_void()
combined.RV <- plot_grid(empty_plot,plot.age,plot.age.all,
plot.freq,plot.freq.all,
plot.usual,plot.usual.all,
plot.young,plot.young.all,
plot.act, plot.act.all,
plot.household,
plot.nationality,
plot.mot,labels=c('','A','B','C','D',
'E','F','G','H',
'I','J','K', 'L','M'),ncol=4)## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'title.text <- "Relational Values\nwith Factors" # Each word on a new line
# Annotate the plot with the wrapped text label
combined.RV.title <- combined.RV +
annotate("text", x = -Inf, y = Inf,
label = str_wrap(title.text, width = 10),
hjust = 0, vjust = 1.1, size = 10,fontface='bold')
ggsave("combined_RV.png", combined.RV.title, width = 12, height = 10,bg='white')
#Venn
image1 <- imager::load.image('C:/Users/rebec/OneDrive - Nanyang Technological University/2022 Documents/uni life/Y4 FYP/survey time LETS GOOO/venn_plot_inst_rel.png')
image2 <- imager::load.image("C:/Users/rebec/OneDrive - Nanyang Technological University/2022 Documents/uni life/Y4 FYP/survey time LETS GOOO/venn_plot_c.png")
image3 <- imager::load.image("C:/Users/rebec/OneDrive - Nanyang Technological University/2022 Documents/uni life/Y4 FYP/survey time LETS GOOO/venn_plot_soc.png")
image4 <- imager::load.image("C:/Users/rebec/OneDrive - Nanyang Technological University/2022 Documents/uni life/Y4 FYP/survey time LETS GOOO/venn_plot_spi.png")
image1_grob <- rasterGrob(image1)
image2_grob <- rasterGrob(image2)
image3_grob <- rasterGrob(image3)
image4_grob <- rasterGrob(image4)
title_grob.venn <- textGrob("Instrumental & Relational Values", gp = gpar(fontsize = 16, fontface = "bold"))
# Arrange images in a grid
combined.venn <- grid.arrange(image1_grob, image2_grob, image3_grob, image4_grob,
top = title_grob.venn,nrow = 2, ncol = 2)
ggsave(
"/Users/rebec/OneDrive - Nanyang Technological University/2022 Documents/uni life/Y4 FYP/survey time LETS GOOO/combined_venn_plots.png", combined.venn,width = 10, height = 10,
bg='white')# I just realised the fisher's test won't work either on the normalised data
# because everything will be rounded to 0 or 1 (integer) when divided by the counts
# so the above Fisher's test p values are not accurate; in order to get the correct one,
# one has to change the format to this instead: (Part 3.1)
# then run the whole code again to get the actual fishers data
# Note: would need to remove certain lines from the young and the mentionsothercountry section
# the parts to divide it by the count of the opp of young and mentionsothercountry
# Alternative: made another script to just get the fishers data
# data.format <- function (df,tag.var){
#
# unique.tag <- unique(df$tag[grep(paste(tag.var,collapse='|'), df$tag)])
# unique.tag <- unique.tag[order(unique.tag)]
#
# v.r.<- c('value.relational.social','value.relational.care',
# 'value.relational.spiritual','value.relational.eudaimonia')
# v.r.label <- c('Social','Care','Spiritual','Eudaimonia')
# if (length(unique.tag)==1){
#
# df.out <- data.frame(matrix(0, ncol = length(v.r.), nrow = (length(unique.tag) + 1)))
# rownames(df.out)<-c(unique.tag,'opp')
# colnames(df.out)<-v.r.label
# }
# else{
# df.out <- data.frame(matrix(0, ncol = length(v.r.), nrow = length(unique.tag)))
# rownames(df.out)<-unique.tag
# colnames(df.out)<-v.r.label
# }
#
# int.num <- 1
#
#
# while (int.num <=30) {
#
# temp <- df[df$document==(paste0('Interview ',int.num)),]
#
# temp <- temp %>% distinct(tag, .keep_all = TRUE)
#
# if (length(unique.tag)<1){
#
# tag.full <- c(temp$tag[grep(paste(tag.var,collapse='|'),temp$tag)],'opp')
# }else{
#
# tag.full <- temp$tag[grep(paste(tag.var,collapse='|'),temp$tag)]
# }
#
# if (length(tag.full)==0){
# tag.full = 0
# }
# # tag.full <- ifelse(length(unique.tag)==1,
# # c(temp$tag[grep(tag.var,temp$tag)],'opp'),
# # temp$tag[grep(tag.var,temp$tag)])
#
# for (x in 1:length(tag.full)){
#
# if ((length(tag.full)!=0) && (!is.na(tag.full[x])) && sum(grepl(tag.full[x],temp$tag)) >=1){
#
# for (i in 1:nrow(temp)){
#
# for (j in 1:length(v.r.)){
#
# if (v.r.[j]==temp$tag[i]){
#
# df.out[tag.full[x],v.r.label[j]] = df.out[tag.full[x],v.r.label[j]]+1
#
# }
# }
# }
# }
# else{
#
# if (!'opp' %in% rownames(df.out)) {
# new.row <- data.frame(matrix(0, ncol = length(v.r.), nrow = 1))
# colnames(new.row) <- v.r.label
# rownames(new.row) <- 'opp'
# df.out <- rbind(df.out, new.row)
# }
#
# for (i in 1:nrow(temp)){
#
# for (j in 1:length(v.r.)){
#
# if (v.r.[j]==temp$tag[i]){
#
# df.out['opp',v.r.label[j]] = df.out['opp',v.r.label[j]]+1
#
# }
# }
# }
# }
#
# }
# int.num = int.num+1
# }
#
#
#
# return (df.out)
# }