Introducción

Cifosis es una afección de la columna vertebral que se caracteriza por una curvatura hacia adelante de la parte superior de la espalda. En la base de datos denominada Kyphosis se registraron 81 observaciones a pacientes menores de 12 años que fueron intervenidos quirúrgicamente para corregir esta enfermedad indicando si los pacientes desarrollan nuevamente la enfermedad después de la cirugía.

En este informe se presenta un análisis del conjunto de datos “Kyphosis” con objetivo principal de estudiar los factores que podrían estar relacionados con la aparición de la afección de la columna vertebral, así como la relación con las variables del set de datos. Para lograr este objetivo, se aplica la técnica de análisis discriminante con el fin de clasificar o entender qué variables discriminan el estado de presentar o no nuevamente la afección cifosis.

En primer lugar, se proporciona un análisis exploratorio, sobre la descripción de los datos, el número de observaciones, tipo de variables y distribución de estas. Luego se presenta un análisis de correlación entre variables, donde se evidencia una relación negativa y moderadamente fuerte entre el número de vértebras involucradas en la cirugía y la primera vértebra en la que se inicia la operación. Finalmente, se selecciona un modelo de análisis discriminante que clasifica correctamente un 94% de los casos etiquetados como “absent” y un 66% de los casos etiquetados como “present”.

Análisis exploratorio del set de datos “kyphosis”

El set de datos contiene 81 observaciones con 4 variables:

library(MASS)
library(rpart)
data(kyphosis)
summary(kyphosis)
##     Kyphosis       Age             Number           Start      
##  absent :64   Min.   :  1.00   Min.   : 2.000   Min.   : 1.00  
##  present:17   1st Qu.: 26.00   1st Qu.: 3.000   1st Qu.: 9.00  
##               Median : 87.00   Median : 4.000   Median :13.00  
##               Mean   : 83.65   Mean   : 4.049   Mean   :11.49  
##               3rd Qu.:130.00   3rd Qu.: 5.000   3rd Qu.:16.00  
##               Max.   :206.00   Max.   :10.000   Max.   :18.00

Se evidencia que la variable objetivo de este estudio “kyphosis” es una variable binaria con opción de respuesta absent y present, donde 64 de los 81 niños en el conjunto de datos no presentan cifosis espinal después del tratamiento. La edad de los niños en el momento del tratamiento varía de 1 a 206 meses, con una media de 83,65 meses, el número de vértebras involucradas en la operación oscila entre 2 y 10, con una media de 4,049. Además, el número de la vértebra en la que se inició la operación oscila entre la posición 1 y 18, con una media de 11.49.

Para visualizar la distribución de los datos de manera gráfica y observar cómo se agrupan los valores se realiza un histograma para cada variable:

Análisis univariable

hist(kyphosis$Age, col="black", main= "Histograma de la edad en meses al momento de la cirugía", xlab="Edad", ylab="Frecuencia")

hist(kyphosis$Number, col = "black", main = "Histograma número de la vértebra del inicio de la cirugía", xlab="Número de vértebras intervenidas", ylab="Frecuencia")

hist(kyphosis$Start, col="black", main = "Número de la primera vertebra intervenida en la cirugía", xlab="Número de la primera vértebra", ylab="Frecuencia")

En los gráficos anteriores se identifica identificar la frecuencia de los valores de la variable y su distribución en el conjunto de datos.En el histograma correspondiente a la variable edad se observa un pico en la frecuencia de los datos de los primeros meses de vida de los pacientes.

Al analizar los histogramas de las variables del conjunto de datos, podemos observar que la variable “Age” tiene una distribución aproximadamente normal, pero con un pico o frecuencia más alta en los primeros meses de edad, lo que indica que puede haber una mayor concentración de casos de cifosis en ese rango de edad. Por otro lado, en el histograma de la variable “Number”, podemos ver una distribución sesgada a la derecha, lo que sugiere que la mayoría de los pacientes tienen un número bajo de vértebras involucradas en la intervención quirúrgica. Finalmente, el histograma de la variable “Start” muestra una distribución sesgada a la izquierda, lo que sugiere que el número de la vértebra en la que se inició la cirugía es mayor.

Relaciones entre las variables

Con el objetivo de determinar si existe una asociación entre las variables y la fuerza y dirección de esta asociación, se genera una matriz de correlación entre las variables excluyendo la variable 1 (Kyphosis), dado que es de tipo binaria. Cabe resaltar que un valor de correlación cercano a 1 indica unacorrelación positiva fuerte entre dos variables, lo que significa que cuando una variable aumenta, la otra también tiende a aumentar, por el contrario, un valor de correlación cercano a -1 indica una correlación negativa fuerte entre dos variables, lo que significa que cuando una variable aumenta, la otra tiende a disminuir.

cor(kyphosis[,2:4])
##                Age     Number       Start
## Age     1.00000000 -0.0166875  0.05782789
## Number -0.01668750  1.0000000 -0.42509875
## Start   0.05782789 -0.4250988  1.00000000
library(PerformanceAnalytics)
## Loading required package: xts
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## ################################### WARNING ###################################
## # We noticed you have dplyr installed. The dplyr lag() function breaks how    #
## # base R's lag() function is supposed to work, which breaks lag(my_xts).      #
## #                                                                             #
## # If you call library(dplyr) later in this session, then calls to lag(my_xts) #
## # that you enter or source() into this session won't work correctly.          #
## #                                                                             #
## # All package code is unaffected because it is protected by the R namespace   #
## # mechanism.                                                                  #
## #                                                                             #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
## #                                                                             #
## # You can use stats::lag() to make sure you're not using dplyr::lag(), or you #
## # can add conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop   #
## # dplyr from breaking base R's lag() function.                                #
## ################################### WARNING ###################################
## 
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
## 
##     legend
chart.Correlation(kyphosis[-1], histogram = TRUE, method = "pearson")

Se observa que las variables “Age” y “Start” tienen un coeficiente de correlación positivo, lo que sugiere que existe una relación positiva entre la edad del paciente y la vértebra en la que se inició la intervención quirúrgica; sin embargo, la relación es bastante débil con un valor de correlación de 0,0578. Por otro lado, la variable “Number” muestra una correlación negativa y fuerte con “Start”, lo que sugiere que a medida que aumenta el número de vértebras involucradas en la cirugía, la vértebra en la que se inicia la operación tiende a disminuir. El coeficiente de correlación es -0.4251, lo que sugiere una relación moderadamente fuerte.

Análisis discriminante

Con el fin de determinar la variabilidad que hay entre los grupos correspondientes a “absent” y “present” de la variable kyphosis e indica si el paciente presenta cifosis después de la cirugía, se realizar un análisis discriminante en el conjunto de datos; utilizando la opción de validación cruzada para evaluar la capacidad predictiva del modelo y reducir el riesgo de sobreajuste.

library(MASS)
fit<-lda(kyphosis$Kyphosis ~ kyphosis$Age+kyphosis$Number+kyphosis$Start, na.action = "na.omit", CV=TRUE)
tabla<- table(real=kyphosis$Kyphosis, predicha=fit$class) # matriz de confusión
tabla
##          predicha
## real      absent present
##   absent      58       6
##   present     10       7
diag(prop.table(tabla,1))
##    absent   present 
## 0.9062500 0.4117647

A partir de los resultados obtenidos de la matriz de confusión que evalúa la precisión del modelo de clasificación, donde se observa la cantidad de verdaderos positivos (presentes clasificados como presentes), verdaderos negativos (ausentes clasificados como ausentes), falsos positivos (ausentes clasificados como presentes) y falsos negativos (presentes clasificados como ausentes) que se obtienen al utilizar el modelo.

Para el grupo “absent” 58 casos fueron clasificados correctamente y para el grupo “present” 7 casos fueron clasificados de manera exitosa.Sin embargo, el modelo también identificó erróneamente 6 casos como “present” cuando eran en realidad “absent”, y 10 casos como “absent” cuando eran en realidad “present”.

Así mismo, el modelo tiene una tasa de precisión del 90.6% para la clase “absent”, lo que indica que es bastante preciso para predecir casos de “absent”. Por otro lado, la tasa de precisión para la clase “present” es del 41.2%, lo que sugiere que el modelo no es tan preciso para predecir casos del grupo “present”.

Lo anterior indica la necesidad de ajustar el modelo para mejorar su capacidad predictiva, asignando un 70% a datos de entrenamiento del modelo y el restante a datos de validación.

set.seed(54)
n<-dim(kyphosis)[1]
  p<-0.70
  train <- sample(n,(p*n), replace=FALSE)
  validation <-  setdiff(1:n, train)
set.seed(54)
fit2<-lda(Kyphosis ~ Age+Number+Start, data=kyphosis, CV=FALSE, subset = train)
pred<-predict(fit2, kyphosis[validation,])

Estimación de probabilidad de aciertos del modelo:

set.seed(54)
tabla1<-table(kyphosis$Kyphosis[validation],pred$class);tabla1
##          
##           absent present
##   absent      20       0
##   present      3       2

A partir del resultado de la matriz de confusión, se evidencia que el modelo clasificó correctamente 20 observaciones en la clase “absent” y 2 observaciones en la clase “present”. También se puede observar que el modelo no clasificó incorrectamente ninguna observación de la clase “absent” pero clasificó 3 observaciones de la clase “present” como “absent”.

Así mismo, se calcula la proporción de observaciones en el conjunto de datos de validación (validation) para las que el modelo no predice correctamente el grupo al que pertenecían. Evidenciando que el modelo tiene una media de error del 0.12.

set.seed(54)
mean(pred$class !=kyphosis$Kyphosis[validation])
## [1] 0.12
# Proporción de aciertos en cada clase
set.seed(54)
diag (prop.table (tabla1, 1))
##  absent present 
##     1.0     0.4

Se observa que del modelo tiene una tasa de precisión del 100% para el grupo”absent”, y del 40% para el grupo “present”, proporciones similares al modelo anterior, donde se continúa evidenciando una buena precisión para predecir casos de “absent” y no tan alta precisión para el grupo “present”. Lo que indica la necesidad de ajustar los parámetros de regularización en el modelo especificando la probabilidad previa de cada grupo en el estudio mediante el parámetro “prior”.

set.seed(522)
n<-dim(kyphosis)[1]
  train1 <- sample(n,(p*n), replace=FALSE)
  validation1 <-  setdiff(1:n, train1)
fit3<-lda(Kyphosis ~ Age+Number+Start, data=kyphosis, CV=FALSE, subset = train1, prior=c(0.70, 0.30)) 
set.seed(522)
pred2<-predict(fit3, kyphosis[validation1,])
tabla2<-table(kyphosis$Kyphosis[validation1],pred2$class);tabla2
##          
##           absent present
##   absent      18       1
##   present      2       4

La matriz de confusión evidencia que el modelo clasificó correctamente 18 casos del grupo “absent” y 4 casos del grupo “present”, aunque se cometio 1 error de clasificación en el grupo “absent” y 4 errores en la clase “present”. Se evidencia que el modelo clasifica con precisión un 94% para el grupo “absent” y 66% para el grupo “present”.

set.seed(522)
diag (prop.table (tabla2, 1))
##    absent   present 
## 0.9473684 0.6666667

Después de evaluar diferentes modelos de clasificación, se ha encontrado que el modelo que utiliza el análisis discriminante con ajuste de parámetros de regularización y una tasa priori específica es el que tiene un mejor desempeño en la predicción de la variable de interés.Además, al analizar la matriz de confusión, se observa que las tasas de verdaderos positivoslos grupos de la variable de interés son razonablemente altas y equilibradas, lo que indica que el modelo tiene una buena capacidad de discriminación.

set.seed(522)
fit3
## Call:
## lda(Kyphosis ~ Age + Number + Start, data = kyphosis, CV = FALSE, 
##     prior = c(0.7, 0.3), subset = train1)
## 
## Prior probabilities of groups:
##  absent present 
##     0.7     0.3 
## 
## Group means:
##               Age   Number     Start
## absent   86.84444 3.777778 12.288889
## present 100.54545 4.636364  7.636364
## 
## Coefficients of linear discriminants:
##                 LD1
## Age     0.005219094
## Number  0.170066809
## Start  -0.186839561

A partir del análisis discriminante lineal se evidencia el valor promedio de cada variable para cada uno de los dos grupos, donde para el grupo “present” se registra:

Por otra parte, para el grupo etiquetado como “absent” se registra:

Por otra parte los valores de los coeficientes indican la importancia de cada variable para distinguir entre los dos grupos, de manera que, el coeficiente para “Age” es 0.00521, lo que sugiere que esta variable tiene un impacto relativamente pequeño en la diferenciación de los grupos. Por otro lado, el coeficiente para la variable “Number” es 0.17006, lo que indica que esta variable tiene un mayor impacto en la diferenciación de los grupos. Finalmente, el coeficiente para “Start” es -0.1868 lo que sugiere que esta variable tiene un impacto negativo en la diferenciación de los grupos, es decir, que los valores más altos de esta variable están asociados con el grupo “absent”.

plot(fit3)

library(ggplot2)
ggplot(kyphosis, aes(x = kyphosis$Start, y = kyphosis$Number, color = Kyphosis, shape = Kyphosis)) +
  geom_point(size = 2) +
  scale_color_manual(values = c("red", "blue")) +
  scale_shape_manual(values = c(16, 17)) +
  labs(x = "Start", y = "Número", color = "Grupo", shape = "Grupo") +
  theme(plot.title = element_text(hjust = 0.5))

Conclusiones

A partir del análisis realizado en la base de datos kyphosis se concluye: