Rezidential

Iasi

1 Load data

## Read
filename <- "Data_Rezidential.RDS"   

Data <- readRDS(file.path(folder, filename))  

1.1 Doar din Iasi

Data <-
  Data %>%
  filter(judet == "Iasi")

2 Demografice

## Pie chart
Data  %>%
  mutate(Gen = as.factor(as.character(gen))) %>%
  mutate(Gen = forcats::fct_recode(Gen, "femin" = "f", "masculin" = "m")) %>%
  group_by(Gen) %>%
  dplyr::summarise(counts = n()) %>%
  mutate(prop = round(counts*100/sum(counts), 1),
         lab.ypos = cumsum(prop) - .5*prop,
         Percent = paste0(prop, " %")) %>% 
  ggpubr::ggpie(x = "prop", label = "Percent",
                fill = "Gen", color = "white", 
                lab.pos = "in", lab.font = list(color = "white"),
                palette = "grey")

## Dodged Bar plot of Age and Gender
Data  %>%
  mutate(Varta_categ = cut(varsta, 
                           breaks = c(-Inf, 6, 8, 10, 12, 14, 16, Inf), 
                           labels=c("5-6", "6-8", "8-10", "10-12", "12-14", "14-16", "16-18"), 
                           right = FALSE)) %>%  
  mutate(Varta_categ = as.factor(Varta_categ),
         Gen = as.factor(as.character(gen))) %>%
  mutate(Gen = forcats::fct_recode(Gen, "femin" = "f", "masculin" = "m")) %>%
  dplyr::count(Varta_categ, Gen) %>%                    # Group by, then count number in each group
  mutate(pct = prop.table(n)) %>%                       # Calculate percent within each var
  ggplot(aes(x = Varta_categ, y = pct, fill = Gen, label = scales::percent(pct))) + 
    geom_col(position = 'dodge') + 
    geom_text(position = position_dodge(width = .9),    # move to center of bars
              vjust = -0.5,                             # nudge above top of bar
              size = 3) + 
    scale_y_continuous(labels = scales::percent) +
    ggtitle("") +
    xlab("Varsta") + ylab("Percentage %") + 
    guides(fill = guide_legend(title = "Gen", ncol = 1)) + 
    scale_fill_grey(start = 0.8, end = 0.2, na.value = "red", aesthetics = "fill") +
    theme(legend.position = "right", legend.direction = "vertical", 
          legend.justification = c(0, 1), panel.border = element_rect(fill = NA, colour = "black"))

3 GCIC

# Data[str_detect(colnames(Data), fixed("gci", ignore_case=TRUE))] # items
Data_gci <- Data[, c(sprintf("gci_%d", 1:14), "OpenC", "CloseC", "centru")]

labels_gci <- 
  c("Foarte neadevărat",
  "Neadevărat",
  "Un pic neadevărat / Un pic adevărat",
  "Adevărat",
  "Foarte adevărat")

itemtext_gci <-
  c("1. Oamenii de la centru se poartă frumos cu mine.",
  "2. Am încredere în oamenii din centru.",
  "3. Oamenii de la centru mă înţeleg.",
  "4. Atunci când mă plâng de ceva, oamenii din centru mă iau în serios.",
  "5. Oamenii de la centru sunt corecți.",
  "6. Simt că aici, la centru, lucrez la îndeplinirea scopurilor mele.",
  "7. În acest centru sunt întotdeauna destui oameni care să mă ajute.",
  "8. Oamenii din centru se țin de cuvânt.",
  "9. Pot să cer ajutor de la oamenii din centru atunci când am nevoie.",
  "10. În acest centru, copiii au încredere unii în alții.",
  "11. Aici, poți să ai încredere în toată lumea.",
  "12. Haosul și gălăgia din centru mă înnebunesc.",
  "13. Sunt prea mulți copii aici.",
  "14. Oamenii de la centru sunt adesea prea ocupați ca să mă ajute.")

Data_gci <-
  Data_gci %>%
  mutate_at(vars(sprintf("gci_%d", 1:14)), ~as.factor(as.character(.))) %>%
  rename_at(vars(sprintf("gci_%d", 1:14)), ~itemtext_gci) %>%
  rename_at(vars("OpenC", "CloseC"), ~c("Climat deschis", "Climat închis")) %>%
  dplyr::rename(Centru = centru)

# Plots  # library(likert)
Likertobj_gci <- likert::likert(Data_gci[, 1:14], nlevels = 5)   # here are percentages

plot(Likertobj_gci, type = "bar", 
     centered = TRUE, center = 3, include.center = TRUE,              # "3" is neutral
     wrap = 30, low.color = 'burlywood', high.color = 'maroon',
     group.order = names(Data_gci[, 1:14])) +
  ylab("Procent") + 
  guides(fill = guide_legend(nrow = 1, title = "Răspuns")) +
  geom_vline(xintercept = 5.51)

Data_gci %>%
  select("Climat deschis", "Climat închis") %>%
  gather() %>%
  rename_at(vars("key", "value"), ~c("Var", "Scor")) %>%
    ggpubr::ggviolin("Var", "Scor", fill = "Var",
      palette = c("#00AFBB", "#FC4E07"),
      add = "boxplot", add.params = list(fill = "white"),
      xlab = "", legend = "none") +
  stat_summary(fun.data = mean_se,  colour = "darkred")

Data_gci %>%
  select("Climat deschis", "Climat închis", "Centru") %>%
  gather(key ="Var", value = "Scor", -Centru) %>%
  mutate(Centru = as.factor(Centru)) %>%
    ggpubr::ggviolin("Var", "Scor", fill = "Var",
      palette = c("#00AFBB", "#FC4E07"),
      add = "boxplot", add.params = list(fill = "white"),
      xlab = "", legend = "none",
      facet.by = "Centru") +
  stat_summary(fun.data = mean_se,  colour = "darkred")

cat("### Climat deschis")

3.0.1 Climat deschis

Data_gci %>%
  select("Climat deschis", "Centru") %>% 
  group_by(Centru) %>%  
  dplyr::summarise(medie = mean(`Climat deschis`, na.rm = TRUE),
                   sd = sd(`Climat deschis`, na.rm = TRUE))

cat("### Climat închis")

3.0.2 Climat închis

Data_gci %>%
  select("Climat închis", "Centru") %>% 
  group_by(Centru) %>%  
  dplyr::summarise(medie = mean(`Climat închis`, na.rm = TRUE),
                   sd = sd(`Climat închis`, na.rm = TRUE))

4 ASCQ

Data_ascq <-
  Data %>%
  dplyr::select(sprintf("asc_%d", 1:15), c("ASecur", "AAnxio", "AAvoid", "ASCQ_f", "centru")) %>%
  dplyr::rename(Centru = centru) %>%
  mutate(
    ASCQ_f = forcats::fct_recode(ASCQ_f,
                                      "Sec" = "Secur",
                                      "Sec și Anx" = "Secur&Anxio",
                                      "Anx" = "Anxio",
                                      "Evit" = "Avoid",
                                      "Sec și Evit" = "Secur&Avoid",
                                      "Anx și Evit" = "Anxio&Avoid",
                                      "Sec, Anx, Evit" = "Secur&Anxio&Avoid"),
    ASCQ_f = fct_explicit_na(ASCQ_f, "lipsă"))

# Create a custom color scale for all ASCQ graphs
library(RColorBrewer)
myColors <- brewer.pal(9,"Set1")
names(myColors) <- levels(Data_ascq$ASCQ_f)
colScale <- scale_colour_manual(name = "ASCQ_f", values = myColors)

# Plot
ggplot(Data_ascq, aes(x = forcats::fct_infreq(ASCQ_f), fill = ASCQ_f)) +
  geom_bar(aes(y = (..count..)/sum(..count..))) +
  geom_text(aes(y = ((..count..)/sum(..count..)), 
                label = scales::percent((..count..)/sum(..count..))), 
            stat = "count", vjust = -0.25) +
  scale_y_continuous(labels = percent) +
  labs(title = "", y = "Procent", x = "Tip Atașament") +
  guides(fill = FALSE) + colScale       # color scale here keep consistency of color with factor level

ggplot(Data_ascq, aes(x = forcats::fct_infreq(ASCQ_f), fill = ASCQ_f)) +
  facet_wrap(~Centru, scales = "free", ncol = 2) +
  geom_bar(aes(y = (..count..)/sum(..count..))) +
  geom_text(aes(y = ((..count..)/sum(..count..)), 
                label = scales::percent((..count..)/sum(..count..))), 
            stat = "count", vjust = -0.25) +
  scale_y_continuous(labels = percent) +
  labs(title = "", y = "Procent", x = "") +
  guides(fill = FALSE) + colScale +                         # color scale here keep consistency of color with factor level
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) 

5 ACE

# Data$sec2_1    is redundant because all should be 1, even tough there are 403 NA and 872 of 1
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")

# Plot function and Data function
ace_plot <- function(df){ 
  ggplot(df, aes(x = variable, y = percent, fill = variable)) + 
     geom_bar(stat = "identity") +
     geom_text(aes(label = paste0(round(percent), "%")), vjust = -0.25) +
     guides(fill=FALSE) + 
     theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
     ylab("Percentage") +  xlab("")  
}

ace_data <- function(df, ace_levels, filter_col, filter_level){
  filter_col <- rlang::enquo(filter_col)
  df %>% 
    filter(!!filter_col %in% filter_level) %>% 
    select(Ace_col_names) %>%
    summarise_all(funs(sum(!is.na(.)) / length(.) * 100)) %>% 
    gather(variable, percent) %>%
    mutate(variable = stringr::str_replace(variable, Ace_col_names, Ace_new_names)) %>%
    arrange(desc(percent)) %>%
    mutate(variable = factor(variable, ace_levels)) 
}  
  
# ACEs data & plots
Data_ACE <- 
  Data %>%    # barplot(colSums(Data[, Ace_col_names], na.rm = TRUE))
    select(Ace_col_names) %>%
    summarise_all(funs(sum(!is.na(.)) / length(.) * 100)) %>% 
    gather(variable, percent) %>%
    mutate(variable = stringr::str_replace(variable, Ace_col_names, Ace_new_names)) %>%
    arrange(desc(percent)) %>%
    mutate(variable = factor(variable, variable))     # this makes levels order match row order!
ace_levels <- levels(Data_ACE$variable)  

ace_plot1 <- 
  Data_ACE %>%
    ace_plot() +
      ggtitle("ACE") 

ace_plot2 <-  
  ace_data(Data, ace_levels, gen, filter_level = "f") %>%
    ace_plot() +
      ggtitle("ACE - fete") 

ace_plot3 <-
  ace_data(Data, ace_levels, gen, filter_level = "m") %>%
    ace_plot() +
      ggtitle("ACE - băieți") 

ace_plot4 <-
  ace_data(Data, ace_levels, tip_chestionar, filter_level = c("5-8ani", "5-8intarziere")) %>%
    ace_plot() +
      ggtitle("ACE - 5-8 ani") 

ace_plot5 <-
  ace_data(Data, ace_levels, tip_chestionar, filter_level = "9-18ani") %>%
    ace_plot() +
      ggtitle("ACE - 9-18 ani")


ggpubr::ggarrange(ace_plot1,                                                 
          ggarrange(ace_plot2, ace_plot3, ncol = 2, labels = c("B", "C")), 
          ggarrange(ace_plot4, ace_plot5, ncol = 2, labels = c("C", "D")),
          nrow = 3, 
          labels = "A")                                        

6 Session Info

R version 3.6.1 (2019-07-05)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 8.1 x64 (build 9600)

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] RColorBrewer_1.1-2         GGally_1.4.0               Hmisc_4.1-1                Formula_1.2-3              survival_2.44-1.1         
 [6] lattice_0.20-38            rio_0.5.16                 scales_1.0.0               ggpubr_0.2                 magrittr_1.5              
[11] PerformanceAnalytics_1.5.2 xts_0.11-2                 zoo_1.8-4                  tadaatoolbox_0.16.1        summarytools_0.8.8        
[16] broom_0.5.2                psych_1.8.12               forcats_0.4.0              stringr_1.4.0              dplyr_0.8.3               
[21] purrr_0.3.2                readr_1.3.1                tidyr_1.0.0                tibble_2.1.3               ggplot2_3.2.1             
[26] tidyverse_1.2.1            papaja_0.1.0.9842          kableExtra_0.9.0           knitr_1.25                 pacman_0.5.1              

loaded via a namespace (and not attached):
 [1] colorspace_1.4-1    pryr_0.1.4          ellipsis_0.3.0      htmlTable_1.12      base64enc_0.1-3     rstudioapi_0.8      mvtnorm_1.0-11     
 [8] lubridate_1.7.4     xml2_1.2.0          codetools_0.2-16    splines_3.6.1       mnormt_1.5-5        zeallot_0.1.0       pixiedust_0.8.6    
[15] jsonlite_1.6        cluster_2.1.0       compiler_3.6.1      httr_1.4.0          backports_1.1.4     assertthat_0.2.1    Matrix_1.2-17      
[22] lazyeval_0.2.2      cli_1.1.0           acepack_1.4.1       htmltools_0.3.6     tools_3.6.1         gtable_0.3.0        glue_1.3.1         
[29] reshape2_1.4.3      Rcpp_1.0.2          carData_3.0-2       cellranger_1.1.0    vctrs_0.2.0         nlme_3.1-140        xfun_0.9           
[36] openxlsx_4.1.0      rvest_0.3.2         lifecycle_0.1.0     MASS_7.3-51.4       hms_0.5.1           parallel_3.6.1      expm_0.999-3       
[43] pwr_1.2-2           curl_3.2            gridExtra_2.3       pander_0.6.3        likert_1.3.5        rpart_4.1-15        reshape_0.8.8      
[50] latticeExtra_0.6-28 stringi_1.4.3       nortest_1.0-4       checkmate_1.8.5     boot_1.3-22         zip_1.0.0           rlang_0.4.0        
[57] pkgconfig_2.0.3     matrixStats_0.54.0  bitops_1.0-6        evaluate_0.14       labeling_0.3        rapportools_1.0     htmlwidgets_1.3    
[64] cowplot_0.9.3       tidyselect_0.2.5    plyr_1.8.4          R6_2.4.0            DescTools_0.99.29   generics_0.0.2      pillar_1.4.2       
[71] haven_2.1.1         foreign_0.8-71      withr_2.1.2         abind_1.4-5         RCurl_1.95-4.11     nnet_7.3-12         modelr_0.1.5       
[78] crayon_1.3.4        car_3.0-2           rmarkdown_1.15      viridis_0.5.1       grid_3.6.1          readxl_1.1.0        data.table_1.11.8  
[85] digest_0.6.21       xtable_1.8-4        munsell_0.5.0       viridisLite_0.3.0   quadprog_1.5-5     

 

---

A work by Claudiu Papasteri

claudiu.papasteri@gmail.com