Analisi dei dati - Biblioteca FBK

Statistiche riassuntive: variabili demografiche

Distribuzione per caratteristiche demografiche

# Import data
df <-  read_excel("G:/My Drive/IRVAPP/Biblioteca/quest.xlsx", skip = 1)

# Prepare data for demographics table 
demo <- df %>% mutate(
  sesso = factor(Q12, c(1, 2), c("Femina", "Maschio")),
  eta = factor(Q13, 1:4, c("18-25", "26-35", "36-55", "56 oltre")),
  occup = factor(
    Q14, 1:5, 
    c("Studente/essa", "Occupato/a", "Disoccupato/a", "Pensionato/a", "Ritirato/a")),
  istruz = factor(
    Q15, c(1, 3, 4), 
    c("Secondaria I grado", "Secondaria II grado", "Laurea o più"))
)

# Table 1 - count observation by demographic variable
demo %>% select(sesso:istruz) %>%
  # Pivot to longer and compute the count
  pivot_longer(everything(),
               names_to = "var", values_to = "label"
               ) %>%
  group_by(var, label) %>%
  summarise(Totale = n()) %>%
  filter(!is.na(label)) %>%
  # Arrange by Total (desc)
  arrange(match(var, c("sesso", "eta", "occup", "istruz")),
          desc(Totale)) %>%
  ungroup() %>%
  # Format Totale to have a ligthgreen bar depending on its value
  mutate(Totale = color_bar("lightblue")(Totale)) %>%
  select(label, Totale) %>% 
  rename(Variabile = label) %>%
  # Format the final table
  kable(escape = F) %>% 
  kable_styling("hover", full_width = T) %>% 
  pack_rows("Sesso", 1, 2) %>%
  pack_rows("Età", 3, 6) %>%
  pack_rows("Condizione occupazionale
", 7, 10) %>%
  pack_rows("Livello di istruzione
", 11, 13)

Variabile	Totale
Sesso
Maschio	47
Femina	44
Età
18-25	37
26-35	25
36-55	17
56 oltre	11
Condizione occupazionale
Studente/essa	58
Occupato/a	29
Pensionato/a	3
Disoccupato/a	1
Livello di istruzione
Laurea o più	59
Secondaria II grado	30
Secondaria I grado	3

Ricodifica delle variabili demografiche

Livello di istruzione
- 1: Laurea o più
- 0: Secondaria (grado I o II)
Condizione occupazionale
- 1: Studente/essa
- 0: Occupato/a, Pensionato/a o Disoccupato/a
Età
- 1: 18-25
- 2: 26-35
- 3: 36 oltre

df_a <- df %>% 
  select(ID:Q1_2, Q2:Q5, Q6:Q15) %>%
  mutate_at(vars(Q1_1:Q11), ~ifelse(. > 10, NA_real_, .)) %>%
  mutate_at(vars(Q4_3, Q7), ~ifelse(. > 3, NA_real_, .)) %>%
  mutate(
    q2_piu_1_mese = ifelse(Q2 < 3, 1, 0), 
    q5_no_cambio = ifelse(Q5 == 1, 1, 0),
    q6_ottimo = ifelse(Q6 == 1, 1, 0),
    q8_abast = ifelse(Q8 %in% c(1, 2), 1, 0),
    q9_si = ifelse(Q9 %in% c(1, 2, 3), 1, 0),
    q10_abast = ifelse(Q10 %in% c(1, 2), 1, 0),
    q11_piu_1_mese = ifelse(Q11 < 3, 1, 0)
  ) %>%
  mutate(
    fem = ifelse(Q11 == 1, 1, 0),
    laur_o_piu = ifelse(Q15 == 4, 1, 0),
    stud = ifelse(Q14 == 1, 1, 0),
    age = case_when(
      Q13 == 1 ~ 1,
      Q13 == 2 ~ 2,
      Q13 > 2  ~ 3,
      TRUE ~ NA_real_
    )) %>%
  select(Q1_1:Q1_2, q2_piu_1_mese, Q3_1:Q3_2, Q4_1:Q4_3, q5_no_cambio, q6_ottimo, 
         Q7, q8_abast:age)

Cross tabulation: occupazione, genere, età

df_a %>%
  group_by(fem, stud, age) %>%
  summarise(count = n()) %>%
  na.omit() %>%
  ggplot(
    aes(x = factor(age, labels = c("18-25", "26-35", "36 oltre")), y = count, 
        fill = factor(stud,labels = c(
                             "Occupato/a, Pensionato/a o Disoccupato/a", "Studente/essa"))
        )
    ) +
  geom_bar(stat = "identity", alpha = 0.7) +
  scale_fill_viridis(NULL, discrete = TRUE, option = "D") +
  facet_wrap(~ factor(fem, labels = c("Maschio", "Femina"))) +
  xlab("") + 
  scale_y_continuous("Numero", breaks = seq(0, 30, 5)) +
  theme(legend.position = "bottom")

Variabili dipendenti per caratteristiche demografiche

order_vars <- df_a %>% select(Q1_1:q11_piu_1_mese) %>% colnames() %>% rev()

label_y <- c(
  "Ambiente ideale per lo studio",
  "Materiale utile per la ricerca",
  "Accede più di 1 volta al mese",
  "Prevalentemente risorse cartacee",
  "Prevalentemente risorse digitali",
  "Prevalentemente sezione storia",
  "Prevalentemente sezione scienze religiose",
  "Prevalentemente sezione scientifica",
  "L'orario modificato nessun impatto",
  "Ottimo servizio di distribuzione e di reference",
  "Interessata/o prestito a domicilio",
  "Molto o abasstanza importante garantare la constanta disponibilita",
  "Usufrito del servizio di prestito interbibliotecario",
  "Molto o abasstanza soddisfatta/o servizio Internet",
  "Accede altre Biblioteche più di 1 volta al mese"
) %>% rev()

summarise_for_plot <- function(data) {
  # plot
  data %>% 
    pivot_longer(Q1_1:q11_piu_1_mese, names_to = "var_y", values_to = "val_y") %>%
    group_by(var_y) %>%
    summarise(
      mean = sum(val_y == 1, na.rm = T)/n())

}


summaries <- df_a %>%
  pivot_longer(fem:age, names_to = "var", values_to = "val") %>%
  group_by(var, val) %>%
  nest %>% 
  mutate(df_sum = map(data, summarise_for_plot)) %>%
  select(-data) %>%
  unnest(df_sum) %>%
  filter(!is.na(val))
  
  # summaries %>%
  # ggplot() +
  # geom_point(size = 5, alpha = 0.7, aes(x = var_y, y = mean, color = factor(val), group = factor(val))) +
  # scale_color_viridis(discrete = TRUE, option = "D") +
  # geom_segment(aes(x = var_y,
  #                  xend = var_y,
  #                  y = 0,
  #                  yend = 1),
  #              linetype="dashed",
  #              size = 0.1) +
  # coord_flip() +
  # facet_wrap(~ var)





plot_y_by_demo <- function(x, labels) {
  demo <- enquo(x)
  
  df_a %>% 
    # Tidy data
    pivot_longer(Q1_1:q11_piu_1_mese, names_to = "var", values_to = "val") %>%
    # Compute share by each value of demographic variable
    group_by(var, !! demo) %>%
    summarise(
      mean = sum(val == 1, na.rm = T)/n()
      ) %>% 
    filter(!is.na(!! demo)) %>% ungroup() %>%
    # Arrange to have first variable on top in the figure
    arrange(match(var, order_vars)) %>%
    # Add proper lables to variables
    mutate(
      var = factor(var, levels = order_vars, labels = label_y),
      !! demo := factor(!! demo, labels = labels)
      ) %>%
    # Plot
    ggplot() +
    # Add geom points
    geom_point(size = 3, alpha = 0.5, 
               aes(x = var, y = mean, color = !! demo, group = !! demo)
               ) +
    # Add intrerupted line from 0% to 100$
    geom_segment(
      aes(x = var, xend = var, y = 0, yend = 1),
      linetype="dashed", size = 0.1
      ) +
    # Format as percentage
    scale_y_continuous(NULL, labels = scales::percent) +
    scale_x_discrete(NULL) +
    # Color scale for categories
    scale_color_viridis(NULL, discrete = TRUE, option = "D") +
    theme(legend.position = "bottom") +
    # Remove axis
    theme(
      #axis.text.y = element_blank(),
      axis.ticks.y = element_blank(),
      axis.line.x = element_blank(),
      axis.line.y = element_blank()
        ) +
    # Flip figure horizontally
    coord_flip() 
}

Variabili dipendenti per genere

plot_y_by_demo(fem, c("Maschio", "Femina"))

Variabili dipendenti per età

plot_y_by_demo(age, c("18-25", "26-35", "36 oltre"))

Variabili dipendenti per condizione occupazionale

plot_y_by_demo(stud, c("Occupato/a, Pensionato/a o Disoccupato/a", "Studente/essa"))

Variabili dipendenti per livello di istruzione

plot_y_by_demo(laur_o_piu, c("Secondary degree", "Tertiary degree"))

 # p1 <- plot_y_by_demo(fem, c("Maschio", "Femina"))
 # p2 <- plot_y_by_demo(age, c("18-25", "26-35", "36 oltre")) +
 #   theme(axis.text.y = element_blank(),
 #         axis.ticks.y = element_blank(),
 #         axis.line.y = element_blank(),
 #         axis.title.y = element_blank())
 # p3 <- plot_y_by_demo(stud, c("Non-student", "Student"))
 # p4 <- plot_y_by_demo(laur_o_piu, c("Secondary degree", "Tertiary degree")) +
 #     theme(axis.text.y = element_blank(),
 #         axis.ticks.y = element_blank(),
 #         axis.line.y = element_blank(),
 #         axis.title.y = element_blank())
 # grid.arrange(p1,p2, p3, p4,  ncol = 2,
 #              widths = c(2.9, 2.2))

Tabella di regressione

Nota esplicativa:

I numeri nelle celle indicano differenze di punti percentuali
Se la cella è in grassetto e colorata, la differenza è statisticamente diversa da zero. Altrimenti, la differenza non è statisticamente diversa da zero.

mod_out <- df_a %>% 
  pivot_longer(Q1_1:q11_piu_1_mese, names_to = "dv", values_to = "val") %>%
  group_by(dv) %>%
  do(tidy(lm(val ~ fem + factor(age) + stud + laur_o_piu, data = .))) %>%
  ungroup() %>%
  mutate(p.value = round(p.value, 3),
         estimate = round(100* estimate, 2)
         ) %>%
  mutate(
    estimate = case_when(
      p.value < 0.1 & estimate > 0 ~ cell_spec(estimate, "html", color = "green", bold = T),
      p.value < 0.1 & estimate < 0 ~ cell_spec(estimate, "html", color = "red", bold = T),
      TRUE ~ cell_spec(estimate, "html",  bold = F)
      )
    ) %>%
  filter(term != "(Intercept)") %>%
  select(dv, term, estimate) %>%
  pivot_wider(names_from = term, values_from = estimate) %>%
  arrange(match(dv, rev(order_vars))) %>%
  mutate(dv = rev(label_y)) %>%
  rename_all(~c("Variabile dipendente", "Femina/Maschio", "26-35/18-25", "36 oltre/18-25", "Studente/Occupato, Pensionato o Disoccupato", "Laureato o più/Non laureato"))
    
mod_out %>% kable(escape = F, align = c("l", rep("c", ncol(.) - 1))) %>% kable_styling() %>%
  add_header_above(c(" " = 1, "Variabili indipendente" = 5))

	Variabili indipendente
Variabile dipendente	Femina/Maschio	26-35/18-25	36 oltre/18-25	Studente/Occupato, Pensionato o Disoccupato	Laureato o più/Non laureato
Ambiente ideale per lo studio	-12.58	-9.05	-39.82	15.61	2.6
Materiale utile per la ricerca	18.5	14.77	37.01	-5.04	17.98
Accede più di 1 volta al mese	-0.24	5.9	-17.13	5.19	9.48
Prevalentemente risorse cartacee	9.9	-1.05	1.45	-16.46	-27.31
Prevalentemente risorse digitali	-6.55	-5.57	-6.16	20.58	34.29
Prevalentemente sezione storia	1.52	1.02	-21.07	-9.96	-2.93
Prevalentemente sezione scienze religiose	-4.94	-12.99	19.49	3.88	10.44
Prevalentemente sezione scientifica	2.49	14.88	11.51	11.52	-3.61
L’orario modificato nessun impatto	-0.91	10.49	-1.7	8.66	5.98
Ottimo servizio di distribuzione e di reference	-9.47	8.98	12.35	-2.5	18.07
Interessata/o prestito a domicilio	-0.16	6.87	-2.13	24.65	-33.79
Molto o abasstanza importante garantare la constanta disponibilita	-38.11	1.83	-10.97	-6.45	5.55
Usufrito del servizio di prestito interbibliotecario	5.58	11.69	5.03	-12.11	1.82
Molto o abasstanza soddisfatta/o servizio Internet	5.19	11.49	-1.47	6.36	6.03
Accede altre Biblioteche più di 1 volta al mese	34.38	-24.46	-18.86	1.98	15.21

# mod_out %>% mutate(
#   arrow = ifelse(
#     estimate < 0,
#      paste0("<a href=\"", "www.google.com", "\">", as.character(fa("angle-double-down")), "</a>"),
#     paste0("<a href=\"", "www.google.com", "\">", as.character(fa("angle-double-up")), "</a>")
#   )
# ) %>% select(arrow) %>% kable(escape = F) %>% kable_styling()

Analisi dei dati - Biblioteca FBK

Sergiu Burlacu

12/27/2019

Statistiche riassuntive: variabili demografiche

Distribuzione per caratteristiche demografiche

Ricodifica delle variabili demografiche

Cross tabulation: occupazione, genere, età

Variabili dipendenti per caratteristiche demografiche

Variabili dipendenti per genere

Variabili dipendenti per età

Variabili dipendenti per condizione occupazionale

Variabili dipendenti per livello di istruzione

Tabella di regressione