R Notebook

This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

Try executing this chunk by clicking the Run button within the chunk or by placing your cursor inside it and pressing Cmd+Shift+Enter.

La siguiente base de datos habla sobre las muertes en cirugía en un hospital. Hay más de 70 variables que fueron estudiadas que podían influir en la muerte de un paciente, sin embargo solo se seleccionaron algunas para poder predecir si un paciente puede morir o no en cirugía de acuerdo a sus características.

datos <- read_csv("/Users/ander/Downloads/mrk0.csv")

Rows: 50240 Columns: 106── Column specification ─────────────────────────────────────────────────────────────────
Delimiter: ","
dbl (106): hospital_death, age, bmi, ethnicity, gender, height, hospital_admit_source...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

datos <- select(datos, hospital_death, age, bmi, gender, height, weight )

La base de datos tenía más de 50,000 filas. Solo se agarraron 100 para este algoritmo de prueba por cuestiones de procesamiento.

datos <- head(datos, 100)

datos

# Estandarización y visualización de datos
datos$age <- (datos$age - min(datos$age)) / (max(datos$age) - min(datos$age))
hist(datos$age)

datos$bmi <- (datos$bmi - min(datos$bmi)) / (max(datos$bmi) - min(datos$bmi))
hist(datos$bmi)

datos$gender <- (datos$gender - min(datos$gender)) / (max(datos$gender) - min(datos$gender))
hist(datos$gender)

datos$height <- (datos$height - min(datos$height)) / (max(datos$height) - min(datos$height))
hist(datos$height)

datos$weight <- (datos$weight - min(datos$weight)) / (max(datos$weight) - min(datos$weight))
hist(datos$weight)

# training aleatorio
set.seed(37)
inp <- sample(2, nrow(datos), replace = TRUE, prob = c(0.7, 0.3)) # 70% train 30% test
training_data <- datos[inp==1, ]
test_data <- datos[inp==2, ]

training_data

#Red neuronal
set.seed(333) #hidden es la cantidad de neuronas en la capa escondida, stepmax es que tantos pasos hará


n <- neuralnet(hospital_death~ . , #Decimos cuál es la y y cuáles son x 
               data = training_data, # información para crear la red 
               hidden = 3, # capas escondidas o en medio 
               # o puede ser hidden = c(3,2), --> tienes una fila hidden de tres y otra de 2 
               err.fct = "ce", # Tipo de error 
               linear.output = FALSE, 
               lifesign = 'full',
               rep = 2, # va a hacer dos veces lo de 800,000
               algorithm = "rprop+",
               stepmax = 200000) # Cuántos procesameintos de CPU va a utilizar --> Súper

hidden: 3    thresh: 0.01    rep: 1/2    steps:    1000 min thresh: 0.0513176851684538
                                                   2000 min thresh: 0.0211325124915538
                                                   2523 error: 4.13908  time: 0.71 secs
hidden: 3    thresh: 0.01    rep: 2/2    steps:    1000 min thresh: 0.0990185490874353
                                                   2000 min thresh: 0.0908582993673342
                                                   3000 min thresh: 0.0453100284895061
                                                   4000 min thresh: 0.0183738033612628
                                                   4708 error: 0.0118   time: 0.17 secs

Como lo indica la red neuronal al final, el grado de error es muy bajo, lo que habla de que puede ser un buen modelo de predicción

plot(n, rep = 1)

n$result.matrix

                                     [,1]          [,2]
error                        4.139083e+00  1.180024e-02
reached.threshold            9.874308e-03  9.520511e-03
steps                        2.523000e+03  4.708000e+03
Intercept.to.1layhid1       -7.122948e-02 -1.473687e+00
age.to.1layhid1              1.406182e+01  8.415427e+00
bmi.to.1layhid1              9.733135e-01 -4.424890e+00
gender.to.1layhid1          -7.306990e+00 -1.131577e+00
height.to.1layhid1           5.908567e-01 -1.779182e+00
weight.to.1layhid1          -4.619967e+00 -1.037482e+01
Intercept.to.1layhid2       -2.135161e+00 -3.020322e+00
age.to.1layhid2              2.991330e+01 -1.078558e+01
bmi.to.1layhid2             -1.413562e+00  6.155407e+00
gender.to.1layhid2          -1.448467e+01  1.544272e+00
height.to.1layhid2           2.511397e+00  2.972897e+00
weight.to.1layhid2          -2.633483e+01  1.506173e+01
Intercept.to.1layhid3       -6.652525e+00 -3.188152e-01
age.to.1layhid3             -1.728165e+01  2.346808e+01
bmi.to.1layhid3              5.867970e+00 -2.994696e+00
gender.to.1layhid3           5.599826e+00 -6.389445e+01
height.to.1layhid3           7.692730e+00  4.594788e+01
weight.to.1layhid3           2.318704e+01  6.520218e+01
Intercept.to.hospital_death  1.784738e+01  9.521330e+01
1layhid1.to.hospital_death  -1.413127e+00 -2.086324e+02
1layhid2.to.hospital_death  -1.939548e+01 -3.734334e+02
1layhid3.to.hospital_death  -6.595448e+01 -1.107419e+01

output <- neuralnet::compute(n, rep = 1, training_data[, -1])
head(output$net.result)

             [,1]
[1,] 9.070221e-19
[2,] 4.901214e-02
[3,] 1.037817e-21
[4,] 4.919891e-02
[5,] 1.234759e-21
[6,] 4.900811e-02

head(training_data[1, ])

# Matriz de confusión 
output <- neuralnet::compute(n, rep = 1, training_data[, -1])
p1 <- output$net.result
pred1 <- ifelse(p1 > 0.5, 1, 0)
tab1 <- table(pred1[,1], training_data[,1]$hospital_death)
tab1

   
     0  1
  0 67  1
  1  0  2

De acuerdo con la matriz de confusión, el modelo solo tuvo un falso negativo (es decir, sólo se equivocó en uno), por lo que se puede decir que tiene un grado de error muy bajo

#Porcentaje de error total (usando datos de la matrix de confusión)
1 - sum(diag(tab1)) / sum(tab1)

[1] 0.01428571