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.

# Instalar paquetes 

library(foreign)
library(ggplot2)
library(MASS)
library(openxlsx)
library(tidyverse)
library(dplyr)

La base de datos habla de el nivel de enfermedad crónica pulmonar que tienen las personas analizadas y las características de estas personas. Con esta base de datos se puede hacer una relación de qué características influyen más para que una enfermedad crónica pulmonar afecte fuerte o no tan fuerte.

Datos = read.csv("/Users/ander/Downloads/cancer patient data sets.csv")
head(Datos)
view(Datos)

Para esta parte de los datos, la columna a predecir la pasamos a variables de 0 y 1, de tal forma que solo hubieran dos categorías: enfermedad leve y enfermedad grave

Datos$chronic.Lung.Disease <- as.numeric(as.character(Datos$chronic.Lung.Disease))

Datos$chronic.Lung.Disease <- ifelse(Datos$chronic.Lung.Disease >= 1 & Datos$chronic.Lung.Disease <= 4, 0,
                        ifelse(Datos$chronic.Lung.Disease >= 5 & Datos$chronic.Lung.Disease <= 7, 1, Datos$chronic.Lung.Disease))

Los datos estaban en formato texto, por lo que para hacer el algoritmo era necesario pasar todos a numéricos

Datos[] <- lapply(Datos, as.numeric)
Warning: NAs introduced by coercionWarning: NAs introduced by coercion

Aquí solo se seleccionaron las columnas que se iban a utilizar para el modelo

DatosS = select_(Datos, "index", "Age", "Gender", "Air.Pollution", "Alcohol.use", "Genetic.Risk", "chronic.Lung.Disease")
Warning: `select_()` was deprecated in dplyr 0.7.0.
Please use `select()` instead.
DatosS
# Entrenamiento de datos 

DatosS$chronic.Lung.Disease <- factor(DatosS$chronic.Lung.Disease, levels = c(0,1), labels = c("Leve", "Fuerte")) #factor significa darle jerarquía a los datos 

dis=lda(chronic.Lung.Disease~Age+Gender+Air.Pollution+Alcohol.use+Genetic.Risk, data=DatosS,prior=c(0.5,0.5)) # No estamos tomando en cuenta todas las variables
dis
Call:
lda(chronic.Lung.Disease ~ Age + Gender + Air.Pollution + Alcohol.use + 
    Genetic.Risk, data = DatosS, prior = c(0.5, 0.5))

Prior probabilities of groups:
  Leve Fuerte 
   0.5    0.5 

Group means:
            Age   Gender Air.Pollution Alcohol.use Genetic.Risk
Leve   35.82574 1.506931      2.677228    2.613861     2.857426
Fuerte 38.54949 1.294949      5.026263    6.551515     6.337374

Coefficients of linear discriminants:
                       LD1
Age            0.006673682
Gender        -0.119227475
Air.Pollution -0.047034112
Alcohol.use    0.125085046
Genetic.Risk   0.710574089

#Nueva observación –> Pronóstico Supongamos que entra un alumno nuevo. Y que: Age =19 Gender = 1 Air.Pollution = 5 Alcohol = 3 Genetic Risk = 1

nuevo.dato=rbind(c(19,1,5,3,1))
colnames(nuevo.dato)=colnames(DatosS[,2:6])
nuevo.dato=data.frame(nuevo.dato) # No lo agregué a la base de datos anterior (es aparte) --> datos para testear el modelo
predict(dis,newdata =nuevo.dato)
$class
[1] Leve
Levels: Leve Fuerte

$posterior
       Leve       Fuerte
1 0.9997642 0.0002358329

$x
        LD1
1 -2.881772

La predicción dice que una persona con una enfermedad pulmonar crónica con las características de los datos proporcionados anteriormente tiene un 99% de probabilidad de que se le manifieste la enfermedad de forma leve.

LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKVGhpcyBpcyBhbiBbUiBNYXJrZG93bl0oaHR0cDovL3JtYXJrZG93bi5yc3R1ZGlvLmNvbSkgTm90ZWJvb2suIFdoZW4geW91IGV4ZWN1dGUgY29kZSB3aXRoaW4gdGhlIG5vdGVib29rLCB0aGUgcmVzdWx0cyBhcHBlYXIgYmVuZWF0aCB0aGUgY29kZS4KClRyeSBleGVjdXRpbmcgdGhpcyBjaHVuayBieSBjbGlja2luZyB0aGUgKlJ1biogYnV0dG9uIHdpdGhpbiB0aGUgY2h1bmsgb3IgYnkgcGxhY2luZyB5b3VyIGN1cnNvciBpbnNpZGUgaXQgYW5kIHByZXNzaW5nICpDbWQrU2hpZnQrRW50ZXIqLgoKYGBge3J9CiMgSW5zdGFsYXIgcGFxdWV0ZXMgCgpsaWJyYXJ5KGZvcmVpZ24pCmxpYnJhcnkoZ2dwbG90MikKbGlicmFyeShNQVNTKQpsaWJyYXJ5KG9wZW54bHN4KQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeShkcGx5cikKYGBgCgpMYSBiYXNlIGRlIGRhdG9zIGhhYmxhIGRlIGVsIG5pdmVsIGRlIGVuZmVybWVkYWQgY3LDs25pY2EgcHVsbW9uYXIgcXVlIHRpZW5lbiBsYXMgcGVyc29uYXMgYW5hbGl6YWRhcyB5IGxhcyBjYXJhY3RlcsOtc3RpY2FzIGRlIGVzdGFzIHBlcnNvbmFzLiBDb24gZXN0YSBiYXNlIGRlIGRhdG9zIHNlIHB1ZWRlIGhhY2VyIHVuYSByZWxhY2nDs24gZGUgcXXDqSBjYXJhY3RlcsOtc3RpY2FzIGluZmx1eWVuIG3DoXMgcGFyYSBxdWUgdW5hIGVuZmVybWVkYWQgY3LDs25pY2EgcHVsbW9uYXIgYWZlY3RlIGZ1ZXJ0ZSBvIG5vIHRhbiBmdWVydGUuCgpgYGB7cn0KRGF0b3MgPSByZWFkLmNzdigiL1VzZXJzL2FuZGVyL0Rvd25sb2Fkcy9jYW5jZXIgcGF0aWVudCBkYXRhIHNldHMuY3N2IikKYGBgCgpgYGB7cn0KaGVhZChEYXRvcykKYGBgCgpgYGB7cn0KdmlldyhEYXRvcykKYGBgCgpQYXJhIGVzdGEgcGFydGUgZGUgbG9zIGRhdG9zLCBsYSBjb2x1bW5hIGEgcHJlZGVjaXIgbGEgcGFzYW1vcyBhIHZhcmlhYmxlcyBkZSAwIHkgMSwgZGUgdGFsIGZvcm1hIHF1ZSBzb2xvIGh1YmllcmFuIGRvcyBjYXRlZ29yw61hczogZW5mZXJtZWRhZCBsZXZlIHkgZW5mZXJtZWRhZCBncmF2ZQoKYGBge3J9CkRhdG9zJGNocm9uaWMuTHVuZy5EaXNlYXNlIDwtIGFzLm51bWVyaWMoYXMuY2hhcmFjdGVyKERhdG9zJGNocm9uaWMuTHVuZy5EaXNlYXNlKSkKCkRhdG9zJGNocm9uaWMuTHVuZy5EaXNlYXNlIDwtIGlmZWxzZShEYXRvcyRjaHJvbmljLkx1bmcuRGlzZWFzZSA+PSAxICYgRGF0b3MkY2hyb25pYy5MdW5nLkRpc2Vhc2UgPD0gNCwgMCwKICAgICAgICAgICAgICAgICAgICAgICAgaWZlbHNlKERhdG9zJGNocm9uaWMuTHVuZy5EaXNlYXNlID49IDUgJiBEYXRvcyRjaHJvbmljLkx1bmcuRGlzZWFzZSA8PSA3LCAxLCBEYXRvcyRjaHJvbmljLkx1bmcuRGlzZWFzZSkpCgpgYGAKCkxvcyBkYXRvcyBlc3RhYmFuIGVuIGZvcm1hdG8gdGV4dG8sIHBvciBsbyBxdWUgcGFyYSBoYWNlciBlbCBhbGdvcml0bW8gZXJhIG5lY2VzYXJpbyBwYXNhciB0b2RvcyBhIG51bcOpcmljb3MKCmBgYHtyfQpEYXRvc1tdIDwtIGxhcHBseShEYXRvcywgYXMubnVtZXJpYykKYGBgCgpBcXXDrSBzb2xvIHNlIHNlbGVjY2lvbmFyb24gbGFzIGNvbHVtbmFzIHF1ZSBzZSBpYmFuIGEgdXRpbGl6YXIgcGFyYSBlbCBtb2RlbG8KCmBgYHtyfQpEYXRvc1MgPSBzZWxlY3RfKERhdG9zLCAiaW5kZXgiLCAiQWdlIiwgIkdlbmRlciIsICJBaXIuUG9sbHV0aW9uIiwgIkFsY29ob2wudXNlIiwgIkdlbmV0aWMuUmlzayIsICJjaHJvbmljLkx1bmcuRGlzZWFzZSIpCmBgYAoKYGBge3J9CkRhdG9zUwpgYGAKCmBgYHtyfQojIEVudHJlbmFtaWVudG8gZGUgZGF0b3MgCgpEYXRvc1MkY2hyb25pYy5MdW5nLkRpc2Vhc2UgPC0gZmFjdG9yKERhdG9zUyRjaHJvbmljLkx1bmcuRGlzZWFzZSwgbGV2ZWxzID0gYygwLDEpLCBsYWJlbHMgPSBjKCJMZXZlIiwgIkZ1ZXJ0ZSIpKSAjZmFjdG9yIHNpZ25pZmljYSBkYXJsZSBqZXJhcnF1w61hIGEgbG9zIGRhdG9zIAoKZGlzPWxkYShjaHJvbmljLkx1bmcuRGlzZWFzZX5BZ2UrR2VuZGVyK0Fpci5Qb2xsdXRpb24rQWxjb2hvbC51c2UrR2VuZXRpYy5SaXNrLCBkYXRhPURhdG9zUyxwcmlvcj1jKDAuNSwwLjUpKSAjIE5vIGVzdGFtb3MgdG9tYW5kbyBlbiBjdWVudGEgdG9kYXMgbGFzIHZhcmlhYmxlcwpkaXMKCmBgYAoKI051ZXZhIG9ic2VydmFjacOzbiAtLVw+IFByb27Ds3N0aWNvIFN1cG9uZ2Ftb3MgcXVlIGVudHJhIHVuIGFsdW1ubyBudWV2by4gWSBxdWU6IEFnZSA9MTkgR2VuZGVyID0gMSBBaXIuUG9sbHV0aW9uID0gNSBBbGNvaG9sID0gMyBHZW5ldGljIFJpc2sgPSAxCgpgYGB7cn0KbnVldm8uZGF0bz1yYmluZChjKDE5LDEsNSwzLDEpKQpjb2xuYW1lcyhudWV2by5kYXRvKT1jb2xuYW1lcyhEYXRvc1NbLDI6Nl0pCm51ZXZvLmRhdG89ZGF0YS5mcmFtZShudWV2by5kYXRvKSAjIE5vIGxvIGFncmVndcOpIGEgbGEgYmFzZSBkZSBkYXRvcyBhbnRlcmlvciAoZXMgYXBhcnRlKSAtLT4gZGF0b3MgcGFyYSB0ZXN0ZWFyIGVsIG1vZGVsbwpgYGAKCmBgYHtyfQpwcmVkaWN0KGRpcyxuZXdkYXRhID1udWV2by5kYXRvKQpgYGAKCkxhIHByZWRpY2Npw7NuIGRpY2UgcXVlIHVuYSBwZXJzb25hIGNvbiB1bmEgZW5mZXJtZWRhZCBwdWxtb25hciBjcsOzbmljYSBjb24gbGFzIGNhcmFjdGVyw61zdGljYXMgZGUgbG9zIGRhdG9zIHByb3BvcmNpb25hZG9zIGFudGVyaW9ybWVudGUgdGllbmUgdW4gOTklIGRlIHByb2JhYmlsaWRhZCBkZSBxdWUgc2UgbGUgbWFuaWZpZXN0ZSBsYSBlbmZlcm1lZGFkIGRlIGZvcm1hIGxldmUuCg==