Rezidential

Network Analysis

1 Load data

## Read
filename <- "Data_Rezidential.RDS"   
Data <- readRDS(filename)  

1.1 Modify ACE Score to take into account that all are institutionalized

Data$CYW <- ifelse(Data$CYW == 0, 0, Data$CYW - 1) 

1.2 Percentage of individually reported ACEs out of ACE Score

indiv_ACE_sum <- rowSums(Data[, c(sprintf("sec1_%d", 1:10), sprintf("sec2_%d", 2:9))], na.rm = TRUE)
# sum(Data$CYW - indiv_ACE_sum < 0)    # 7 cases where indiv_ACE_sum > Data$CYW
## Summaries
cat("### summary individually reported")

### summary individually reported

summary(indiv_ACE_sum, na.rm = TRUE)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  0.000   0.000   2.000   3.209   6.000  18.000 

cat("### summary overall reported")

### summary overall reported

summary(Data$CYW, na.rm = TRUE)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  0.000   2.000   4.000   4.595   7.000  18.000 

# Plots
acescore_df <- data.frame(ID = Data$ID, Individual = indiv_ACE_sum, Overall = Data$CYW)
acescore_df %>%
  gather(Var, Val, -ID) %>%
    # ggviolin(., x = "Var", y = "Val", 
    #             add = c("boxplot", "mean_sd")) +
    ggerrorplot(., x = "Var", y = "Val",
            desc_stat = "mean_sd", color = "black",
            add = "violin", add.params = list(color = "darkgrey"),
            xlab = NULL, ylab = "Reported score") +
    stat_compare_means(comparisons = list( c("Individual", "Overall")), label = "p.signif")+ # Add significance levels
    stat_compare_means(label.y = 20, label.x = 0.55)

cat("### simple percent of sums of events")

### simple percent of sums of events

sum(acescore_df$Individual) / sum(acescore_df$Overall) * 100     # so they report only 70% of ACEs individually

[1] 69.85319

2 Network

## Dataframe
Ace_col_names <- c(sprintf("sec1_%d", 1:10), sprintf("sec2_%d", 2:9))
Ace_new_names <- c("divort", "incarcerare", "boala mintala", "amenintare", "umilire", 
                   "abuz sexual", "lipsuri", "abuz fizic", "adictie", "nesiguranta", 
                   "bullying", "deces", "emigrare", "boala", "violenta", 
                   "rautate", "politie", "abuz partener") 
netword_df <- Data[, c("ID", sprintf("sec1_%d", 1:10), sprintf("sec2_%d", 2:9))]
netword_df <- 
  netword_df %>%
  replace(is.na(.), 0) %>%
  rename_at(vars(Ace_col_names), ~ Ace_new_names)
## Fit eLasso net  
eLasso_net <- IsingFit::IsingFit(netword_df[, names(netword_df) != "ID"], 
                                family = "binomial",
                                AND = TRUE, gamma = 0.25, 
                                plot = TRUE, progressbar = FALSE,
                                title = "eLasso")

## Reproduce graph for community analysis (Walktrap clustering)
net_plot <- qgraph::qgraph(eLasso_net$weiadj, 
                           layout = "spring", weighted = TRUE, 
                           labels = rownames(eLasso_net$weiadj),
                           title = "eLasso - reproduced qgraph")  # put labels to avoid abbrev

# plot(net_plot)
centr_net_plot <- centralityPlot(eLasso_net$weiadj) # centrality_auto(eLasso_net$weiadj) to get matrix

## Community analysis (Walktrap clustering)
# ig_eLasso <- igraph::graph_from_adjacency_matrix(eLasso_net$weiadj, mode = "undirected" ,weighted = TRUE)
ig_eLasso <- igraph::as.igraph(net_plot)
plot(ig_eLasso, main = "eLasso - reproduced igraph")  # just check

ig_eLasso_communities <- igraph::cluster_walktrap(ig_eLasso)
ig_eLasso_commun_mem <- as.factor(ig_eLasso_communities$membership)
## Plot qgraph with community results
# Coloured
qgraph::qgraph(net_plot, 
               groups = ig_eLasso_commun_mem,
               legend.cex = 0.7,                          # borders = FALSE, pastel = TRUE,
               color = c("lightblue", "lightsalmon", "lightgreen", "lightgrey"),
               title = NULL)

# Greyscale
qgraph::qgraph(net_plot, 
               groups = ig_eLasso_commun_mem,
               edge.color = "black", fade = TRUE,
               legend.cex = 0.7,                          
               color = c("grey90", "grey59", "grey35", "white"),
               title = NULL)

NA
NA

3 Session Info

R version 3.5.2 (2018-12-20)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows >= 8 x64 (build 9200)

Matrix products: default

locale:
[1] LC_COLLATE=Romanian_Romania.1250  LC_CTYPE=Romanian_Romania.1250    LC_MONETARY=Romanian_Romania.1250 LC_NUMERIC=C                     
[5] LC_TIME=Romanian_Romania.1250    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] bindrcpp_0.2.2             igraph_1.2.4.1             qgraph_1.5                 IsingFit_0.3.1             car_3.0-2                 
 [6] carData_3.0-2              RColorBrewer_1.1-2         corrplot_0.84              GGally_1.4.0               Hmisc_4.1-1               
[11] Formula_1.2-3              survival_2.43-3            lattice_0.20-38            rio_0.5.16                 scales_1.0.0              
[16] ggpubr_0.2                 magrittr_1.5               PerformanceAnalytics_1.5.2 xts_0.11-2                 zoo_1.8-4                 
[21] tadaatoolbox_0.16.1        summarytools_0.9.3         broom_0.5.1                psycho_0.4.91              psych_1.8.10              
[26] plyr_1.8.4                 forcats_0.3.0              stringr_1.3.1              dplyr_0.7.8                purrr_0.2.5               
[31] readr_1.3.0                tidyr_0.8.2                tibble_1.4.2               ggplot2_3.2.0              tidyverse_1.2.1           
[36] papaja_0.1.0.9842          kableExtra_1.1.0           knitr_1.24                 pacman_0.5.1              

loaded via a namespace (and not attached):
  [1] estimability_1.3       SparseM_1.77           lavaan_0.6-4           coda_0.19-2            nonnest2_0.5-2         acepack_1.4.1         
  [7] dygraphs_1.1.1.6       multcomp_1.4-10        data.table_1.12.2      rpart_4.1-13           inline_0.3.15          RCurl_1.95-4.11       
 [13] generics_0.0.2         callr_3.1.1            TH.data_1.0-9          webshot_0.5.1          xml2_1.2.0             lubridate_1.7.4       
 [19] httpuv_1.4.5           StanHeaders_2.18.1-10  assertthat_0.2.1       d3Network_0.5.2.1      viridis_0.5.1          xfun_0.8              
 [25] hms_0.4.2              bayesplot_1.6.0        evaluate_0.14          promises_1.0.1         readxl_1.1.0           htmlwidgets_1.3       
 [31] mcmc_0.9-5             reshape_0.8.8          stats4_3.5.2           crosstalk_1.0.0        backports_1.1.3        pbivnorm_0.6.0        
 [37] markdown_0.9           ggcorrplot_0.1.3       MCMCpack_1.4-4         rapportools_1.0        pwr_1.2-2              quantreg_5.38         
 [43] abind_1.4-5            withr_2.1.2            pryr_0.1.4             checkmate_1.8.5        emmeans_1.3.1          sna_2.4               
 [49] fdrtool_1.2.15         prettyunits_1.0.2      mnormt_1.5-5           cluster_2.0.7-1        mi_1.0                 lazyeval_0.2.1        
 [55] crayon_1.3.4           ellipse_0.4.1          labeling_0.3           glmnet_2.0-18          pkgconfig_2.0.2        nlme_3.1-137          
 [61] ggm_2.3                nnet_7.3-12            bindr_0.1.1            rlang_0.3.0.1          miniUI_0.1.1.1         colourpicker_1.0      
 [67] MatrixModels_0.4-1     sandwich_2.5-1         modelr_0.1.2           cellranger_1.1.0       tcltk_3.5.2            matrixStats_0.54.0    
 [73] Matrix_1.2-15          loo_2.1.0              boot_1.3-20            base64enc_0.1-3        whisker_0.3-2          ggridges_0.5.1        
 [79] processx_3.2.1         png_0.1-7              viridisLite_0.3.0      rjson_0.2.20           bitops_1.0-6           pander_0.6.3          
 [85] arm_1.10-1             jpeg_0.1-8             shinystan_2.5.0        ggsignif_0.4.0         threejs_0.3.1          compiler_3.5.2        
 [91] rstantools_1.5.1       lme4_1.1-19            cli_1.0.1              lmerTest_3.0-1         pbapply_1.3-4          ps_1.2.1              
 [97] htmlTable_1.12         MASS_7.3-51.1          tidyselect_0.2.5       stringi_1.2.4          sem_3.1-9              pixiedust_0.8.6       
[103] yaml_2.2.0             latticeExtra_0.6-28    grid_3.5.2             manipulate_1.0.1       tools_3.5.2            parallel_3.5.2        
[109] matrixcalc_1.0-3       rstudioapi_0.8         foreach_1.4.4          foreign_0.8-71         gridExtra_2.3          BDgraph_2.53          
[115] digest_0.6.18          shiny_1.2.0            nortest_1.0-4          quadprog_1.5-5         ppcor_1.1              Rcpp_1.0.2            
[121] BayesFactor_0.9.12-4.2 later_0.7.5            httr_1.4.0             rsconnect_0.8.15       colorspace_1.3-2       blavaan_0.3-5         
[127] rvest_0.3.2            splines_3.5.2          expm_0.999-3           shinythemes_1.1.2      MuMIn_1.42.1           xtable_1.8-3          
[133] rstanarm_2.18.2        jsonlite_1.6           nloptr_1.2.1           corpcor_1.6.9          rstan_2.19.2           glasso_1.10           
[139] nFactors_2.3.3         R6_2.4.0               pillar_1.3.1           htmltools_0.3.6        mime_0.6               glue_1.3.1            
[145] minqa_1.2.4            DT_0.5                 codetools_0.2-15       pkgbuild_1.0.2         mvtnorm_1.0-11         network_1.13.0.1      
[151] numDeriv_2016.8-1      huge_1.2.7             curl_4.0               DescTools_0.99.28      gtools_3.8.1           magick_2.0            
[157] zip_1.0.0              shinyjs_1.0            openxlsx_4.1.0         CompQuadForm_1.4.3     rmarkdown_1.14         statnet.common_4.1.4  
[163] munsell_0.5.0          iterators_1.0.10       haven_2.1.1            reshape2_1.4.3         gtable_0.2.0          

 

---

A work by Claudiu Papasteri

claudiu.papasteri@gmail.com