Proyecto de Estadistica

Vanessa Salazar/ Paralelo: XX

## Warning: package 'knitr' was built under R version 4.0.3
## Warning: package 'rmdformats' was built under R version 4.0.3

Se presenta el siguiente proyecto de Estadistica, en donde se hara un analisis descriptivo, inferencial y modelos de regresion lineal simple del data set: Heart Disease https://archive.ics.uci.edu/ml/datasets/Heart+Disease

Librerias

Se cargan las siguientes librerias usadas en el desarrollo del proyecto:

library(readr)
library(dplyr)
library(fdth)
library(ggcorrplot)
library(plotly)
library(moments)
library(GGally)
library(nortest)

Carga de datos

La siguiente base de datos es cargada desde la web.

data <- read.csv("https://archive.ics.uci.edu/ml/machine-learning-databases/heart-disease/processed.cleveland.data",
                 header= FALSE , sep="," , na.strings = '?')

Cambio de nombres a columnas conforme la informacion de las variables

names(data) <- c( "age", "sex", "cp", "trestbps", "chol","fbs", "restecg","thalach","exang",                   "oldpeak","slope", "ca", "thal", "num")

Estructura de los datos

str(data)
'data.frame':   303 obs. of  14 variables:
 $ age     : num  63 67 67 37 41 56 62 57 63 53 ...
 $ sex     : num  1 1 1 1 0 1 0 0 1 1 ...
 $ cp      : num  1 4 4 3 2 2 4 4 4 4 ...
 $ trestbps: num  145 160 120 130 130 120 140 120 130 140 ...
 $ chol    : num  233 286 229 250 204 236 268 354 254 203 ...
 $ fbs     : num  1 0 0 0 0 0 0 0 0 1 ...
 $ restecg : num  2 2 2 0 2 0 2 0 2 2 ...
 $ thalach : num  150 108 129 187 172 178 160 163 147 155 ...
 $ exang   : num  0 1 1 0 0 0 0 1 0 1 ...
 $ oldpeak : num  2.3 1.5 2.6 3.5 1.4 0.8 3.6 0.6 1.4 3.1 ...
 $ slope   : num  3 2 2 3 1 1 3 1 2 3 ...
 $ ca      : num  0 3 2 0 0 0 2 0 1 0 ...
 $ thal    : num  6 3 7 3 3 3 3 3 7 7 ...
 $ num     : int  0 2 1 0 0 0 3 0 2 1 ...

Como se aprecia hay variables que estan puestas como numero, sin embargo representan una categoria u opcion tal como se muestra a continuacion:

  1. cp: chest pain type

    • Value 1: typical angina

    • Value 2: atypical angina

    • Value 3: non-anginal pain

    • Value 4: asymptomatic

  2. sex: sex

    • Value 0: female

    • Value 1: male

  3. fbs: fasting blood sugar > 120 mg/dl

    • Value 0: False

    • Value 1: True

  4. restecg: resting electrocardiographic results

    • Value 0: normal

    • Value 1: having ST-T wave abnormality (T wave inversions and/or ST elevation or depression of > 0.05 mV)

    • Value 2: showing probable or definite left ventricular hypertrophy by Estes’ criteria

  5. exang: exercise induced angina

    • Value 0: False

    • Value 1: True

  6. slope: the slope of the peak exercise ST segment

    • Value 1: upsloping

    • Value 2: flat

    • Value 3: downsloping

  7. thal

    • Value 3: normal

    • Value 6: fixed defect

    • Value 7: reversable defect

  8. num: diagnosis of heart disease (angiographic disease status)

    • Value 0: < 50% diameter narrowing

    • Value 1: > 50% diameter narrowing

Se procede a cambiar el tipo de datos numerico a caracter para las variables antes descritas:

data[,c("cp","sex","fbs","restecg","exang","slope","thal","num")]<-lapply(data[,c("cp","sex","fbs","restecg","exang","slope","thal","num")] , as.character)

Se comprueba los cambios

str(data)
'data.frame':   303 obs. of  14 variables:
 $ age     : num  63 67 67 37 41 56 62 57 63 53 ...
 $ sex     : chr  "1" "1" "1" "1" ...
 $ cp      : chr  "1" "4" "4" "3" ...
 $ trestbps: num  145 160 120 130 130 120 140 120 130 140 ...
 $ chol    : num  233 286 229 250 204 236 268 354 254 203 ...
 $ fbs     : chr  "1" "0" "0" "0" ...
 $ restecg : chr  "2" "2" "2" "0" ...
 $ thalach : num  150 108 129 187 172 178 160 163 147 155 ...
 $ exang   : chr  "0" "1" "1" "0" ...
 $ oldpeak : num  2.3 1.5 2.6 3.5 1.4 0.8 3.6 0.6 1.4 3.1 ...
 $ slope   : chr  "3" "2" "2" "3" ...
 $ ca      : num  0 3 2 0 0 0 2 0 1 0 ...
 $ thal    : chr  "6" "3" "7" "3" ...
 $ num     : chr  "0" "2" "1" "0" ...

Ahora la variable num, tiene valor de 0 a 4, en donde 0 significa que el corazon esta bien, mientras que el resto de valores enfermedad cardiaca, por lo que cambiamos a solo dos categorias “heart disease” o “no heart disease”

En la variable Thal, hay valores con NA por lo que se cambia la etiqueta a “No hay info”

data$num<-ifelse(data$num=="0","no heart disease","heart disease")
data$thal<-ifelse(is.na(data$thal),"No hay info",data$thal)

Se comprueba cambio de los valores a las 2 opciones

head(data,3)
  age sex cp trestbps chol fbs restecg thalach exang oldpeak slope ca thal
1  63   1  1      145  233   1       2     150     0     2.3     3  0    6
2  67   1  4      160  286   0       2     108     1     1.5     2  3    3
3  67   1  4      120  229   0       2     129     1     2.6     2  2    7
               num
1 no heart disease
2    heart disease
3    heart disease

Estadistica descriptiva univariante

Variables Cualitativas

Sex

Graficas

sex_db<- ggplot(data) + aes(x = sex) +
         geom_bar(fill = "#0c4c8a") + 
         labs(title ="Diagrama de Barra de Sex\n", x="Sex", y="Frecuencia") +
         scale_x_discrete(NULL)
ggplotly(sex_db)
sex_dc<- plot_ly(type='pie', labels=c("0","1"), values=c(97,206), 
               textinfo='label+percent',
               insidetextorientation='radial') %>%
       layout(title = "Diagrama de Barra Sex\n")
sex_dc

CP

Graficas

cp_db<- ggplot(data) + aes(x = cp) +
         geom_bar(fill = "#0c4c8a") +
         labs(title ="Diagrama de Barra de CP\n", x="CP", y="Frecuencia") +
         scale_x_discrete(NULL)
ggplotly(cp_db)
cp_dc<- plot_ly(type='pie', labels=c("1","2","3","4"), values=c(23,50,86,144), 
               textinfo='label+percent',
               insidetextorientation='radial') %>%
       layout(title = "Diagrama de Barra CP\n")
cp_dc

Fbs

Graficas

fbs_db<- ggplot(data) + aes(x = fbs) +
         geom_bar(fill = "#0c4c8a") +
         labs(title ="Diagrama de Barra de Fbs\n", x="Fbs", y="Frecuencia") +
         scale_x_discrete(NULL)
ggplotly(fbs_db)
fbs_dc<- plot_ly(type='pie', labels=c("0","1"), values=c(258,45), 
               textinfo='label+percent',
               insidetextorientation='radial') %>%
       layout(title = "Diagrama de Barra Fbs\n")
fbs_dc

Restecg

Graficas

res_db<- ggplot(data) + aes(x = restecg) +
         geom_bar(fill = "#0c4c8a") +
         labs(title ="Diagrama de Barra de Restecg\n", x="Restecg", y="Frecuencia") +
         scale_x_discrete(NULL)
ggplotly(res_db)
res_dc<- plot_ly(type='pie', labels=c("0","1","2"), values=c(151,4,148), 
               textinfo='label+percent',
               insidetextorientation='radial') %>%
       layout(title = "Diagrama de Barra Restecg\n")
res_dc

Exang

Graficas

exang_db<- ggplot(data) + aes(x = exang) +
           geom_bar(fill = "#0c4c8a") +
           labs(title ="Diagrama de Barra de Exang\n", x="Exang", y="Frecuencia") +
           scale_x_discrete(NULL)
ggplotly(exang_db)
exang_dc<- plot_ly(type='pie', labels=c("0","1"), values=c(204,99), 
               textinfo='label+percent',
               insidetextorientation='radial') %>%
       layout(title = "Diagrama de Barra Exang\n")
exang_dc

Slope

Graficas

slope_db<-ggplot(data) + aes(x = slope) +
          geom_bar(fill = "#0c4c8a") +
          labs(title ="Diagrama de Barra de Slope\n", x="Slope", y="Frecuencia") +
          scale_x_discrete(NULL)
ggplotly(slope_db)
slope_dc<-plot_ly(type='pie', labels=c("1","2","3"), values=c(142,140,21), 
               textinfo='label+percent',
               insidetextorientation='radial') %>%
       layout(title = "Diagrama de Barra Slope\n")
slope_dc

Thal

Graficas

thal_db<-ggplot(data) + aes(x = thal) +
          geom_bar(fill = "#0c4c8a") +
          labs(title ="Diagrama de Barra de Thal\n", x="Thal", y="Frecuencia") +
          scale_x_discrete(NULL)
ggplotly(thal_db)
thal_dc<-plot_ly(type='pie', labels=c("3","6","7","No hay info"), values=c(166,18,117,2), 
               textinfo='label+percent',
               insidetextorientation='radial') %>%
       layout(title = "Diagrama de Barra Thal\n")
thal_dc

Num

Graficas

num_db<-ggplot(data) + aes(x = num) +
          geom_bar(fill = "#0c4c8a") +
          labs(title ="Diagrama de Barra de Num\n", x="Num", y="Frecuencia") +
          scale_x_discrete(NULL)
ggplotly(num_db)
num_dc<-plot_ly(type='pie', labels=c("heart disease", "no heartdisease"), values=c(139,164), 
               textinfo='label+percent',
               insidetextorientation='radial') %>%
       layout(title = "Diagrama de Barra Num\n")
num_dc

Variables Cuantitativas

Age

Medidas descriptivas

Minimo Maximo Primer_cuartil Tercer_cuartil Mediana Media Desviacion Curtosis Sesgo
29 77 48 61 56 54.439 9.039 2.465 -0.208

Tabla de frecuencia

Clase Frec abs Frec rel Frec abs acum Frec rel acum
[25,31) 1 0.00 1 0.33
[31,37) 6 0.02 7 2.31
[37,43) 29 0.10 36 11.88
[43,49) 46 0.15 82 27.06
[49,55) 61 0.20 143 47.19
[55,61) 81 0.27 224 73.93
[61,67) 53 0.17 277 91.42
[67,73) 23 0.08 300 99.01
[73,79) 3 0.01 303 100.00

Histograma

Diagrama de cajas

Trestbps

Medidas descriptivas

Minimo Maximo Primer_cuartil Tercer_cuartil Mediana Media Desviacion Curtosis Sesgo
94 200 120 140 130 131.69 17.6 3.846 0.703

Tabla de frecuencia

Clase Frec abs Frec rel Frec abs acum Frec rel acum
[90,105) 10 0.03 10 3.30
[105,120) 50 0.17 60 19.80
[120,135) 124 0.41 184 60.73
[135,150) 67 0.22 251 82.84
[150,165) 38 0.13 289 95.38
[165,180) 9 0.03 298 98.35
[180,195) 4 0.01 302 99.67
[195,210) 1 0.00 303 100.00

Histograma

Diagrama de cajas

Chol

Medidas descriptivas

Minimo Maximo Primer_cuartil Tercer_cuartil Mediana Media Desviacion Curtosis Sesgo
126 564 211 275 241 246.693 51.777 7.398 1.13

Tabla de frecuencia

Clase Frec abs Frec rel Frec abs acum Frec rel acum
[125,190) 31 0.10 31 10.23
[190,255) 153 0.50 184 60.73
[255,320) 98 0.32 282 93.07
[320,385) 16 0.05 298 98.35
[385,450) 4 0.01 302 99.67
[450,515) 0 0.00 302 99.67
[515,580) 1 0.00 303 100.00

Histograma

Diagrama de cajas

Thalach

Medidas descriptivas

Minimo Maximo Primer_cuartil Tercer_cuartil Mediana Media Desviacion Curtosis Sesgo
71 202 133.5 166 153 149.607 22.875 2.928 -0.535

Tabla de frecuencia

Clase Frec abs Frec rel Frec abs acum Frec rel acum
[70,95) 3 0.01 3 0.99
[95,120) 31 0.10 34 11.22
[120,145) 80 0.26 114 37.62
[145,170) 127 0.42 241 79.54
[170,195) 60 0.20 301 99.34
[195,220) 2 0.01 303 100.00

Histograma

Diagrama de cajas

Oldpeak

Medidas descriptivas

Minimo Maximo Primer_cuartil Tercer_cuartil Mediana Media Desviacion Curtosis Sesgo
0 6.2 0 1.6 0.8 1.04 1.161 4.53 1.263

Tabla de frecuencia

Clase Frec abs Frec rel Frec abs acum Frec rel acum
[0,0.8) 150 0.50 150 49.50
[0.8,1.6) 68 0.22 218 71.95
[1.6,2.4) 45 0.15 263 86.80
[2.4,3.2) 21 0.07 284 93.73
[3.2,4) 11 0.04 295 97.36
[4,4.8) 6 0.02 301 99.34
[4.8,5.6) 1 0.00 302 99.67
[5.6,6.4) 1 0.00 303 100.00

Histograma

Diagrama de cajas

Ca

Medidas descriptivas

Minimo Maximo Primer_cuartil Tercer_cuartil Mediana Media Desviacion Curtosis Sesgo
0 3 0 1 0 0.672 0.937 3.235 1.183

Tabla de frecuencia

Clase Frec abs Frec rel Frec abs acum Frec rel acum
[0,1) 176 0.59 176 58.86
[1,2) 65 0.22 241 80.60
[2,3) 38 0.13 279 93.31
[3,4) 20 0.07 299 100.00

Histograma

Diagrama de cajas

Estadistica descriptiva bivariante o multivariante

Matriz de correlacion

Correlacion de Pearson
age trestbps chol thalach oldpeak ca
age 1.000 0.291 0.203 -0.392 0.197 0.363
trestbps 0.291 1.000 0.132 -0.048 0.192 0.099
chol 0.203 0.132 1.000 0.002 0.040 0.119
thalach -0.392 -0.048 0.002 1.000 -0.341 -0.264
oldpeak 0.197 0.192 0.040 -0.341 1.000 0.296
ca 0.363 0.099 0.119 -0.264 0.296 1.000

Matriz de diagramas de dispersion

Boxplot por categorias

Estadistica Inferencial

Se presentan 4 constraste de hipotesis:

Contraste de hipotesis 1

Los hombres y mujeres tienen la misma edad en promedio?

Primero debemos comprobar si las varianzas aunque son desconocidas son iguales o diferentes.

Ho: Var 1 = Var 2 vs Ha: Var 1 != Var 2

Por lo que se realiza el test de varianzas


    F test to compare two variances

data:  edad_hombres$age and edad_mujeres$age
F = 0.88933, num df = 205, denom df = 96, p-value = 0.487
alternative hypothesis: true ratio of variances is not equal to 1
95 percent confidence interval:
 0.623388 1.241458
sample estimates:
ratio of variances 
         0.8893321

Existe evidencia estadistica al 95% de confianza, que no se rechaza Ho, dado que el valor p es mayor al 5% de significancia, por lo tanto ahora se escoge el estadistico T cuando el caso es con varianzas iguales.

Contraste de hipotesis 2

Se procede a continuar con el test antes planteado

Ho: Media 1 = Media 2 vs Ha: Media 1 != Media 2


    Two Sample t-test

data:  edad_hombres$age and edad_mujeres$age
t = -1.7004, df = 301, p-value = 0.09009
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -4.0701726  0.2967765
sample estimates:
mean of x mean of y 
 53.83495  55.72165

Existe evidencia estadistica al 95% de confianza, en no rechazar Ho, dado que el valor p cae en zona de rechazo .

No se puede afirmar que la edad es diferente entre hombres y mujeres.

Contraste de hipotesis 3

La proporcion de aquellos que no cumplen que el azucar en ayunas >120 mg/dl, es superior al 90% ?

Se procede a plantear las hipotesis

Ho: Proporcion = 0.9 vs Ha: Proporcion > 0.9

Se procede con el calculo

  FBS
0 258
1  45

    1-sample proportions test with continuity correction

data:  258 out of 303, null probability 0.9
X-squared = 7.3942, df = 1, p-value = 0.9967
alternative hypothesis: true p is greater than 0.9
95 percent confidence interval:
 0.8129898 1.0000000
sample estimates:
        p 
0.8514851

Existe evidencia estadistica al 95% de confianza, en no rechazar Ho, dado que el valor p cae en zona de no rechazo .

No se puede afirmar que la proporacion de aquellos que no cumplen que el azucar en ayunas >120 mg/dl, es superior al 90%.

Contraste de hipotesis 4

El segmento st cuando es horizontal, su proporcion es 50% ?

Ho: Proporcion = 0.5 vs Ha: Proporcion != 0.9

Se procede con el calculo

  Slope
1   142
2   140
3    21

    1-sample proportions test with continuity correction

data:  140 out of 303, null probability 0.5
X-squared = 1.5974, df = 1, p-value = 0.2063
alternative hypothesis: true p is not equal to 0.5
95 percent confidence interval:
 0.4051205 0.5199500
sample estimates:
        p 
0.4620462

Existe evidencia estadistica al 95% de confianza, en no rechazar Ho, dado que el valor p cae en zona de no rechazo .

No se puede afirmar que la proporacion que el segmento st cuando es horizontal, su proporcion es 50%.

Tabla de contigencias

Contraste de hipotesis 5

Existe relacion entre el sexo de una persona con los tipos de segmento ST ?

Ho: Sex es Independiente de Slope vs Ha: Sex no es Independiente de Slope

Se procede con el calculo realizando la tabla cruzada:

   
     0  1
  1 47 95
  2 45 95
  3  5 16

    Pearson's Chi-squared test

data:  tabla_con_1
X-squared = 0.7273, df = 2, p-value = 0.6951

Contraste de hipotesis 6

Existe relacion entre el problema cardiaco de una persona con los tipos de segmento ST ?

Ho: Num es Independiente de Slope vs Ha: Num no es Independiente de Slope

Se procede con el calculo realizando la tabla cruzada:

                  
                     1   2   3
  heart disease     36  91  12
  no heart disease 106  49   9

    Pearson's Chi-squared test

data:  tabla_con_2
X-squared = 45.785, df = 2, p-value = 1.143e-10

Pruebas de bondad de ajuste

Metodo Chi Cuadrado

Metodo Kolmogorov-Smirnov

La edad tiene un comportamiento de distribucion Normal ?

Ho: Age tiene un comportamiento de distribucion Normal

vs

Ha: Age no tiene un comportamiento de distribucion Normal

Se aplica el test de KS


    Lilliefors (Kolmogorov-Smirnov) normality test

data:  data$age
D = 0.07689, p-value = 0.0001812

Por lo tanto al 95% de confianza, se rechaza Ho, la variable Edad no sigue un comportamiento de tipo Lineal

Regresion lineal

El modelo de regresion lineal simple nos indica que se tiene la siguiente expresion:

Ecuacion de la recta

\[ f(x)=y= mx+b \]

Ecuacion del modelo propuesto de regresion lineal

\[ \hat{y}=\hat b_{1}(x)+\hat b_{0} \]

Se procede a realizar el calculo de los estimadores de la recta, para:

Modelo propuesto 1

Variable dependiente: “ca” = y

Variable independiente: “age” = x

Por lo tanto se calcula:


Call:
lm(formula = ca ~ age, data = data)

Coefficients:
(Intercept)          age  
   -1.38245      0.03768

Por lo que la ecuacion del modelo propuesto quedaria:

\[ \hat{y}=0.03768(x)-1.38245 \]

Modelo propuesto 2

Variable dependiente: “thalach” = y

Variable independiente: “age” = x

Por lo tanto se calcula:


Call:
lm(formula = thalach ~ age, data = data)

Coefficients:
(Intercept)          age  
   203.8634      -0.9966

Por lo que la ecuacion del modelo propuesto quedaria:

\[ \hat{y}=-0,9966(x)+203.8634 \]

Investigacion sobre el tema y el software usado

bla bla bla bla

Conclusiones

bla bla bla bla