mail: dameliotomas@gmail.com

Participantes

Treinta y cuatro mujeres diestras (edad media = 21.24 años; SD= 3.38) fueron evaluadas en el presente estudio. Los participantes recibieron créditos académicos por asistencia al experimento. Fueron criterios de exclusión la historia de enfermedades neurológicas o psiquiátricas y la existencia de trastornos sensorio-motores de otra índole, así como también el consumo de medicación neurológica o psiquiátrica, haber dormido menos de 5 horas la noche anterior, y/o poseer deficiencias visuales no corregidas. El protocolo de estudio fue aprobado por la Comité de Conductas Responsables de la Facultad de Psicología de la Universidad de Buenos Aires (ver Anexo 1). Todos los participantes firmaron una nota de consentimiento informado. Se siguieron estrictamente las recomendaciones internacionales para la experimentación humana (American Psychological Association, 2002).

Estimulos

Los estímulos utilizados fueron obtenidos del Sistema Internacional de Imágenes Afectivas (International Affective Pictures System [IAPS], Lang, Bradley y Cuthbert, 2008). Los mismos tenían un tamaño de 7.2 cm x 5.4 cm. Estos estímulos pertenecían a tres categorías: neutros, aversivos y apetitivos. El conjunto de estímulos neutros estaba conformado por objetos (e.g., una cuchara o una canasta). Los estimulos neutros solamente fueron utilizados en los ensayos de prueba. Los estímulos aversivos, por su parte, se dividieron en dos subconjuntos: mutilaciones humanas y animales aversivos (e.g., cucarachas o arañas). El set de estímulos apetitivos estaba conformado por imágenes eróticas de parejas heterosexuales, puesto que éstas presentan altos niveles tanto de arousal como de valencia, según los datos normativos de Lang, Bradley y Cuthbert (2008). Para realizar la selección de los estímulos aversivos, se tomaron en consideración los datos normativos de la validación argentina de imágenes pertenecientes al IAPS (Irrazabal, Aranguren, Zaldua y Di Giuliano, 2015). Teniendo en cuenta que no existe una validación argentina de un set de imágenes eróticas de parejas heterosexuales, se tomaron los datos normativos de Lang, Bradley y Cuthbert (2008) como referencia para realizar la selección de estímulos apetitivos. Así, se seleccionaron estímulos con valores altos de arousal (rango de valores de los estímulos: 5.55 a 7.79) y con valores opuestos en la dimensión “valencia” (rango de valores de estímulos “apetitivos”: 5.45 a 7.22; rango de valores de estímulos “aversivos”: 1.16 a 2.98). Por otra parte, se controló la luminancia de la imagen a partir de su medición (a través de SHINE Toolbox; Willenbockel et al., 2010) y su modificación (a través de Adobe Photoshop) en caso que fuera necesario. La modificación de la luminancia se realizó teniendo en cuenta que dicha propiedad de las imágenes puede influenciar la evaluación de sus componentes afectivos (Lakens, Fockenberg, Lemmens, Ham y Midden, 2013). Para comparar los valores de luminancia entre estímulos aversivos y apetitivos, se realizó una prueba de comparación de medias para muestras independientes (prueba U de Mann Whitney), con un nivel de significancia bilateral. No se detectaron diferencias significativas entre el set de estímulos aversivos (M= 100.30 SD= 23.63) y apetitivos (M= 98.17 SD= 34.21) en sus puntajes de luminancia, (Z = 0.09, p > .92). Del mismo modo se evaluó la complejidad de los estímulos, tomando como estimador el tamaño en kilobytes del archivo comprimido JPEG de cada imágen (Donderi, 2006; Stickel, Ebner, y Holzinger, 2010). Para comparar los valores de complejidad entre estímulos aversivos y apetitivos, se realizó también una prueba de comparación de medias para muestras independientes (prueba U de Mann Whitney), con el nivel de significancia bilateral. No se observaron diferencias significativas entre el set de estímulos aversivos (M= 295,88, SD= 178,27) y apetitivos (M= 292,19, SD= 182,54) en sus puntajes de complejidad (Z = 0,77, p > .44).

Procedimiento

Los participantes fueron evaluados individualmente, en una sala tranquila con temperatura controlada (aproximadamente 24 ° C). Al comenzar el experimento, se les proporcionó a los participantes información acerca del procedimiento y luego se les brindó un formulario de consentimiento informado para completar. Cada sesión experimental duró aproximadamente 45 minutos por participante. Al comienzo del experimento, los participantes completaron una serie de datos demográficos personales (e.g. género, edad), así como también procedieron a completar el Inventario de Lateralidad Manual de Edimburgo (Oldfield, 1971). Luego de esto, se los instruyó para que completen el Cuestionario de Personalidad BIS/BAS-IPIP (Martinez, Jaime, Pilatti y Cupani, 2012), Luego, el investigador conectó los sensores de actividad electrodérmica a las falanges medias izquierda y derecha de los dedos índice y medio de los participantes. Se pidió a los mismos que fijaran su cabeza en una mentonera ubicada a una distancia constante de 57 cm de la superficie de la pantalla (Kayser, 2015). También se les indicó que permanecieran lo más quietos posible durante la tarea para evitar artefactos en el registro de EDA y que mantengan su mirada visual en el centro de la pantalla donde se mostraba una cruz de fijación (Wong, Shevrin y Williams, 1994). La siguiente tarea consistió simplemente en la presentación de los estímulos y la observación de los mismos por parte del participante (es decir, tarea pasiva). La evaluación se realizó en 8 bloques de 8 ensayos, durante los cuales las imágenes se presentaron de forma pseudoaleatoria según su valencia (positiva y negativa). La introducción de pausas regulares se realizó para mantener altos niveles de concentración (Bourne, 2006). Cada prueba fue precedida por una cruz de fijación en el centro de la pantalla durante 1500 ms. Luego, los estímulos se presentaron de forma centrada durante 180 ms. Los estímulos se presentaron de forma espejada, ya que un problema potencial al presentar estímulos lateralizados es la disminución de la agudeza visual en la visión periférica (Bourne, 2006). Por el mismo motivo, cada estímulo fue seguido por una máscara (un imagen compuesta por partes de imágenes neutras de IAPS) que apareció centralmente durante 80 ms para evitar un tiempo de exposición más largo del estímulo en la retina de los participantes (Bourne, 2006) . Finalmente, hubo un intervalo entre ensayos de 4000 ms. Antes de comenzar la fase experimental, se realizó un bloque de prueba de 8 intentos para controlar que el participante entendiera la tarea. En este caso, se utilizaron estímulos neutros para evitar cualquier tipo de sesgo antes de la evaluación. Una vez concluida la fase experimental, se procedió a la realización de una tarea final de auto-reporte. La misma consistió en la ejecución de la tarea del Maniquí de Autoevaluación (Self-Assessment Manikin [SAM]) ideada por Lang (1980). Así, se instruyó a los participantes para que evaluaran las imágenes vistas en la fase previa de acuerdo a una medida subjetiva compuesta por tres dimensiones: valencia, nivel de excitación (arousal) y dominancia. Estas tres dimensiones conforman tres escalas diferentes, con valores del 1 al 9 (Bradley y Lang, 1994). El procedimiento de exposición de los estímulos fue similar al de la tarea de registro de actividad electrodérmica. Cada ensayo fue precedido por una cruz de fijación de 1500 ms. Luego, los estímulos fueron exhibidos por 180 ms de forma centrada, seguido por una máscara de 80 ms de duración. Sin embargo, esta vez el tiempo entre estímulos no fue fijo, sino que se esperó a que el participante finalizara el reporte de las tres dimensiones del SAM previo a que comience automáticamente la exposición de la siguiente imagen.

Time Domain Features

Calculo media y desvío para las variables que componene el tibble “data” Se calculan features por estimulo, por sujeto. Para esto me sirvo de los datos crudos de EDA, no de los logaritmizados.

# Hago una funcion que calcule:
#   el promedio de EDA_IZQ
media_izq_func <- function(df) {
  round(mean(df$EDA_IZQ),4)
}
#   el promedio de EDA_DER
media_der_func <- function(df) {
  round(mean(df$EDA_DER),4)
}
#   el desvio estandar de EDA_IZQ
sd_izq_func <- function(df) {
  round(sd(df$EDA_IZQ),4)
}
#   el desvio estandar de EDA_DER
sd_der_func <- function(df) {
  round(sd(df$EDA_DER),4)
}
# Creo nuevas variables en el dataframe original sirviendome de esas funciones
df <- df %>% 
  mutate(MEDIA_IZQ = map(data, media_izq_func)) %>%
  mutate(MEDIA_DER = map(data, media_der_func)) %>%  
  mutate(SD_IZQ = map(data, sd_izq_func)) %>%
  mutate(SD_DER = map(data, sd_der_func)) 

Sigo creando variables del tipo Time Domain Features. Calculo kurtosis y skweness para las variables que componene el tibble “data”. Nuevamente, se calculan features por estimulo, por sujeto.

# Hago una funcion que calcule:
#   kurtosis de EDA_IZQ
kurtosis_izq_func <- function(df) {
  round(kurtosis(df$EDA_IZQ),4)
}
#   kurtosis de EDA_DER
kurtosis_der_func <- function(df) {
  round(kurtosis(df$EDA_DER),4)
}
#   skweness de EDA_IZQ
skewness_izq_func <- function(df) {
  round(skewness(df$EDA_IZQ),4)
}
#   skweness de EDA_DER
skewness_der_func <- function(df) {
  round(skewness(df$EDA_DER),4)
}
# Creo nuevas variables en el dataframe original sirviendome de esas funciones
df <- df %>% 
  mutate(KURTOSIS_IZQ = map(data, kurtosis_izq_func)) %>%
  mutate(KURTOSIS_DER = map(data, kurtosis_der_func)) %>%  
  mutate(SKEWNESS_IZQ = map(data, skewness_izq_func)) %>%
  mutate(SKEWNESS_DER = map(data, skewness_der_func)) 

Voy a graficar como se comporta la actividad electrodermica bilateral para un ensayo cualquiera, a modo de ejemplo

PRUEBA_1 <- df$data[[344]]
PRUEBA_EDA_IZQ<-data.frame(x=PRUEBA_1$TIEMPO_ESTIMULO,y=PRUEBA_1$EDA_IZQ)
PRUEBA_EDA_DER<-data.frame(x=PRUEBA_1$TIEMPO_ESTIMULO,y=PRUEBA_1$EDA_DER)

ggplot(PRUEBA_EDA_IZQ,aes(x,y))+geom_line(aes(color="EDA IZQ"))+
  geom_line(data=PRUEBA_EDA_DER,aes(color="EDA DER"))+
  labs(color="EDA") +
  xlab("Tiempo (segs.)") +
  ylab("μS") +
  labs(title = "Actividad electrodermica bilateral para un ensayo de un sujeto")

Calcular SCR a partir de los datos de actividad electrodérmica (con un umbral de 0.01 μS).

# Calculo SCR para EDA_IZQ primero (luego para EDA_DER), poniendo como umbral de SCR >=0.01
# Hago la funcion para calculo de SCR DE EDA_IZQ
SCR_izq_func <- function(df) {
  minimo_para_SCR_izq <- df[21,"EDA_IZQ"]
  maximo_para_SCR_izq <- max(df$EDA_IZQ)
  SCR_IZQ_resultado <- maximo_para_SCR_izq - minimo_para_SCR_izq 
  if_else(SCR_IZQ_resultado >=0.01, round(SCR_IZQ_resultado[1,1], 4), 0.0000)
}

SCR_der_func <- function(df) {
  minimo_para_SCR_der <- df[21,"EDA_DER"]
  maximo_para_SCR_der <- max(df$EDA_DER)
  SCR_DER_resultado <- maximo_para_SCR_der - minimo_para_SCR_der 
  if_else(SCR_DER_resultado >=0.01, round(SCR_DER_resultado[1,1], 4), 0.0000)
}

# Creo nuevas variables en el dataframe  sirviendome de esas funciones
df <- df %>% 
  mutate(SCR_IZQ = map(data, SCR_izq_func)) %>% 
  mutate(SCR_DER = map(data, SCR_der_func))  

Ajusto un modelo lineal para “TIEMPO_ESTIMULO” y “EDA_IZQ” (tambien con EDA_DER) y me quedo con los β₁ como features.

# Creo las funciones para obtener los coeficientes de lm para EDA IZQ Y DER
prueba1_lm <- lm(EDA_IZQ ~ TIEMPO_ESTIMULO, data = PRUEBA_1)

EDA_IZQ_model <- function(df) {
  EDA_lm_IZQ <- lm(EDA_IZQ ~ TIEMPO_ESTIMULO, data = df)
  as.numeric(EDA_lm_IZQ$coef[2])
}
EDA_DER_model <- function(df) {
  EDA_lm_DER <- lm(EDA_DER ~ TIEMPO_ESTIMULO, data = df)
  as.numeric(EDA_lm_DER$coef[2])
}
# Creo nuevas variables en el dataframe  sirviendome de esas funciones
df <- df %>% 
  mutate(EDA_IZQ_beta1 = map(data, EDA_IZQ_model)) %>% 
  mutate(EDA_DER_beta1 = map(data, EDA_DER_model))

Coeficientes de lateralidad

Una vez finalizado el proceso de extracción de features del tipo Time Domain Features, voy a crear algunas features de coeficientes de lateralidad (variables de particular interés para el presente trabajo).

Las variables a craer son:

• Coeficiente_lat_SCR (propuesto por Schulter and Papousek,1998: \[ {\frac{EDA_{ DER} - EDA_{ IZQ}}{EDA_{ DER} + EDA_{ IZQ}}} \]

• Coeficiente_lat_EDA_MEDIA
• Coeficiente_lat_EDA_SD
• Coeficiente_lat_EDA_kurtosis
• Coeficiente_lat_EDA_skewness

• Coeficiente_lat_EDA_lm

# Creo nuevas variables en el dataframe referidas a coeficientes de lateralidad

df <- df %>% 
  mutate(Coeficiente_lat_SCR = (as.numeric(SCR_DER) - as.numeric(SCR_IZQ))/(as.numeric(SCR_DER) + as.numeric(SCR_IZQ))) %>% 
    mutate(Coeficiente_lat_EDA_MEDIA = (as.numeric(MEDIA_DER) - as.numeric(MEDIA_IZQ))/(as.numeric(MEDIA_DER) + as.numeric(MEDIA_IZQ))) %>% 
    mutate(Coeficiente_lat_EDA_SD = (as.numeric(SD_DER) - as.numeric(SD_IZQ))/(as.numeric(SD_DER) + as.numeric(SD_IZQ))) %>%   
    mutate(Coeficiente_lat_EDA_kurtosis = (as.numeric(KURTOSIS_DER) - as.numeric(KURTOSIS_IZQ))/(as.numeric(KURTOSIS_DER) + as.numeric(KURTOSIS_IZQ))) %>% 
    mutate(Coeficiente_lat_EDA_skewness = (as.numeric(SKEWNESS_DER) - as.numeric(SKEWNESS_IZQ))/(as.numeric(SKEWNESS_DER) + as.numeric(SKEWNESS_IZQ))) %>%
    mutate(Coeficiente_lat_EDA_lm = (as.numeric(EDA_DER_beta1) - as.numeric(EDA_IZQ_beta1))/(as.numeric(EDA_DER_beta1) + as.numeric(EDA_IZQ_beta1))) 

Redondeo los datos a 4 decimales desde la columna 15 a la 22 (columnas de coeficientes)

df[,c(15:22)] <- as.numeric(unlist(df[,c(15:22)]))
df[,c(15:22)] <- round(df[,c(15:22)],4)

#Hago todas las features numericas
df[,c(5:22)] <-  mutate_all(df[,c(5:22)], function(x) as.numeric(as.character(x)))

Chequeo cuántos NA hay por columna

for (i in 5:22){
  print(sum(is.na(df[,i])))
}

## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 797
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0

# "Coeficiente_lat_SCR" tiene 797 NA. 
# Asigno 0 cuando "Coeficiente_lat_SCR" es NA (porque en realidad tanto SCR_IZQ como SCR_DER eran 0, y el calculo de 0 dividido 0 daba NA)
df$Coeficiente_lat_SCR[is.na(df$Coeficiente_lat_SCR)] <- 0

Selección de features

Elegir algun metodo de seleccion de features y aplicarlo (se tomaron de referencias algunos de estos códigos)

# ensure the results are repeatable
set.seed(7)
# calculate correlation matrix
correlationMatrix <- cor(df[,5:22])
# find attributes that are highly corrected (ideally >0.75)
highlyCorrelated <- findCorrelation(correlationMatrix, cutoff=0.5)
# print indexes of highly correlated attributes
highlyCorrelated

## [1] 10  4  3  1  9 15

for (i in highlyCorrelated){
print(colnames(df)[(4+i)])
}

## [1] "SCR_DER"
## [1] "SD_DER"
## [1] "SD_IZQ"
## [1] "MEDIA_IZQ"
## [1] "SCR_IZQ"
## [1] "Coeficiente_lat_EDA_SD"

Selección a partir del método Recursive Feature Elimination (RFE)

Para poder emplear este método de selección de features voy a tener que preparar una columna de target:

• 1: “POSITIVO”
• 0: “NEGATIVO”

Recordar que el target refiere a si las imagenes tienen valencia positiva o negativa. En este caso se modelo como categórica, pero también podria modelarse como dimensional (puesto que la variable original de valencia es dimensional, con valores del 1 al 7)

#Creo la columna target
df$TARGET <- NA
df$TARGET <- as.integer(grepl('pos',df$ESTIMULO))
#Conveirto el target a factor
df$TARGET <- as.factor(df$TARGET)

Una vez separada la columna de target, corro la selección de features a partir del método RFE

# ensure the results are repeatable
set.seed(7)
# load the library
library(mlbench)
library(caret)
# define the control using a random forest selection function
control <- rfeControl(functions=rfFuncs, method="cv", number=10)
# run the RFE algorithm
library(randomForest)
results <- rfe(df[,5:22], df$TARGET, sizes=c(1:18), rfeControl=control)
# summarize the results
print(results)
# list the chosen features 
predictors(results)
# plot the results
plot(results, type=c("g", "o"))

Selección de variables con RFE

Según la selección de features realizada con RFE, las variables a conservar son:

• Coeficiente_lat_EDA_kurtosis
• SCR_DER

De todos modos, estos predictores son apenas superiores al 51% de accuracy.

Tristeza

Vuelvo a correr la selección de features escalando previaemnte los datos, para ver si eso cambia la performance alcanzada.

# Escalo los datos
df_escalado <- df
df_escalado[,5:22] <- scale(df_escalado[,5:22])
# ensure the results are repeatable
set.seed(10)
# load the library
library(mlbench)
library(caret)
# define the control using a random forest selection function
control <- rfeControl(functions=rfFuncs, method="cv", number=5)
# run the RFE algorithm
library(randomForest)
results <- rfe(df_escalado[,5:22], df_escalado$TARGET, sizes=c(1:18), rfeControl=control)
# summarize the results
print(results)
# list the chosen features 
predictors(results)
# plot the results
plot(results, type=c("g", "o"))

Predictores seleccionados por el modelo como variables importantes en la clasificación de estados afectivos [1] “SCR_DER”
[2] “Coeficiente_lat_SCR” [3] “Coeficiente_lat_EDA_skewness”
[4] “KURTOSIS_IZQ” [5] “SCR_IZQ”
[6] “SKEWNESS_DER” [7] “Coeficiente_lat_EDA_lm”

Selección de variables con RFE

Podemos ver que tampoco de esta forma podemos mejorar el accuracy.

Clustering Jerárquico

Hago una función para correr clustering jerarquico con un único parametro: “metodo a emplear en la matriz de distancia”. De esta forma, la función va a devolver el metodo de clusterización maximice la correlación cofenética.

clustering_jerarquico <- function(method_mat_dist){
  # Matriz de distancias euclideas
  mat_dist <- dist(x = df_clustering, method = method_mat_dist)
  # Dendogramas
  hc_complete <- hclust(d = mat_dist, method = "complete") 
  hc_average <- hclust(d = mat_dist, method = "average") 
  hc_single <- hclust(d = mat_dist, method = "single")
  hc_ward <- hclust(d = mat_dist, method = "ward.D2")
  lista_hc <- c(hc_complete, hc_average, hc_single, hc_ward)
  name_hc <- c("hc_complete", "hc_average", "hc_single", "hc_ward")
  values <- c(cor(x = mat_dist, cophenetic(hc_complete)),
              cor(x = mat_dist, cophenetic(hc_average)),
              cor(x = mat_dist, cophenetic(hc_single)),
              cor(x = mat_dist, cophenetic(hc_ward)))
  hc <- data.frame(name_hc, values)
  return (hc %>% filter(values == max(values)))
}

Corro la función que devuelve el hc maximo

clustering_jerarquico("euclidean")

##      name_hc    values
## 1 hc_average 0.9335897

Uso ese hc con correlación cofenetica maxima (“average”) para plotear el clustering

# Creo la función para ese plot.
# 2 parámetros: a) metodo de la matriz de distancia; b) metodo de clusterización
plot_clustering_jerarquico <- function(method_mat_dist, hc_metodo){
  mat_dist <- dist(x = df_clustering, method = method_mat_dist)
  hc <- hclust(d = mat_dist, method = hc_metodo)
  plot(hc)
}
plot_clustering_jerarquico("euclidean", "average") 

No parece haber tendencia al clustering. A continuación, voy a probar la clusterización con otros parametros (e.g. cambiando la distancia empleada para el cálculo de la matriz de distancias):

• Manhattan

clustering_jerarquico("manhattan") 

##      name_hc    values
## 1 hc_average 0.8988347

plot_clustering_jerarquico("manhattan", "average") 

• Maximum

clustering_jerarquico("maximum") 

##      name_hc    values
## 1 hc_average 0.9494773

plot_clustering_jerarquico("maximum", "average")

• Canberra

clustering_jerarquico("canberra") 
# Realizo el plot del del clustering jerárquico con Canberra
mat_dist <- dist(x = df_clustering, method = "canberra")
hc_average <- hclust(d = mat_dist, method = "average")

factoextra::fviz_dend(x = hc_average, k = 2, cex = 0.6) + 
  ggplot2::labs(x = "Imagenes afectivas (IAPS)", y = "Altura", 
                title = "Clasificación de estados afectivos según EDA bilateral",
                subtitle = "Clustering jerárquico") +
  theme(plot.title = element_text(size=22)) +
  theme(plot.subtitle = element_text(size=22)) +
  theme(axis.text=element_text(size=18),
        axis.title=element_text(size=18,face="bold")) + 
  ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5),
                 plot.subtitle = ggplot2::element_text(hjust = 0.5)
  )

Tendencia al clustering con distancia “Canberra”

Podemos ver que si bien a partir del uso de “Canberra” como método para el cálculo de la matriz de distancias la métrica de correlación cofénitica es la menor comparado con el uso de otras distancias(c=0.77), la clusterización parece dar mejor que con cualquier otra medida. De esta forma, parecería existir alguna tendencia al clustering (a pesar de que no divide en dos grupos homogeneos, como idealmente debería suceder), motivo por el cual voy a probar otros algoritmos de clusterización no supervisados.

K-means

Silhouette <- function(df){
  fviz_nbclust(df, kmeans, method = "silhouette")+
    labs(subtitle = "Silhouette method") 
}
Silhouette(df_clustering)

SSE <- function(df){
  fviz_nbclust(df, kmeans, method = "wss")+
  labs(subtitle = "SSE method")
}
SSE(df_clustering)

set.seed(123) # Fijo semilla por la asignacion de los centroides
# Implemento k-means
km_clusters_df_clustering <- kmeans(x = df_clustering, centers = 2, nstart = 25)
# Uso k = 2. 
clusters_df_clustering <- km_clusters_df_clustering$cluster

# Creo un df uniendo: a)la columna de clusters producto de la implementacion del k-means; b) la colimna de "TARGETS"
clusters_df_clustering_TARGET <- cbind(clusters_df_clustering, TARGET)

# Construyo la matriz de confusión
table(clusters_df_clustering_TARGET[,1],clusters_df_clustering_TARGET[,2])

##    
##        1    2
##   1 1045 1040
##   2   43   48

#Armo un df juntando el df_clustering con sus etiquetas de clase ("TARGET")
#visualizO haciendo PCA

df_clustering_etiquetado_target <- cbind(df_clustering, TARGET)

library(ggfortify)

## Warning: package 'ggfortify' was built under R version 3.6.1

autoplot(prcomp(df_clustering), data = df_clustering_etiquetado_target, colour = 'TARGET')

PAM

#Matriz de distancias
mat_dist <- dist(x = df_clustering, method = "canberra")

# Grafico de Silhouette para PAM con k = 2 (en .jpg aparte)
personal_pam <- pam(mat_dist, 2, diss = T)

# Grafico los clusters con PAM
clusplot(personal_pam) 

Tendencia al clustering con PAM"

Con la implementación de este algoritmo no supervisado no puede verse una mejor clusterización. Habiendo finalizado la exploración algoritmos no supervisados en forma infructífera, paso a la implementación de métodos supervisados

SVM con todos los features

Implemento Support Vector Machine general para todos mis datos (ver apunte pag 343 de Anadatos)

#Creo un set de datos exclusivamente para correr el SVM
df_SVM <- df[,5:23]
# Particiono los datos
set.seed(3033)
intrain <- createDataPartition(y = df_SVM$TARGET, p= 0.7, list = FALSE)
training <- df_SVM[intrain,]
testing <- df_SVM[-intrain,]
# Preprocesamiento y entrenamiento
trctrl <- trainControl(method = "repeatedcv", number = 10, repeats = 3)
set.seed(3233)
svm_Linear <- train(TARGET ~., data = training, method = "svmLinear",
                 trControl=trctrl,
                 preProcess = c("center", "scale"),
                 tuneLength = 10)
svm_Linear

## Support Vector Machines with Linear Kernel 
## 
## 1524 samples
##   18 predictor
##    2 classes: '0', '1' 
## 
## Pre-processing: centered (18), scaled (18) 
## Resampling: Cross-Validated (10 fold, repeated 3 times) 
## Summary of sample sizes: 1371, 1372, 1371, 1372, 1372, 1372, ... 
## Resampling results:
## 
##   Accuracy   Kappa     
##   0.5142127  0.02833544
## 
## Tuning parameter 'C' was held constant at a value of 1

En el conjunto de entrenamiento ya podemos ver que el modelo performa muy mal (Accuracy = 0.5048).

Solo para probar, podemos ver como performa la predicción en el conjunto de test

test_pred <- predict(svm_Linear, newdata = testing)
confusionMatrix(test_pred, testing$TARGET)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 153 170
##          1 173 156
##                                          
##                Accuracy : 0.4739         
##                  95% CI : (0.435, 0.5131)
##     No Information Rate : 0.5            
##     P-Value [Acc > NIR] : 0.9148         
##                                          
##                   Kappa : -0.0521        
##                                          
##  Mcnemar's Test P-Value : 0.9140         
##                                          
##             Sensitivity : 0.4693         
##             Specificity : 0.4785         
##          Pos Pred Value : 0.4737         
##          Neg Pred Value : 0.4742         
##              Prevalence : 0.5000         
##          Detection Rate : 0.2347         
##    Detection Prevalence : 0.4954         
##       Balanced Accuracy : 0.4739         
##                                          
##        'Positive' Class : 0              
## 

El modelo performa peor que tirar una moneda…

#Decepcion

SVM solo con los features de mano izquierda

Implemento Support Vector Machine general con los features provenientes de la señal de los sensores colocados en la mano izquierda de los sujetos

#Creo un set de datos exclusivamente para correr el SVM
df_SVM_IZQ <- df[,c(5,7,9,11,13,15,23)]
# Particiono los datos
set.seed(3033)
intrain <- createDataPartition(y = df_SVM_IZQ$TARGET, p= 0.7, list = FALSE)
training <- df_SVM_IZQ[intrain,]
testing <- df_SVM_IZQ[-intrain,]
# Preprocesamiento y entrenamiento
trctrl <- trainControl(method = "repeatedcv", number = 10, repeats = 3)
set.seed(3233)
svm_IZQ_Linear <- train(TARGET ~., data = training, method = "svmLinear",
                 trControl=trctrl,
                 preProcess = c("center", "scale"),
                 tuneLength = 10)
svm_IZQ_Linear

## Support Vector Machines with Linear Kernel 
## 
## 1524 samples
##    6 predictor
##    2 classes: '0', '1' 
## 
## Pre-processing: centered (6), scaled (6) 
## Resampling: Cross-Validated (10 fold, repeated 3 times) 
## Summary of sample sizes: 1371, 1372, 1371, 1372, 1372, 1372, ... 
## Resampling results:
## 
##   Accuracy   Kappa      
##   0.4864508  -0.02657604
## 
## Tuning parameter 'C' was held constant at a value of 1

Nuevamente el accuracy está por debajo del 50%. No pruebo con el set de test.

Paso directamente a probar que pasa si entreno el modelo con los datos de la mano derecha.

SVM solo con los features de mano derecha

Implemento Support Vector Machine general con los features provenientes de la señal de los sensores colocados en la mano derecha de los sujetos

#Creo un set de datos exclusivamente para correr el SVM
df_SVM_DER <- df[,c(6,8,10,12,14,16,23)]
# Particiono los datos
set.seed(3033)
intrain <- createDataPartition(y = df_SVM_DER$TARGET, p= 0.7, list = FALSE)
training <- df_SVM_DER[intrain,]
testing <- df_SVM_DER[-intrain,]
# Preprocesamiento y entrenamiento
trctrl <- trainControl(method = "repeatedcv", number = 10, repeats = 3)
set.seed(3233)
svm_DER_Linear <- train(TARGET ~., data = training, method = "svmLinear",
                 trControl=trctrl,
                 preProcess = c("center", "scale"),
                 tuneLength = 10)
svm_DER_Linear

## Support Vector Machines with Linear Kernel 
## 
## 1524 samples
##    6 predictor
##    2 classes: '0', '1' 
## 
## Pre-processing: centered (6), scaled (6) 
## Resampling: Cross-Validated (10 fold, repeated 3 times) 
## Summary of sample sizes: 1371, 1372, 1371, 1372, 1372, 1372, ... 
## Resampling results:
## 
##   Accuracy   Kappa      
##   0.4890394  -0.02194247
## 
## Tuning parameter 'C' was held constant at a value of 1

Con un accuracy de 0.49, dejo de hacer pruebas con todos los datos juntos.

Ahora voy a implementar modelos diferentes para cada sujeto.

Clasificadores por sujeto

Voy a hacer unas pruebas con el sujeto 1 (probar también despues con algunos sujetos más) Quiero analizar la tendencia a la clusterización (grafico en PCA)

# Me quedo solo con los datos desde la columna 5 del sujeto 1
df_sujeto_1 <- df %>% 
  filter(SUJETO == 1)
df_sujeto_1 <- df_sujeto_1[,5:23]
#Escalo los datos (Z-score)
df_sujeto_1[,1:18] <- scale(df_sujeto_1[,1:18])
df_sujeto_1 <- as.data.frame(df_sujeto_1)

Visualizo el PCA para el sujeto 1

TARGET <- df_sujeto_1$TARGET
df_sujeto_1_sin_TARGET <- df_sujeto_1[,-19]
df_sujeto_1_etiquetado_target <- cbind(df_sujeto_1_sin_TARGET, TARGET)
autoplot(prcomp(df_sujeto_1_sin_TARGET), data = df_sujeto_1_etiquetado_target, colour = 'TARGET')

* PAM

#Matriz de distancias
mat_dist <- dist(x = df_sujeto_1, method = "canberra")

# Grafico de Silhouette para PAM con k = 2 (en .jpg aparte)
personal_pam <- pam(mat_dist, 2, diss = T)

# Grafico los clusters con PAM
clusplot(personal_pam) 

* SVM

# Particiono los datos
set.seed(3033)
intrain <- createDataPartition(y = df_sujeto_1$TARGET, p= 0.7, list = FALSE)
training <- df_sujeto_1[intrain,]
testing <- df_sujeto_1[-intrain,]
# Preprocesamiento y entrenamiento
trctrl <- trainControl(method = "repeatedcv", number = 2, repeats = 3)
set.seed(3233)
svm_sujeto_1_Linear <- train(TARGET ~., data = training, method = "svmLinear",
                 trControl=trctrl,
                 preProcess = c("center", "scale"),
                 tuneLength = 10)
svm_sujeto_1_Linear

## Support Vector Machines with Linear Kernel 
## 
## 46 samples
## 18 predictors
##  2 classes: '0', '1' 
## 
## Pre-processing: centered (18), scaled (18) 
## Resampling: Cross-Validated (2 fold, repeated 3 times) 
## Summary of sample sizes: 23, 23, 24, 22, 23, 23, ... 
## Resampling results:
## 
##   Accuracy   Kappa      
##   0.4647288  -0.06723788
## 
## Tuning parameter 'C' was held constant at a value of 1

Accuracy =0.4647

Probar lo mismo pero con menos feautres (SCR_IZQ, SCR_DER, COEFICIENTE DE LATERALIDAD)

#Me quedo solo con las 3 features y el target
df_sujeto_1 <- df_sujeto_1[,c(9,10,13,19)]
#Escalo los datos (Z-score)
df_sujeto_1[,1:3] <- scale(df_sujeto_1[,1:3])
df_sujeto_1 <- as.data.frame(df_sujeto_1)

Visualizo el PCA para el sujeto 1 con features reducidas

TARGET <- df_sujeto_1$TARGET
df_sujeto_1_sin_TARGET <- df_sujeto_1[,-4]
df_sujeto_1_etiquetado_target <- cbind(df_sujeto_1_sin_TARGET, TARGET)
autoplot(prcomp(df_sujeto_1_sin_TARGET), data = df_sujeto_1_etiquetado_target, colour = 'TARGET')

• SVM

# Particiono los datos
set.seed(3033)
intrain <- createDataPartition(y = df_sujeto_1$TARGET, p= 0.7, list = FALSE)
training <- df_sujeto_1[intrain,]
testing <- df_sujeto_1[-intrain,]
# Preprocesamiento y entrenamiento
trctrl <- trainControl(method = "repeatedcv", number = 2, repeats = 3)
set.seed(3233)
svm_sujeto_1_Linear <- train(TARGET ~., data = training, method = "svmLinear",
                 trControl=trctrl,
                 preProcess = c("center", "scale"),
                 tuneLength = 10)
svm_sujeto_1_Linear

## Support Vector Machines with Linear Kernel 
## 
## 46 samples
##  3 predictor
##  2 classes: '0', '1' 
## 
## Pre-processing: centered (3), scaled (3) 
## Resampling: Cross-Validated (2 fold, repeated 3 times) 
## Summary of sample sizes: 23, 23, 24, 22, 23, 23, ... 
## Resampling results:
## 
##   Accuracy   Kappa     
##   0.4482598  -0.0916407
## 
## Tuning parameter 'C' was held constant at a value of 1

Accuracy < 0.50 en el training set.

Me rindo