In Projecte-Orbita/sociogrames: Paquet que crea els sociogrames del Test Àtom, creats per Projecte Òrbita SCCL

knitr::opts_chunk$set(echo = F)
Sys.setlocale("LC_ALL","Catalan") 
require(ggplot2)
require(reshape2)
require(igraph)
require(visNetwork)
require(kableExtra)
require(dplyr)
source("sociograma_helpers.R")
set.seed(1111)

Introducció

El sociograma és una tècnica d'anàlisi de dades que permet visualitzar de forma gràfica diferents variables implicades en les relacions entre subjectes. A nivell educatiu, suposa una eina per comprendre el sistema d'interaccions socials d'un grup-classe, aportant informació sobre la intensitat i la qualitat de les relacions entre els alumnes. Conèixer la posició sociomètrica de cada estudiant, així com comprendre els subgrups dins l'aula ens permet elaborar estratègies per facilitar la convivència escolar i influir en el benestar dels alumnes atenent les seves necessitats.

Aquesta és una versió beta de l'informe resultat del Sociograma Àtom als cicles mitjà is superior, tant a nivell estètic com de continguts. Aquest informe està realitzat sobre dades simulades, i per tant els perfils sociomètrics dels nens i nenes poden no tenir sentit. Trobareu el document complet de preguntes en un fitxer que acompanya aquest informe. En totes les preguntes els nens i nenes han de triar els tres companys que s'adeqüin millor al que es demana.

Si trobeu errors o conceptes o gràfics que no s'entenen si us plau feu-nos-ho saber a info\@projecteorbita.cat.

######## Manipulacions inicials ###########

# importem
soc = read.csv('dades/Preguntes sociograma - Sociograma_CMS.csv', fileEncoding = "UTF-8")
colnames(soc)[1:2] = c("noms", "num")


## En cas que sigui necessari, si hi ha missingns en els números i noms de nens (de cada tres només n'han posat un)
# soc$número =ffill(soc$número, NA)
# soc$nom = ffill(soc$nom, "")

# Calculem el recompte de quantes vegades cada nen ha estat anomenat en cada categoria:
num_anomenats = 3 # quants nens es poden anomenar en totes les categories - la majoria de funcions depenen explícitament d'aquest número, però potser no totes; precaució en canviar-lo

# matriu que calcula el número de vegades que s'ha estat anomenat en cada categoria
mat = matrix(data = 0, 
             nrow = nrow(soc)/num_anomenats, 
             ncol = ncol(soc)-2)

for (j in 1:ncol(mat)){
  for (i in 1:nrow(mat)){
    mat[i,j] = sum(soc[,j+2]==i)
  }
}
colnames(mat) = colnames(soc[,3:ncol(soc)])

noms = as.character(soc$nom[seq(1, nrow(soc), num_anomenats)]) # faig un vector amb els noms, que necessitaré més endavant

# Estandaritzem tots els resultats:
mat_est = scale(mat)


###### Aquí s'acaben les manipulacions inicials #######

# Calculem l'impacte total i la preferència total i les seves estandaritzacions
# 
# ### Ara mateix no s'està utilitzant. S'ha de pensar on i com posar-ho.

impacte = as.data.frame(cbind(mat[,1], mat[,2], mat[,3], mat[,4]))
impacte_est = scale(impacte)

imp = mat[,1] + mat[,2] + mat[,3] + mat[,4]
pref_feina = mat[,1] - mat[,2]
pref_jugar = mat[,3] - mat[,4]
pref = pref_feina + pref_jugar

imp_pref = cbind(imp, pref, pref_feina, pref_jugar)
imp_pref_est = scale(imp_pref)

Presentem cada una de les àrees estudiades per separat, presentant primer un gràfic global i després un desglossament de cada puntuació i en forma de taula.

Disrupció:

Els resultats d'aquesta àrea s'obtenen a partir de les respostes dels alumnes a les següents preguntes:

Qui molesta als altres?

Qui insulta als altres?

Qui pega als altres?

Qui diu coses dolentes dels altres?

Qui no deixa participar?

Per tant aquí estem mesurant el grau de disrupció que observem que cada alumne causa a l'aula, principalment causat per l'agressivitat, tant física com relacional.

# Disrupció (antiga agressivitat)

dis_directe = cbind( mat[,10], mat[,12], mat[,14], mat[,16])
dis_relacional = cbind( mat[,22], mat[,24], mat[,25], mat[,26])

dis_total = rowSums(dis_relacional) + rowSums(dis_directe)

disrupcio = cbind(dis_relacional, dis_directe, dis_total)
disrupcio_est = scale(disrupcio)

Disrupcio = cbind.data.frame(dis_total, dis_directe[,4], rowSums(dis_directe[,1:3]), rowSums(dis_relacional))
rownames(Disrupcio) = noms
colnames(Disrupcio) = c("Disrupció total", 
                           "Disrupció física",
                           "Disrupció verbal",
                           "Disrupció relacional")
Disrupcio$noms = as.factor(rownames(Disrupcio))

# Ara en fem un posant 1 en els que són significativament liantes
Disrupcio_sino = as.data.frame(ifelse(scale(Disrupcio[,-ncol(Disrupcio)])>1, 1, 0))

rownames(Disrupcio_sino) = noms
Disrupcio_sino$noms = rownames(Disrupcio_sino)
Disrupcio = Disrupcio[,c(5,2:4,1)]
names(Disrupcio)[1] = "Noms"
#taula_classe(Disrupcio, Disrupcio_sino[,1])
negretes = Disrupcio_sino[,1]
bones=NULL
dades = Disrupcio


   cols = seq(2,ncol(dades))

  dolentes = cols[!cols %in% (bones+1)]

## Outputs: gràfic i taula

grafic_barres_classe(Disrupcio[,2:5],Disrupcio_sino[,1], noms, "Disrupció")

I a continuació presentem una taula amb els mateixos resultats:

  con <- file("taules/proves.tex", open = "wt", encoding = "UTF-8")
  sink(con, type='output', split = F)
  titol="proves"
  dades %>% 
    mutate(Noms = cell_spec(Noms, bold = ifelse(negretes==0,FALSE,TRUE), format = "latex")) %>%
    mutate_at((.vars = vars(dolentes)), 
              funs(cell_spec(., "latex", 
                             color = ifelse(. > mean(.) + sd(.), "red", "blue")) )) %>%
    mutate_at(.vars = vars(bones+1), 
              funs(cell_spec(., "latex", 
                             color = ifelse(. > mean(.) + sd(.), "green", "blue")) )) %>%
    kable(format = "latex", escape = F, row.names = F, align = "c") %>%
    kable_styling(bootstrap_options = c( "striped"),
                  latex_options="scale_down",
                  protect_latex = T,
                  full_width =F, position = "center")
    #save_kable(paste0("taules/", titol, ".pdf"), keep_tex = T, expand = 100)
sink()

dades %>% 
  mutate(Noms = cell_spec(Noms, bold = ifelse(negretes==0,FALSE,TRUE), format = "latex")) %>%
  kable(format = "latex", escape = F, row.names = F, align = "c")

kableExtra::kable(Disrupcio, format = "latex")

Prosocialitat/coopearció:

Els resultats d'aquesta àrea s'obtenen a partir de les respostes dels alumnes a les següents preguntes:

Qui ajuda als altres?

Qui defensa als altres

Qui diu coses bones dels altres?

En aquest apartat mesurem el que anomenem la prosocialitat, que seria el contrari a la disrupció. És a dir, mesurem en quin gran un alumne ajuda als seus companys i crea un bon clima social i escolar.

# Prosocialitat/cooperació:
prosocialitat = cbind(mat[,7], mat[,8], mat[,9], mat[,18])
prosocialitat_est = scale(prosocialitat)
prosocialitat_total = rowSums(prosocialitat)
prosocialitat_total_est = scale(rowSums(prosocialitat))

Prosocialitat = prosocialitat_total
Pro_sino = prosocialitat_total_est < -1
Pro_sino = ifelse(Pro_sino, 1, 0)
Prosocialitat = as.data.frame(Prosocialitat)
Pro_sino = as.data.frame(Pro_sino)
rownames(Prosocialitat) = noms
rownames(Pro_sino) = noms
colnames(Prosocialitat) = c("Prosocialitat")

Prosocialitat$noms = factor(rownames(Prosocialitat), 
                            levels = unique(as.character(rownames(Prosocialitat))))
Prosocialitat$lletra = ifelse(prosocialitat_total_est< -1,"bold", "plain")
ggplot(Prosocialitat, aes(x = as.factor(noms), y = Prosocialitat)) +
  geom_bar(stat='identity', fill = "blue") + 
  theme_bw() + 
  theme(axis.text.x = element_text(angle = 45, hjust = 1,
                              face = Prosocialitat$lletra)) +
  labs(title = "Prosocialitat/Cooperació") + 
  ylab("") + 
  xlab("Alumnes")

names(Prosocialitat)[2] = "Noms"
Prosocialitat = Prosocialitat[, c(2,1)]

#knitr::kable(Prosocialitat, booktabs = TRUE, align = "c")
taula_classe_negativa(Prosocialitat, Pro_sino[,1])

Víctimes:

Els resultats d'aquesta àrea s'obtenen a partir de les respostes dels alumnes a les següents preguntes:

A qui molesten?

A qui insulten?

A qui peguen?

De qui diuen coses dolentes?

A qui no deixen participar?

# Victimisme
victima_directe = cbind(mat[,11], mat[,13], mat[,15], mat[,17], mat[,19])
victima_directe_total = rowSums(victima_directe)
victima_relacional = cbind(mat[,21], mat[,25])
victima_relacional_total = rowSums(victima_relacional)
victima = as.data.frame(cbind(victima_directe, victima_relacional))

victima_total = victima_directe_total + victima_relacional_total
victima_est = scale(victima_total)

Victimitzacio = cbind(victima_total, victima_directe[,4], rowSums(victima_directe[,1:3]), victima_relacional_total)
colnames(Victimitzacio) = c("Total víctima", 
                            "Víctima física", 
                            "Víctima verbal",
                            "Víctima relacional")

Vict_sino = ifelse(victima_est > 1, 1, 0)
rownames(Victimitzacio) = noms
rownames(Vict_sino) = noms
Victimitzacio = as.data.frame(Victimitzacio)
Victimitzacio$noms = rownames(Victimitzacio)

Aquest apartat és complementari a l'anterior, i analitzem les víctimes que la disrupció i l'agressivitat.

grafic_barres_classe(Victimitzacio[,2:5], Vict_sino[,1], noms, "Víctimes")

I a continuació presentem una taula amb els mateixos resultats:

Victimitzacio = Victimitzacio[,c(5,2:4,1)]
names(Victimitzacio)[1] = "Noms"
taula_classe(Victimitzacio, Vict_sino[,1])

Acadèmic

Els resultats d'aquesta àrea s'obtenen a partir de les respostes dels alumnes a les següents preguntes:

Treu bones notes

No treu bones notes

Participa a classe

No participa a classe

academic = as.data.frame(cbind(mat[,38], mat[,40], mat[,39], mat[,41]))
colnames(academic) = c("Bones notes", "Participa", "Males notes", "No participa")
academic_est = scale(academic)
academic_total = mat[,38] + mat[,40] - mat[,39] - mat[,41]
academic_total_est = scale(academic_total)
academic_sino = ifelse(academic_total_est < -1,1,0)

academic[,3] = - academic[,3]
academic[,4] = - academic[,4]

academic$noms = factor(noms, levels = as.character(noms))

grafic_barres_classe(academic, academic_sino, noms, "Valoració acadèmica")

I a continuació presentem una taula amb els mateixos resultats:

academic[,3] = - academic[,3]
academic[,4] = - academic[,4]
academic = academic[,c(5,1:4)]
names(academic)[1] = "Noms"
taula_classe(academic, academic_sino[,1], 1:2)

Xarxa relacional acadèmica

En aquest apartat dibuixem la xarxa de relacions acadèmiques entre els nens i les nenes de la classe partint de la informació de la pregunta "Qui voldries al teu grup per fer un treball?".

El gràfic consta dels següents elements:

Cada vèrtex (rodona) és un alumne i cada fletxa és una relació que indica si l'alumne del qual prové la fletxa indica si faria un treball amb l'alumne cap al qual va. Recordem que cada alumne en pot seleccionar fins a 3. La mida del vèrtex mostra el número de tries positives menys el número de tries negatives que ha rebut aquell alumne.

A més, mostrem tres magnituds més: el color dels vèrtex indica les bones notes que treu l'alumne tal com és percebut pels altres (informació que també hem presentat en forma de gràfic més amunt). Per altra banda, el color del nom indica si els altres aumnes perceben que aquell nen o nena participa significativament a classe o no. Per acabar, en els casos en que dos alumnes indiquen que treballarien l'un amb l'altre de forma recíproca, la fletxa es blava.

#creo la xarxa
xarxa = soc[,c(1:3)] # estem agafant només els que sí, els que no els obviem per ara
noms = as.character(xarxa$noms[seq(1,nrow(xarxa),3)])
gg <- graph.data.frame(xarxa[,c(2,3)], directed=T)
gg <- simplify(gg, remove.multiple = F, remove.loops = T) 
deg <- degree(gg, mode="all")

adj = as_adjacency_matrix(gg, sparse = TRUE)

# això és per pintar les relacions bidireccionals de blau (no és molt necessari)
reci = rep(0, nrow(xarxa))
xarxa$relacions = reci

for (i in 1:length(noms)){
  for (j in 1:length(noms)){
    if (adj[i,j] == 1 & adj[j,i] == 1){
      xarxa$relacions[which(xarxa$num==i & xarxa$Feina_sí==j)] = 1
    }
  }
}

V(gg)$label <- as.character(noms)
V(gg)$label.cex = 1
V(gg)$label.font = 2
V(gg)$size <- deg*3 + 1

# faig una paleta manual perquè l'igraph es lia amb la normal:
color_academic = as.data.frame(mat[,38] - mat[,39])
color_academic$noms = noms
colnames(color_academic) = c("academic", "noms")

color_academic$corregida = color_academic$academic- min(color_academic$academic) + 1
paleta <- colorRampPalette(c("chartreuse3", 
                                 "khaki1", 
                                 "firebrick"))(n = max(color_academic$corregida))
paleta = paste0(paleta, "90")   ## afegeixo transparència

colors = rep("", length(noms))

for (i in 1:length(noms)){
  colors[i] = paleta[color_academic$corregida[i]]
}

# participació

participa_est = scale(mat[,40] - mat[,41])

label.color = ifelse(participa_est > 1, "chartreuse3", ifelse(participa_est< -1, "firebrick", "black"))
edge.color = ifelse(xarxa$relacions==1, "darkblue", "black")

plot(gg,
     layout=layout_with_lgl, # altres opcions són: layout_with_gem layout_with_fr, layout_with_mds, layout_with_lgl
     frame = T,
     vertex.label.color = label.color,
     vertex.color = as.character(colors),
     width = 1.5,
     vertex.frame.color = NA,
     vertex.alpha = 0.5,
#     vertex.label.color = label.color,   !!! no funciona !!!
     edge.curved = .2,
     edge.arrow.size = 0.55, 
     label.cex = 0.5, 
     main = "Xarxa de relacions acadèmiques a l'aula",
     sub = "Classe X de l'escola Y")

legend(x=0.7, y=-0.9, c("Males notes","Notes mitjanes", "Bones notes"),
       pch=21, col="#777777", pt.bg=c("firebrick", "khaki1", "chartreuse3"),
       pt.cex=3, cex=1.5, bty="n", ncol=1)
legend(x=-1.2, y=-0.9, c("Poc popular","Normal", "Molt popular"),
       pch=21, col="#777777", pt.bg="gray",
       pt.cex=c(4,5,6), cex=1.5, bty="n", ncol=1)

Estat d'ànim percebut

En aquest apartat mesurem factors d'estat d'ànim relacionats que ens poden donar pistes d'un entorn social no satisfactori, tan a nivell personal com escolar. Els resultats d'aquesta àrea s'obtenen a partir de les respostes dels alumnes a les següents preguntes:

Acostuma a estar content

Es queixa sovint

S'enfada amb facilitat

Sol estar trist

# estat d'ànim percebut (emocional)

estat_anim = as.data.frame(cbind(mat[,28], mat[,29], mat[,30], mat[,31]))
colnames(estat_anim) = c("Dissatisfacció", "Enuig", "Alegria", "Tristor")
estat_anim_est = scale(estat_anim)
estat_anim_total = - estat_anim[,1] - estat_anim[,2] + estat_anim[,3] - estat_anim[,4]
estat_anim_total_est = scale(estat_anim_total)
estat_anim_sino = ifelse(estat_anim_total_est< -1,1,0)
estat_anim = -estat_anim
estat_anim$Alegria = -estat_anim$Alegria
estat_anim$noms = factor(noms, levels = as.character(noms))

grafic_barres_classe(estat_anim, estat_anim_sino, noms, "Estat d'ànim percebut")

I a continuació presentem una taula amb els mateixos resultats:

estat_anim = estat_anim[,c(5,3,1,2,4)]
estat_anim[,3:5] = -1*estat_anim[,3:5]
names(estat_anim)[1] = "Noms"

taula_classe(estat_anim, estat_anim_sino[,1],1)

Caràcter

En aquest apartat mesurem qüestions relacionades amb el caràcter dels i les alumnes, en concret aquells relacionats amb lideratge, autonomia i socialització, ja que pensem que són els que més influècien en les relacions socials dins de l'escola. Els resultats d'aquesta àrea s'obtenen a partir de les respostes dels alumnes a les següents preguntes:

Qui lidera els altres

Qui fa el que li diuen els altres

Soluciona els problemes sol

Acostuma a demanar ajuda

Parla molt amb els altres companys de classe

No parla gaire amb els companys de classe

# caràcter
caracter = as.data.frame(cbind(mat[,32], mat[,33], mat[,34], mat[,35], mat[,36], mat[,37]))
colnames(caracter) = c("Lideratge", "No lideratge", "Autonomia", "No autonomia", "Socialització", "No socialització")
caracter_est = scale(caracter)
caracter_total = - caracter[,1] - caracter[,2] + caracter[,3] - caracter[,4] + caracter[,5] - caracter[,6]
caracter_total_est = scale(caracter_total)
caracter_sino = ifelse(caracter_total_est< -1,1,0)
caracter[,2] = -caracter[,2]
caracter[,4] = -caracter[,4]
caracter[,6] = -caracter[,6]
caracter$noms = factor(noms, levels = as.character(noms))

grafic_barres_classe(caracter, caracter_sino, noms, "Caràcter percebut")

I a continuació presentem una taula amb els mateixos resultats:

caracter = caracter[,c(7,1:6)]
names(caracter)[1] = "Noms"
caracter[,c(3,5,7)] = - caracter[,c(3,5,7)]
taula_classe(caracter, caracter_sino[,1], c(1,3,5))

Estatus sociomètric

En aquest apartat mesurem l'estatus social de cada alumne, tant directe (preguntant directament qui són els seus amics) com indirecte. Els resultats d'aquesta àrea s'obtenen a partir de les respostes dels alumnes a les següents preguntes:

Qui voldries al teu grup per jugar al pati?

Qui NO voldries al teu grup per jugar al pati?

Marca/tria/escull els teus millors amics

Marca/tria/escull els companys que et triarien com a millor amic

Els altres volen estar al seu costat

Pocs companys volen estar amb ell

estatus = cbind.data.frame(mat[,1:6],mat[,19], mat[,26], mat[,27])
estatus_est = scale(estatus)

En aquest cas presentem les relacions en forma de xarxa:

Xarxa relacional social

En aquest apartat dibuixem la xarxa de relacions entre els nens i les nenes de la classe partint de la informació de la pregunta "Tria els teus tres millors amics o amigues".

El gràfic consta dels següents elements:

Cada vèrtex (rodona) és un alumne i cada fletxa és una relació que indica si l'alumne del qual prové la fletxa indica que l'alumne cap al qual va és amic o amiga seva. Recordem que cada alumne en pot seleccionar fins a 3. La mida del vèrtex mostra el número de tries que ha rebut aquell alumne.

A més, mostrem tres magnituds més: el color dels vèrtex indica el grau de disrupció total per aquell alumne, que ja hem vist en el primer apartat de l'informe. Per altra banda, el color del nom indica si els altres aumnes perceben aquell nen o nena com a especialment content o trist (provinent de les preguntes "Normalment està content" i "Normalment està trist"). Per acabar, en els casos en que dos alumnes indiquen que són amics de forma recíproca, la fletxa es blava.

#creo la xarxa
xarxa = soc[,c(1,2,7)]
noms = as.character(xarxa$noms[seq(1,nrow(xarxa),3)])
gg <- graph.data.frame(xarxa[,c(2,3)], directed=T)
gg <- simplify(gg, remove.multiple = F, remove.loops = T) 
deg <- degree(gg, mode="all")

adj = as_adjacency_matrix(gg, sparse = TRUE)

# això és per pintar les relacions bidireccionals de blau (no és molt necessari)
reci = rep(0, nrow(xarxa))
xarxa$relacions = reci

for (i in 1:length(noms)){
  for (j in 1:length(noms)){
    if (adj[i,j] == 1 & adj[j,i] == 1){
      xarxa$relacions[which(xarxa$num==i & xarxa$Amics==j)] = 1
    }
  }
}

V(gg)$label <- as.character(noms)
V(gg)$label.cex = 1
V(gg)$label.font = 2
V(gg)$size <- deg*3 + 1

# faig una paleta manual perquè l'igraph es lia amb la normal:

agressivitat = as.data.frame(Disrupcio$`Disrupció total`)
agressivitat$noms = noms
colnames(agressivitat) = c("disrupcio", "noms")

agressivitat$corregida = agressivitat$disrupcio- min(agressivitat$disrupcio) + 1
paleta <- colorRampPalette(c("chartreuse3", 
                                 "khaki1", 
                                 "firebrick"))(n = max(agressivitat$corregida))
paleta = paste0(paleta, "90")   ## afegeixo transparència

colors = rep("", length(noms))

for (i in 1:length(noms)){
  colors[i] = paleta[agressivitat$corregida[i]]
}
label.color = ifelse(estat_anim_est > 1, "chartreuse3", ifelse(estat_anim_est< -1, "firebrick", "black"))
edge.color = ifelse(xarxa$relacions==1, "darkblue", "black")

plot(gg,
     layout=layout_with_lgl, # altres opcions són: layout_with_gem layout_with_fr, layout_with_mds, layout_with_lgl
     frame = T,
     vertex.label.color = label.color, 
     vertex.color = as.character(colors),
     width = 1.5,
     vertex.frame.color = NA,
     vertex.alpha = 0.5,
#     edge.color = edge.color , !!! no funciona !!!
     edge.curved = .2,
     edge.arrow.size = 0.55, 
     label.cex = 0.5, 
     main = "Xarxa de relacions a l'aula",
     sub = "Classe X de l'escola Y")

legend(x=0.7, y=-0.9, c("Poc disruptiu","Disrupcio mitjana", "Molt disruptiu"),
       pch=21, col="#777777", pt.bg=c("chartreuse3", "khaki1", "firebrick"),
       pt.cex=3, cex=1.5, bty="n", ncol=1)
legend(x=-1.2, y=-0.9, c("Poc popular","Normal", "Molt popular"),
       pch=21, col="#777777", pt.bg="gray",
       pt.cex=c(4,5,6), cex=1.5, bty="n", ncol=1)

Nota: el color del nom del nen o la nena indica si és percebut com a content pels seus companys. Verd és que sí, vermell és que no, negre és que no hi ha prou respostes sobre ell o ella perquè sigui rellevant.

Xarxes amb visNetwork

my_palette <- colorRampPalette(c("green", "yellow", "red"))(n = 30)
visgg = toVisNetworkData(gg)

ns = visgg$nodes
es = visgg$edges

ns$label = noms
ns$color = my_palette[agressivitat$corregida]
ns$shape = rep("circle", nrow(ns))
ns$font.size = ns$size


visNetwork(ns, es) %>% 
  visEdges(arrows = "to") %>%
  visOptions(highlightNearest = TRUE) %>%
  visLayout(randomSeed = 123) %>%
  visPhysics(solver = "forceAtlas2Based", 
             forceAtlas2Based = list(gravitationalConstant = -20), 
             enabled = F)