analisisCluster.qmd

if (!require("pacman")) install.packages("pacman")

Loading required package: pacman

pacman::p_load("tidyverse", "lubridate", "psych")

load("postProcessed-benalmadena-1a100b.RData")

baseDatos <- postProcessed %>% select(prefijoRAW,L1) %>% unnest(cols="L1") %>% 
  arrange(prefijoRAW,name) %>%
  mutate(fecha=ymd(str_replace(name,"[._][0-9]+$","")),
         intradia=as.integer(str_replace(name,".*[._]([0-9]+)$","\\1"))) %>% 
  mutate(diaSem=wday(ymd(fecha),week_start = 1)) %>% 
  select(prefijoRAW,fecha,intradia,diaSem,everything()) %>%
  arrange(prefijoRAW,fecha,intradia) %>% mutate_if(is.double, ~round(., 2)) %>% 
  filter(!str_detect(fecha,"\\.\\.")) %>% 
  mutate(
    VPA_pc_wb5=dur_VPA_05s_Adult_wb5 / dur_wb5, # % está en VPA
    wb01_pc_wb5=dur_wb_01_90_3m_wb5 / dur_wb5,#% del tiempo contiene al menos wb01 (tiempo al menos paseando)
    fragwb01=n_wb_01_90_3m_wb5 / dur_wb_01_90_3m_wb5 #indice de fragmentación.
    )

Warning: There was 1 warning in `mutate()`.
ℹ In argument: `intradia = as.integer(str_replace(name, ".*[._]([0-9]+)$",
  "\\1"))`.
Caused by warning:
! NAs introduced by coercion

#crear grafico de cluster jerarquico de las variables de baseDatos

variables="ENMO_mean_wb5
ENMO_sd_wb5
dur_wb5
steps_wb5
cad_wb5
ENMO_mean_VPA_05s_Adult_wb5
ENMO_sd_VPA_05s_Adult_wb5
dur_VPA_05s_Adult_wb5
ENMO_mean_MVPA_03m_Adult_wb5
ENMO_sd_MVPA_03m_Adult_wb5
dur_MVPA_03m_Adult_wb5
n_MVPA_03m_Adult_wb5
steps_MVPA_03m_Adult_wb5
cad_MVPA_03m_Adult_wb5
ENMO_mean_MVPA_10m_Adult_wb5
ENMO_sd_MVPA_10m_Adult_wb5
dur_MVPA_10m_Adult_wb5
n_MVPA_10m_Adult_wb5
steps_MVPA_10m_Adult_wb5
cad_MVPA_10m_Adult_wb5
ENMO_mean_wb_10_90_3m_i2m_wb5
ENMO_sd_wb_10_90_3m_i2m_wb5
dur_wb_10_90_3m_i2m_wb5
n_wb_10_90_3m_i2m_wb5
ENMO_mean_wb_01_90_3m_i2m_wb5
ENMO_sd_wb_01_90_3m_i2m_wb5
dur_wb_01_90_3m_i2m_wb5
n_wb_01_90_3m_i2m_wb5
VPA_pc_wb5
wb01_pc_wb5
fragwb01"

variables=unlist(strsplit(variables,"\n"))

baseLimitada= baseDatos %>%   
  select(prefijoRAW:diaSem,all_of( intersect(variables,names(baseDatos)))) %>%
  filter(!is.na(intradia)) %>% 
  filter(complete.cases(.))

df = baseLimitada %>% 
  select(all_of( intersect(variables,names(baseDatos)))) %>%
  select(where(~!all(is.na(.)))) %>% 
  select(where(is.numeric)) %>%
  select(where(~sd(.,na.rm=T)>0.01)) 




df_scaled <- scale(df)

cor_matrix=df_scaled%>%cor()

dist_matrix <- as.dist(1 - cor_matrix)

# Realizar el clustering jerárquico de variables

hclust_result <- hclust(dist_matrix, method = "complete")

# Graficar el dendrograma
plot(hclust_result, main = "Clúster jerárquico basado en la correlación", 
     xlab = "", ylab = "Distancia", sub = "", cex = 0.7)

#Vamos a hacer cluster de filas (paseos) usando solo algunas de las
#variables con las que hemos organizado el cluster de variables
#Realmente se pueden usar todas

variables2=c( "dur_wb5", "dur_wb_10_90_3m_i2m_wb5", "ENMO_sd_wb5", "ENMO_mean_wb_10_90_3m_i2m_wb5",
  "VPA_pc_wb5", "wb01_pc_wb5", "fragwb01")

df_scaled2 =scale(df %>% select(all_of(variables2)))

dist_rows <- dist(df_scaled2, method = "euclidean")

#Creamos el dendograma
hc_rows <- hclust(dist_rows, method = "ward.D2")

# Visualiza el dendrograma
plot(hc_rows, main = "Clustering jerárquico de filas", xlab = "",
     sub = "",cex=0.1)

grupos3 <- cutree(hc_rows, h = 65)
grupos4 <- letters[cutree(hc_rows, h = 55)]



dfg=data.frame(grupos3,grupos4) %>% as_tibble() %>% 
  mutate(grupo=paste0(grupos3,"",grupos4)) %>% 
  mutate(grupo=case_when(grupo=="2c" ~"2", grupo=="3d" ~ "3", TRUE ~ grupo))#%>% 
#  mutate(grupo=gsub("(.)\\1+", "\\1", grupo))

dfg %>% count(grupo)

# A tibble: 4 × 2
  grupo     n
  <chr> <int>
1 1a     1147
2 1b      767
3 2       447
4 3       122

# Primero hacemos análisis factorial con rotación oblimin de dos factores de todas las columnnas de dfAnalisis menos la primera
#Empezamos cargando la libreria adecuada

fa <- fa(df_scaled2, nfactors = 3, rotate = "oblimin")

Loading required namespace: GPArotation

Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
The estimated weights for the factor scores are probably incorrect.  Try a
different factor score estimation method.

Warning in fac(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate, : An
ultra-Heywood case was detected.  Examine the results carefully

# Mostrar los pesos de cada factor
fa$loadings

Loadings:
                              MR1    MR2    MR3   
dur_wb5                        0.998              
dur_wb_10_90_3m_i2m_wb5        0.964        -0.104
ENMO_sd_wb5                           0.602  0.193
ENMO_mean_wb_10_90_3m_i2m_wb5         1.004       
VPA_pc_wb5                            0.868       
wb01_pc_wb5                   -0.367        -0.735
fragwb01                      -0.389         0.721

                 MR1   MR2   MR3
SS loadings    2.212 2.133 1.122
Proportion Var 0.316 0.305 0.160
Cumulative Var 0.316 0.621 0.781

Se pueden crear estas 3 variables que son combinaciones lineales de las variables originales y explican un 78% de la varianza total.

MR1 es una variable que puntúa alto cuando hay mucha duración (y algo más si hay baja fragmentacion con bajo porcentaje de tiempo caminando)

MR2 puntua alto con la intensidad (ENMO y pct en VPA)

MR3 puntua alto con la fragmentación y bajo porcentaje de tiempo caminando

dfFinal=baseLimitada %>% mutate(grupo=dfg$grupo) %>% cbind(fa$scores)  %>% 
  select(prefijoRAW:diaSem, grupo, MR1,MR2,MR3,everything()) 

#HAcer boxplot de las variables en función de los grupos
dfFinal %>% select(grupo,MR1,MR2,MR3) %>% 
  pivot_longer(cols=MR1:MR3)  %>% 
  ggplot(aes(x=grupo,y=value,fill=grupo,color=grupo))+
  geom_boxplot(alpha=0.25)+geom_jitter(width=0.2,alpha=0.1)+
  facet_wrap(~name)

# Vamos a representar los clusters en un plano de dos dimensiones de las variables factoriales

dfFinal  %>% 
  ggplot(aes(x=MR1,y=MR2,color=grupo,label=prefijoRAW))+
  geom_point(alpha=0.25)+
  theme_minimal()

# Vamos a representar los clusters en un plano de dos dimensiones de las variables factoriales

dfFinal  %>% 
  ggplot(aes(x=MR1,y=MR3,color=grupo,label=prefijoRAW))+
  geom_point(alpha=0.25)+
  theme_minimal()

# Vamos a representar los clusters en un plano de dos dimensiones de las variables factoriales

dfFinal  %>% 
  ggplot(aes(x=MR2,y=MR3,color=grupo,label=prefijoRAW))+
  geom_point(alpha=0.25)+
  theme_minimal()

Vamos a repetir lo mismo con un gráfico en 3d manipulable por el usuario y con puntos pequeños

library(plotly)

Attaching package: 'plotly'

The following object is masked from 'package:ggplot2':

    last_plot

The following object is masked from 'package:stats':

    filter

The following object is masked from 'package:graphics':

    layout

dfFinal %>% plot_ly(x=~MR1,y=~MR2,z=~MR3,color=~grupo,text=~prefijoRAW) %>%
  add_markers(marker=list(size=2)) %>%
  layout(scene = list(xaxis = list(title = 'MR1'),
                      yaxis = list(title = 'MR2'),
                      zaxis = list(title = 'MR3')))