####WORKPLACE SETTING####
setwd("C:/Users/vitto/Desktop/Autocritica/Analisi dati")
library(magrittr)
library(dplyr)
##
## Caricamento pacchetto: 'dplyr'
## I seguenti oggetti sono mascherati da 'package:stats':
##
## filter, lag
## I seguenti oggetti sono mascherati da 'package:base':
##
## intersect, setdiff, setequal, union
library(careless)
## Warning: il pacchetto 'careless' è stato creato con R versione 4.4.2
library(sampling)
## Warning: il pacchetto 'sampling' è stato creato con R versione 4.4.2
library(psych)
library(stringr)
#for map function
library(purrr)
##
## Caricamento pacchetto: 'purrr'
## Il seguente oggetto è mascherato da 'package:magrittr':
##
## set_names
#for network graphs
library(igraph)
## Warning: il pacchetto 'igraph' è stato creato con R versione 4.4.3
##
## Caricamento pacchetto: 'igraph'
## I seguenti oggetti sono mascherati da 'package:purrr':
##
## compose, simplify
## I seguenti oggetti sono mascherati da 'package:dplyr':
##
## as_data_frame, groups, union
## I seguenti oggetti sono mascherati da 'package:stats':
##
## decompose, spectrum
## Il seguente oggetto è mascherato da 'package:base':
##
## union
library(networkD3)
## Warning: il pacchetto 'networkD3' è stato creato con R versione 4.4.3
#for slopegraph
library(slopegraph)
####CLEAN DATA INPUT####
dati <- read.csv("clean_original_data.csv")
####CARELESS RESPONDING####
#Resampled Individual Reliability Function
rir <- function(x,factors){
iterations <- 60
#objects
df1_mean <- data.frame(matrix(nrow = nrow(x),
ncol = length(factors)))
df2_mean <- data.frame(matrix(nrow = nrow(x),
ncol = length(factors)))
ir <- data.frame(matrix(nrow = nrow(x),
ncol = iterations))
for (l in 1:iterations){
##Cycle for mean calculation
#Objects
a <- 0
j <- 1
for (i in factors){
#section selection
a <- a+i
sec <- x[,(a-i+1):a]
#random sampling
sel <- as.logical(srswor(round(ncol(sec)/2),ncol(sec)))
#means
df1_mean[,j] <- apply(sec[sel],1,mean,na.rm=T)
df2_mean[,j] <- apply(sec[!sel],1,mean,na.rm=T)
j <- j+1
}
#Correlation
ir[,l] <- sapply(1:nrow(df1_mean), function(x){
cor(
as.numeric(df1_mean[x,]),
as.numeric(df2_mean[x,]),
use="complete.obs"
)
}
)
}
meanIr <- apply(ir,1,mean)
riri <- 2*meanIr/(1 + meanIr)
riri
}
#Rir calculation
rir_results <- dati %>%
select(contains("_rs_"),contains("_hs_"),contains("_is_"),contains("shame")) %>%
rir(.,c(8,8,5,5,9,9,23))
#Mahalanobis distance
mahad_results <- dati %>%
select(contains("_rs_"),contains("_hs_"),contains("_is_"),contains("shame")) %>%
mahad(plot=F,flag=T,confidence=0.90)
#cbind to show results
cbind.data.frame(code = dati$codice[mahad_results$flagged],
rir = rir_results[mahad_results$flagged],
mahad = mahad_results$d_sq[mahad_results$flagged])
## code rir mahad
## 1 mb1605 0.4389291 86.15328
## 2 pst0307 0.8641571 94.74849
## 3 cm2608 0.9853661 85.84252
## 4 al1308 0.8102885 85.64281
## 5 el3004 0.8933870 83.62822
## 6 lg2410 0.8754199 83.78218
## 7 mg1603 0.5807576 89.21355
## 8 gf0705 0.6764467 88.01420
## 9 mc3112xx 0.9196018 97.20491
## 10 am0501 0.8760383 94.58552
## 11 mc0206 0.9300554 82.72440
#remove those both with low rir and flagged by mahalanobis
dati <- dati %>%
slice(-which(dati$codice%in%c("mb1605","mg1603","gf0705")))
####SCORING####
dati <- dati %>%
mutate(
FSCRSt_s1_is = apply(dati%>%select(contains("_s1_is_")),1,sum),
FSCRSt_s1_rs = apply(dati%>%select(contains("_s1_rs_")),1,sum),
FSCRSt_s1_hs = apply(dati%>%select(contains("_s1_hs_")),1,sum),
FSCRSt_s2_is = apply(dati%>%select(contains("_s2_is_")),1,sum),
FSCRSt_s2_rs = apply(dati%>%select(contains("_s2_rs_")),1,sum),
FSCRSt_s2_hs = apply(dati%>%select(contains("_s2_hs_")),1,sum),
shame = apply(dati%>%select(contains("shame")),1,sum)
)
####THEORY-BASED STATE FSCRS SCORING - based on trait version####
#Scoring of subscales
subscale_names <- c("is","rs","hs")
subscale_items <- list(c(1,2,4,6,7,13,16,17,19),
c(3,5,8,11,12,15,18,20),
c(9,10,14,21))
for (i in c("FSCRSs_s1_PRE_","FSCRSs_s1_POST_","FSCRSs_s2_","FSCRSs_s3_","FSCRSs_s4_")){
for (j in 1:3){
dati[[paste0(i,subscale_names[j],"_th")]] <- dati %>%
select(num_range(i,subscale_items[[j]])) %>%
apply(1,sum)
}
}
#plot
dati %>%
select(matches("_th$")) %>%
error.bars(las="2",xlab="")
#Reversing reassuring self
dati <- dati %>%
mutate(across(ends_with("rs_th"),\(x)x*(-1)))
#Scoring of scales
for (i in c("FSCRSs_s1_PRE","FSCRSs_s1_POST","FSCRSs_s2","FSCRSs_s3","FSCRSs_s4")){
dati[[paste0(i,"_th")]] <- dati %>%
select(paste0(i,"_",c("is","rs","hs"),"_th")) %>%
apply(1,sum)
}
#### EFFECT OF MANIPULATION ####
t.test(dati$FSCRSs_s1_PRE_is_th,
dati$FSCRSs_s1_POST_is_th,
paired = T,
alternative = "greater")
##
## Paired t-test
##
## data: dati$FSCRSs_s1_PRE_is_th and dati$FSCRSs_s1_POST_is_th
## t = 1.206, df = 115, p-value = 0.1152
## alternative hypothesis: true mean difference is greater than 0
## 95 percent confidence interval:
## -0.1196147 Inf
## sample estimates:
## mean difference
## 0.3189655
t.test(dati$FSCRSs_s1_PRE_rs_th,
dati$FSCRSs_s1_POST_rs_th,
paired = T,
alternative = "less")
##
## Paired t-test
##
## data: dati$FSCRSs_s1_PRE_rs_th and dati$FSCRSs_s1_POST_rs_th
## t = -1.2853, df = 115, p-value = 0.1006
## alternative hypothesis: true mean difference is less than 0
## 95 percent confidence interval:
## -Inf 0.1000541
## sample estimates:
## mean difference
## -0.3448276
t.test(dati$FSCRSs_s1_PRE_hs_th,
dati$FSCRSs_s1_POST_hs_th,
paired = T,
alternative = "greater")
##
## Paired t-test
##
## data: dati$FSCRSs_s1_PRE_hs_th and dati$FSCRSs_s1_POST_hs_th
## t = -0.18031, df = 115, p-value = 0.5714
## alternative hypothesis: true mean difference is greater than 0
## 95 percent confidence interval:
## -0.1757966 Inf
## sample estimates:
## mean difference
## -0.01724138
dati %>%
select(contains("_th")) %>%
select(1:15) %>%
error.bars(
col=rep(1:3,5)
)
#### ITEM RESPONSE DISTRIBUTION ####
vdata <- dati %>%
select(num_range("FSCRSs_s1_PRE_",1:36))
par(mfrow=c(2,2))
barplots <- vdata %>%
map(\(x)factor(x,levels=0:4)) %>%
map(table) %>%
imap(~barplot(.x,main=.y))
description <- vdata %>%
describe
#eliminatig 0-median items
vdata <- vdata %>%
select(-which(description$median==0))
#### EXPLORATIVE FACTOR ANALYSIS ####
#Number of factors
par(mfrow=c(1,1))
parallel <- vdata %>%
fa.parallel
## Parallel analysis suggests that the number of factors = 2 and the number of components = 2
#Exploratory Factor analysis
for(i in 1:5){
vdata %>%
fa(i) %$%
loadings %>%
print
}
##
## Loadings:
## MR1
## FSCRSs_s1_PRE_1 -0.732
## FSCRSs_s1_PRE_2 -0.713
## FSCRSs_s1_PRE_3 0.692
## FSCRSs_s1_PRE_4 -0.602
## FSCRSs_s1_PRE_5 0.824
## FSCRSs_s1_PRE_6 -0.660
## FSCRSs_s1_PRE_7 -0.798
## FSCRSs_s1_PRE_8 0.728
## FSCRSs_s1_PRE_11 0.785
## FSCRSs_s1_PRE_12 0.777
## FSCRSs_s1_PRE_13 -0.760
## FSCRSs_s1_PRE_15 0.829
## FSCRSs_s1_PRE_16 -0.806
## FSCRSs_s1_PRE_17 -0.631
## FSCRSs_s1_PRE_18 0.744
## FSCRSs_s1_PRE_19 -0.443
## FSCRSs_s1_PRE_20 0.720
## FSCRSs_s1_PRE_21 -0.755
## FSCRSs_s1_PRE_22 -0.692
## FSCRSs_s1_PRE_23 -0.705
## FSCRSs_s1_PRE_24 -0.713
## FSCRSs_s1_PRE_25 0.814
## FSCRSs_s1_PRE_26 0.883
## FSCRSs_s1_PRE_32 -0.436
## FSCRSs_s1_PRE_34 0.817
## FSCRSs_s1_PRE_35 0.768
## FSCRSs_s1_PRE_36 0.782
##
## MR1
## SS loadings 14.527
## Proportion Var 0.538
## Caricamento dei namespace richiesti: GPArotation
##
## Loadings:
## MR1 MR2
## FSCRSs_s1_PRE_1 -0.227 0.587
## FSCRSs_s1_PRE_2 0.875
## FSCRSs_s1_PRE_3 0.793
## FSCRSs_s1_PRE_4 -0.113 0.561
## FSCRSs_s1_PRE_5 0.676 -0.213
## FSCRSs_s1_PRE_6 -0.238 0.493
## FSCRSs_s1_PRE_7 -0.200 0.692
## FSCRSs_s1_PRE_8 0.806
## FSCRSs_s1_PRE_11 0.874
## FSCRSs_s1_PRE_12 0.801
## FSCRSs_s1_PRE_13 -0.292 0.548
## FSCRSs_s1_PRE_15 0.935
## FSCRSs_s1_PRE_16 -0.140 0.767
## FSCRSs_s1_PRE_17 -0.130 0.577
## FSCRSs_s1_PRE_18 0.820
## FSCRSs_s1_PRE_19 -0.145 0.346
## FSCRSs_s1_PRE_20 0.684
## FSCRSs_s1_PRE_21 -0.569 0.248
## FSCRSs_s1_PRE_22 0.170 0.977
## FSCRSs_s1_PRE_23 0.763
## FSCRSs_s1_PRE_24 0.832
## FSCRSs_s1_PRE_25 0.485 -0.403
## FSCRSs_s1_PRE_26 0.664 -0.292
## FSCRSs_s1_PRE_32 0.412
## FSCRSs_s1_PRE_34 0.746 -0.131
## FSCRSs_s1_PRE_35 0.844
## FSCRSs_s1_PRE_36 0.903
##
## MR1 MR2
## SS loadings 8.584 6.281
## Proportion Var 0.318 0.233
## Cumulative Var 0.318 0.551
##
## Loadings:
## MR1 MR2 MR3
## FSCRSs_s1_PRE_1 -0.228 0.599 -0.108
## FSCRSs_s1_PRE_2 0.874
## FSCRSs_s1_PRE_3 0.785
## FSCRSs_s1_PRE_4 -0.116 0.565
## FSCRSs_s1_PRE_5 0.673 -0.235 0.142
## FSCRSs_s1_PRE_6 -0.238 0.500
## FSCRSs_s1_PRE_7 -0.199 0.718 -0.191
## FSCRSs_s1_PRE_8 0.806 -0.244
## FSCRSs_s1_PRE_11 0.862
## FSCRSs_s1_PRE_12 0.800 -0.236
## FSCRSs_s1_PRE_13 -0.291 0.542 0.108
## FSCRSs_s1_PRE_15 0.921
## FSCRSs_s1_PRE_16 -0.143 0.759
## FSCRSs_s1_PRE_17 -0.126 0.565 0.192
## FSCRSs_s1_PRE_18 0.811
## FSCRSs_s1_PRE_19 -0.129 0.326 0.462
## FSCRSs_s1_PRE_20 0.683 -0.111 0.164
## FSCRSs_s1_PRE_21 -0.565 0.230 0.288
## FSCRSs_s1_PRE_22 0.165 0.960 0.131
## FSCRSs_s1_PRE_23 0.754
## FSCRSs_s1_PRE_24 0.843 -0.118
## FSCRSs_s1_PRE_25 0.482 -0.410
## FSCRSs_s1_PRE_26 0.658 -0.303
## FSCRSs_s1_PRE_32 0.401 0.132
## FSCRSs_s1_PRE_34 0.743 -0.153 0.141
## FSCRSs_s1_PRE_35 0.840 0.146
## FSCRSs_s1_PRE_36 0.889
##
## MR1 MR2 MR3
## SS loadings 8.442 6.279 0.683
## Proportion Var 0.313 0.233 0.025
## Cumulative Var 0.313 0.545 0.571
##
## Loadings:
## MR1 MR2 MR4 MR3
## FSCRSs_s1_PRE_1 -0.257 0.543 -0.109
## FSCRSs_s1_PRE_2 0.806 0.105
## FSCRSs_s1_PRE_3 0.777
## FSCRSs_s1_PRE_4 0.353 0.491
## FSCRSs_s1_PRE_5 0.697 -0.215 0.126
## FSCRSs_s1_PRE_6 -0.263 0.488
## FSCRSs_s1_PRE_7 -0.253 0.653 -0.205
## FSCRSs_s1_PRE_8 0.720 -0.313
## FSCRSs_s1_PRE_11 0.845
## FSCRSs_s1_PRE_12 0.725 -0.287
## FSCRSs_s1_PRE_13 -0.283 0.542
## FSCRSs_s1_PRE_15 0.894
## FSCRSs_s1_PRE_16 -0.145 0.721
## FSCRSs_s1_PRE_17 -0.137 0.714 -0.265 0.125
## FSCRSs_s1_PRE_18 0.820
## FSCRSs_s1_PRE_19 0.379 0.453
## FSCRSs_s1_PRE_20 0.671 -0.271
## FSCRSs_s1_PRE_21 -0.479 0.209 0.127 0.343
## FSCRSs_s1_PRE_22 0.152 0.950
## FSCRSs_s1_PRE_23 0.774
## FSCRSs_s1_PRE_24 0.687 0.305
## FSCRSs_s1_PRE_25 0.424 -0.221 -0.428
## FSCRSs_s1_PRE_26 0.638 -0.242 -0.145
## FSCRSs_s1_PRE_32 0.425 0.103
## FSCRSs_s1_PRE_34 0.762 -0.129 0.120
## FSCRSs_s1_PRE_35 0.889 0.105 0.165
## FSCRSs_s1_PRE_36 0.878
##
## MR1 MR2 MR4 MR3
## SS loadings 8.085 5.580 0.779 0.711
## Proportion Var 0.299 0.207 0.029 0.026
## Cumulative Var 0.299 0.506 0.535 0.561
## Warning in GPFoblq(A, Tmat = Tmat, normalize = normalize, eps = eps, maxit =
## maxit, : convergence not obtained in GPFoblq. 1000 iterations used.
##
## Loadings:
## MR1 MR2 MR4 MR5 MR3
## FSCRSs_s1_PRE_1 -0.360 0.433 0.248 0.152
## FSCRSs_s1_PRE_2 0.707 0.207
## FSCRSs_s1_PRE_3 0.824 0.134 -0.202 -0.116
## FSCRSs_s1_PRE_4 0.173 0.650
## FSCRSs_s1_PRE_5 0.706 -0.186 -0.101
## FSCRSs_s1_PRE_6 -0.377 0.409 0.144 0.186
## FSCRSs_s1_PRE_7 -0.265 0.595 0.137 -0.195
## FSCRSs_s1_PRE_8 0.602 -0.122 -0.364
## FSCRSs_s1_PRE_11 0.795 -0.127
## FSCRSs_s1_PRE_12 0.500 0.288 -0.337
## FSCRSs_s1_PRE_13 -0.163 0.578 -0.217 0.106
## FSCRSs_s1_PRE_15 0.830 -0.114
## FSCRSs_s1_PRE_16 -0.155 0.652 0.159
## FSCRSs_s1_PRE_17 -0.193 0.711 -0.187 0.111 0.127
## FSCRSs_s1_PRE_18 0.771
## FSCRSs_s1_PRE_19 0.352 0.470
## FSCRSs_s1_PRE_20 0.430 -0.191 0.475
## FSCRSs_s1_PRE_21 -0.380 0.186 0.177 0.382
## FSCRSs_s1_PRE_22 0.172 0.911
## FSCRSs_s1_PRE_23 0.748
## FSCRSs_s1_PRE_24 0.562 0.390
## FSCRSs_s1_PRE_25 0.203 -0.176 -0.401 0.374 -0.116
## FSCRSs_s1_PRE_26 0.509 -0.248 -0.129 0.215
## FSCRSs_s1_PRE_32 0.433 0.104
## FSCRSs_s1_PRE_34 0.639 -0.170 0.246
## FSCRSs_s1_PRE_35 0.813 -0.105 0.138 0.150 0.135
## FSCRSs_s1_PRE_36 0.813
##
## MR1 MR2 MR4 MR5 MR3
## SS loadings 6.534 4.757 1.122 0.758 0.821
## Proportion Var 0.242 0.176 0.042 0.028 0.030
## Cumulative Var 0.242 0.418 0.460 0.488 0.518
#-> 1 factor
#### ITEM VARIABILITY ####
description <- vdata %>%
describe
#### REDUNDANCY #####
#Write redundancy csv for inspection
corUpp <- cor(vdata)
corUpp[lower.tri(corUpp,diag=T)] <- NA
redundant <- corUpp %>%
{which(.>.69 | .<(-.69))} %>%
arrayInd(dim(corUpp)) %>%
{cbind.data.frame(
names(vdata)[.[,1]],
names(vdata)[.[,2]],
round(cor(vdata),2)[.],
description$range[.[,1]],
describe(vdata)$range[.[,2]]
)} %T>%
write.csv("redundancy.csv")
names(redundant) <- c("item1","item2","r","range item 1","range item 2")
c(redundant[,1],redundant[,2]) %>%
table %>%
t
## .
## FSCRSs_s1_PRE_11 FSCRSs_s1_PRE_12 FSCRSs_s1_PRE_13 FSCRSs_s1_PRE_15
## [1,] 7 4 1 9
## .
## FSCRSs_s1_PRE_16 FSCRSs_s1_PRE_18 FSCRSs_s1_PRE_2 FSCRSs_s1_PRE_20
## [1,] 4 4 2 2
## .
## FSCRSs_s1_PRE_22 FSCRSs_s1_PRE_23 FSCRSs_s1_PRE_24 FSCRSs_s1_PRE_25
## [1,] 3 1 1 1
## .
## FSCRSs_s1_PRE_26 FSCRSs_s1_PRE_34 FSCRSs_s1_PRE_35 FSCRSs_s1_PRE_36
## [1,] 11 5 3 4
## .
## FSCRSs_s1_PRE_5 FSCRSs_s1_PRE_7 FSCRSs_s1_PRE_8
## [1,] 4 4 4
#Create a network graph to visualize redundancies
#Convert codes into text
Code.Text.Conversion <- function(y){
y <- y %>%
map(~gsub('^FSCRSs_s1_PRE_1$','(1) In questo momento mi sento deluso da me stesso',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_2$',"(2) C'è una parte di me che mi sta criticando",.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_3$','(3) Riesco a riconoscere i miei punti di forza',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_4$','(4) Faccio fatica a controllare la rabbia e la frustrazione che sto provando nei miei confronti.',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_5$','(5) In questo momento riesco a perdonarmi',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_6$','(6) Non mi sento abbastanza bravo',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_7$',"(7) Mi sento schiacciato dall'autocritica",.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_8$','(8) Nonostante tutto mi piace essere chi sono',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_9$','(9) Mi sento così arrabbiat* con me stess* da volermi punire',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_10$','(10) Provo disgusto verso me stesso',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_11$','(11) Sento di essere amabile e degno di accettazione',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_12$','(12) Mi piaccio per come sono.',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_13$','(13) Non riesco a smettere di pensare ai miei difetti',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_14$','(14) Mi viene da insultarmi da solǝ.',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_15$','(15) Mi sento gentile verso me stesso e voglio darmi sostegno',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_16$','(16) Mi sento inadeguato',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_17$','(17) Sento di meritare le critiche che mi faccio',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_18$','(18) Ho voglia di prendermi cura di me stesso',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_19$','(19) Vorrei sbarazzarmi degli aspetti di me che non mi piacciono',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_20$','(20) Sento speranza verso il futuro',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_21$','(21) Non mi piace essere quello che sono',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_22$',"(22) C'è una parte di me che mi sta giudicando",.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_23$','(23) Sto pensando ai miei lati negativi',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_24$','(24) provo rabbia e frustrazione verso me stesso.',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_25$','(25) Mi sento in pace con me stesso',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_26$','(26) Ho fiducia in me stesso',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_27$','(27) Mi sento un fallito',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_28$','(28) Non sto facendo nulla di buono',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_29$','(29) Mi sento un peso per chi ho accanto',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_30$','(30) Mi vergogno di quello che sono',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_31$','(31) Vorrei nascondermi',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_32$','(32) Mi sto confrontando agli altri',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_33$','(33) Mi sto odiando',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_34$','(34) Mi sto dicendo che posso farcela',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_35$','(35) Sto scegliedo di vedere il buono in me',.x)) %>%
map(~gsub('^FSCRSs_s1_PRE_36$','(36) Mi rivolgo a me con gentilezza',.x))
}
textReduntant <- Code.Text.Conversion(redundant) %>%
data.frame
simpleNetwork(textReduntant[,1:2],zoom=T)
#I would consider eliminating those central items, to maximise the amount of non-redunant items
#Let's start eliminating 7, 22, 26, 15
textReduntant_2 <- textReduntant %>%
filter(!grepl("(7)|(22)|(26)|(15)",item1)) %>%
filter(!grepl("(7)|(22)|(26)|(15)",item2))
simpleNetwork(textReduntant_2[,1:2],zoom=T)
#Eiminating 34, 36, 11, 8
textReduntant_3 <- textReduntant_2 %>%
filter(!grepl("(34)|(36)|(11)|(8)",item1)) %>%
filter(!grepl("(34)|(36)|(11)|(8)",item2))
#no redundancies left
nrow(textReduntant_3)
## [1] 1
vdata <- vdata %>%
select(-matches("_7|_22|_26|_15|_34|_36|_11|_8"))
(abs(cor(vdata))<.7 & abs(cor(vdata))==1) %>% apply(1,sum) %>% sum
## [1] 0
describe(vdata)
## vars n mean sd median trimmed mad min max range skew
## FSCRSs_s1_PRE_1 1 116 0.82 0.89 1 0.70 1.48 0 4 4 1.16
## FSCRSs_s1_PRE_2 2 116 1.35 1.07 1 1.28 1.48 0 4 4 0.44
## FSCRSs_s1_PRE_3 3 116 2.53 0.93 3 2.53 1.48 1 4 3 -0.04
## FSCRSs_s1_PRE_4 4 116 0.80 0.93 1 0.67 1.48 0 4 4 1.31
## FSCRSs_s1_PRE_5 5 116 2.43 1.00 3 2.44 1.48 0 4 4 -0.20
## FSCRSs_s1_PRE_6 6 116 1.61 1.11 1 1.56 1.48 0 4 4 0.46
## FSCRSs_s1_PRE_12 7 116 2.44 0.97 2 2.45 1.48 0 4 4 -0.17
## FSCRSs_s1_PRE_13 8 116 1.11 0.98 1 1.00 1.48 0 4 4 0.70
## FSCRSs_s1_PRE_16 9 116 1.26 1.04 1 1.16 1.48 0 4 4 0.67
## FSCRSs_s1_PRE_17 10 116 1.45 0.97 1 1.43 1.48 0 4 4 0.14
## FSCRSs_s1_PRE_18 11 116 2.91 0.92 3 2.96 1.48 1 4 3 -0.27
## FSCRSs_s1_PRE_19 12 116 2.09 1.12 2 2.11 1.48 0 4 4 -0.24
## FSCRSs_s1_PRE_20 13 116 2.59 1.02 3 2.62 1.48 1 4 3 -0.16
## FSCRSs_s1_PRE_21 14 116 0.84 0.83 1 0.73 1.48 0 3 3 0.85
## FSCRSs_s1_PRE_23 15 116 1.34 1.05 1 1.24 1.48 0 4 4 0.68
## FSCRSs_s1_PRE_24 16 116 0.85 0.88 1 0.77 1.48 0 4 4 0.82
## FSCRSs_s1_PRE_25 17 116 2.03 1.05 2 2.00 1.48 0 4 4 0.11
## FSCRSs_s1_PRE_32 18 116 1.82 1.17 2 1.78 1.48 0 4 4 0.19
## FSCRSs_s1_PRE_35 19 116 2.62 0.93 3 2.66 1.48 0 4 4 -0.29
## kurtosis se
## FSCRSs_s1_PRE_1 1.47 0.08
## FSCRSs_s1_PRE_2 -0.48 0.10
## FSCRSs_s1_PRE_3 -0.88 0.09
## FSCRSs_s1_PRE_4 1.88 0.09
## FSCRSs_s1_PRE_5 -0.73 0.09
## FSCRSs_s1_PRE_6 -0.63 0.10
## FSCRSs_s1_PRE_12 -0.60 0.09
## FSCRSs_s1_PRE_13 -0.05 0.09
## FSCRSs_s1_PRE_16 -0.05 0.10
## FSCRSs_s1_PRE_17 -0.75 0.09
## FSCRSs_s1_PRE_18 -1.00 0.09
## FSCRSs_s1_PRE_19 -0.56 0.10
## FSCRSs_s1_PRE_20 -1.11 0.09
## FSCRSs_s1_PRE_21 0.20 0.08
## FSCRSs_s1_PRE_23 0.14 0.10
## FSCRSs_s1_PRE_24 0.28 0.08
## FSCRSs_s1_PRE_25 -0.62 0.10
## FSCRSs_s1_PRE_32 -0.68 0.11
## FSCRSs_s1_PRE_35 -0.51 0.09
#### FACTOR ANALYSIS NEW FSCRS ####
fa.parallel(vdata)
## Parallel analysis suggests that the number of factors = 2 and the number of components = 1
for (i in 1:2){
fa(vdata,i) %$%
loadings %T>%
print %>%
write.csv(paste0("newEFA_",i,".csv"))
}
##
## Loadings:
## MR1
## FSCRSs_s1_PRE_1 0.761
## FSCRSs_s1_PRE_2 0.749
## FSCRSs_s1_PRE_3 -0.656
## FSCRSs_s1_PRE_4 0.626
## FSCRSs_s1_PRE_5 -0.809
## FSCRSs_s1_PRE_6 0.663
## FSCRSs_s1_PRE_12 -0.746
## FSCRSs_s1_PRE_13 0.760
## FSCRSs_s1_PRE_16 0.832
## FSCRSs_s1_PRE_17 0.641
## FSCRSs_s1_PRE_18 -0.705
## FSCRSs_s1_PRE_19 0.452
## FSCRSs_s1_PRE_20 -0.696
## FSCRSs_s1_PRE_21 0.748
## FSCRSs_s1_PRE_23 0.725
## FSCRSs_s1_PRE_24 0.748
## FSCRSs_s1_PRE_25 -0.817
## FSCRSs_s1_PRE_32 0.441
## FSCRSs_s1_PRE_35 -0.728
##
## MR1
## SS loadings 9.513
## Proportion Var 0.501
##
## Loadings:
## MR1 MR2
## FSCRSs_s1_PRE_1 0.637 -0.173
## FSCRSs_s1_PRE_2 0.919 0.121
## FSCRSs_s1_PRE_3 0.786
## FSCRSs_s1_PRE_4 0.616
## FSCRSs_s1_PRE_5 -0.197 0.684
## FSCRSs_s1_PRE_6 0.526 -0.181
## FSCRSs_s1_PRE_12 0.790
## FSCRSs_s1_PRE_13 0.558 -0.253
## FSCRSs_s1_PRE_16 0.811
## FSCRSs_s1_PRE_17 0.635
## FSCRSs_s1_PRE_18 0.804
## FSCRSs_s1_PRE_19 0.443
## FSCRSs_s1_PRE_20 0.757
## FSCRSs_s1_PRE_21 0.353 -0.452
## FSCRSs_s1_PRE_23 0.786
## FSCRSs_s1_PRE_24 0.839
## FSCRSs_s1_PRE_25 -0.373 0.506
## FSCRSs_s1_PRE_32 0.464
## FSCRSs_s1_PRE_35 0.860
##
## MR1 MR2
## SS loadings 5.32 4.284
## Proportion Var 0.28 0.225
## Cumulative Var 0.28 0.505
#### SCORING NEW FSCRS ####
#reversing the ones that saturate negatively
reverse <- c(3,5,12,18,20,25,35)
#reversing those items in each of the 5 administrations
dati <- dati %>%
mutate(
across(num_range("FSCRSs_s1_PRE_",reverse),\(x)4-x),
across(num_range("FSCRSs_s1_POST_",reverse),\(x)4-x),
across(num_range("FSCRSs_s2_",reverse),\(x)4-x),
across(num_range("FSCRSs_s3_",reverse),\(x)4-x),
across(num_range("FSCRSs_s4_",reverse),\(x)4-x)
)
#sommo solo gli items in vdata
dati <- dati %>%
mutate(
FSCRSs_s1_PRE = apply(dati[,names(vdata)],1,sum),
FSCRSs_s1_POST = apply(dati[,names(vdata)%>%gsub("PRE","POST",.)],1,sum),
FSCRSs_s2 = apply(dati[,names(vdata)%>%gsub("s1_PRE","s2",.)],1,sum),
FSCRSs_s3 = apply(dati[,names(vdata)%>%gsub("s1_PRE","s3",.)],1,sum),
FSCRSs_s4 = apply(dati[,names(vdata)%>%gsub("s1_PRE","s4",.)],1,sum)
)
#### NEW SCORING THROUGH TIME ####
dati %$%
error.bars(cbind(
FSCRSt_s1_hs,
FSCRSt_s1_is,
FSCRSt_s1_rs,
S1_PRE = FSCRSs_s1_PRE,
S1_POST = FSCRSs_s1_POST,
S2 = FSCRSs_s2,
S3 = FSCRSs_s3,
S4 = FSCRSs_s4),
eyes = F)
for (i in list(1:20,21:40,41:60,61:80,81:100)){
dati[i,] %$%
slopegraph(cbind.data.frame(S1_PRE = FSCRSs_s1_PRE,
S1_POST = FSCRSs_s1_POST,
S2 = FSCRSs_s2,
S3 = FSCRSs_s3,
S4 = FSCRSs_s4),
col.lines = rainbow(length(i))
)
}
#Does any single item vary along time?
itemCodes <- 1:36 %>% str_pad(2,pad="_") %>% as.character
for (i in 1:36){
# Nome file specifico per ogni grafico
file_name <- paste0("./Grafici/item_", itemCodes[i], ".png")
# Aprire dispositivo grafico per salvataggio
png(file_name, width = 800, height = 600)
dati %>%
select(contains("FSCRSs"))%>%
select(matches(paste0(itemCodes[i],"$"))) %>%
error.bars(main=paste("item numero",i))
dev.off()
}
#salvataggio grafici
tempdir() %>%
list.files(pattern="rs-graphics", full.names = TRUE) %>%
list.files(pattern=".png", full.names = TRUE) %>%
file.copy("./Grafici", overwrite=F)
## logical(0)