Paso 1. Importar base de datos

#file.choose() 

base_de_datos <- read.csv( "C:\\Users\\danyc\\OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey\\Desktop\\Excel y CSV\\cancer_de_mama.csv")

Paso 2. Entender la base de datos

summary(base_de_datos)
##   diagnosis          radius_mean      texture_mean   perimeter_mean  
##  Length:569         Min.   : 6.981   Min.   : 9.71   Min.   : 43.79  
##  Class :character   1st Qu.:11.700   1st Qu.:16.17   1st Qu.: 75.17  
##  Mode  :character   Median :13.370   Median :18.84   Median : 86.24  
##                     Mean   :14.127   Mean   :19.29   Mean   : 91.97  
##                     3rd Qu.:15.780   3rd Qu.:21.80   3rd Qu.:104.10  
##                     Max.   :28.110   Max.   :39.28   Max.   :188.50  
##    area_mean      smoothness_mean   compactness_mean  concavity_mean   
##  Min.   : 143.5   Min.   :0.05263   Min.   :0.01938   Min.   :0.00000  
##  1st Qu.: 420.3   1st Qu.:0.08637   1st Qu.:0.06492   1st Qu.:0.02956  
##  Median : 551.1   Median :0.09587   Median :0.09263   Median :0.06154  
##  Mean   : 654.9   Mean   :0.09636   Mean   :0.10434   Mean   :0.08880  
##  3rd Qu.: 782.7   3rd Qu.:0.10530   3rd Qu.:0.13040   3rd Qu.:0.13070  
##  Max.   :2501.0   Max.   :0.16340   Max.   :0.34540   Max.   :0.42680  
##  concave.points_mean symmetry_mean    fractal_dimension_mean   radius_se     
##  Min.   :0.00000     Min.   :0.1060   Min.   :0.04996        Min.   :0.1115  
##  1st Qu.:0.02031     1st Qu.:0.1619   1st Qu.:0.05770        1st Qu.:0.2324  
##  Median :0.03350     Median :0.1792   Median :0.06154        Median :0.3242  
##  Mean   :0.04892     Mean   :0.1812   Mean   :0.06280        Mean   :0.4052  
##  3rd Qu.:0.07400     3rd Qu.:0.1957   3rd Qu.:0.06612        3rd Qu.:0.4789  
##  Max.   :0.20120     Max.   :0.3040   Max.   :0.09744        Max.   :2.8730  
##    texture_se      perimeter_se       area_se        smoothness_se     
##  Min.   :0.3602   Min.   : 0.757   Min.   :  6.802   Min.   :0.001713  
##  1st Qu.:0.8339   1st Qu.: 1.606   1st Qu.: 17.850   1st Qu.:0.005169  
##  Median :1.1080   Median : 2.287   Median : 24.530   Median :0.006380  
##  Mean   :1.2169   Mean   : 2.866   Mean   : 40.337   Mean   :0.007041  
##  3rd Qu.:1.4740   3rd Qu.: 3.357   3rd Qu.: 45.190   3rd Qu.:0.008146  
##  Max.   :4.8850   Max.   :21.980   Max.   :542.200   Max.   :0.031130  
##  compactness_se      concavity_se     concave.points_se   symmetry_se      
##  Min.   :0.002252   Min.   :0.00000   Min.   :0.000000   Min.   :0.007882  
##  1st Qu.:0.013080   1st Qu.:0.01509   1st Qu.:0.007638   1st Qu.:0.015160  
##  Median :0.020450   Median :0.02589   Median :0.010930   Median :0.018730  
##  Mean   :0.025478   Mean   :0.03189   Mean   :0.011796   Mean   :0.020542  
##  3rd Qu.:0.032450   3rd Qu.:0.04205   3rd Qu.:0.014710   3rd Qu.:0.023480  
##  Max.   :0.135400   Max.   :0.39600   Max.   :0.052790   Max.   :0.078950  
##  fractal_dimension_se  radius_worst   texture_worst   perimeter_worst 
##  Min.   :0.0008948    Min.   : 7.93   Min.   :12.02   Min.   : 50.41  
##  1st Qu.:0.0022480    1st Qu.:13.01   1st Qu.:21.08   1st Qu.: 84.11  
##  Median :0.0031870    Median :14.97   Median :25.41   Median : 97.66  
##  Mean   :0.0037949    Mean   :16.27   Mean   :25.68   Mean   :107.26  
##  3rd Qu.:0.0045580    3rd Qu.:18.79   3rd Qu.:29.72   3rd Qu.:125.40  
##  Max.   :0.0298400    Max.   :36.04   Max.   :49.54   Max.   :251.20  
##    area_worst     smoothness_worst  compactness_worst concavity_worst 
##  Min.   : 185.2   Min.   :0.07117   Min.   :0.02729   Min.   :0.0000  
##  1st Qu.: 515.3   1st Qu.:0.11660   1st Qu.:0.14720   1st Qu.:0.1145  
##  Median : 686.5   Median :0.13130   Median :0.21190   Median :0.2267  
##  Mean   : 880.6   Mean   :0.13237   Mean   :0.25427   Mean   :0.2722  
##  3rd Qu.:1084.0   3rd Qu.:0.14600   3rd Qu.:0.33910   3rd Qu.:0.3829  
##  Max.   :4254.0   Max.   :0.22260   Max.   :1.05800   Max.   :1.2520  
##  concave.points_worst symmetry_worst   fractal_dimension_worst
##  Min.   :0.00000      Min.   :0.1565   Min.   :0.05504        
##  1st Qu.:0.06493      1st Qu.:0.2504   1st Qu.:0.07146        
##  Median :0.09993      Median :0.2822   Median :0.08004        
##  Mean   :0.11461      Mean   :0.2901   Mean   :0.08395        
##  3rd Qu.:0.16140      3rd Qu.:0.3179   3rd Qu.:0.09208        
##  Max.   :0.29100      Max.   :0.6638   Max.   :0.20750

Paso 3. Crear árbol de decisiones

library(rpart)
arbol <- rpart(formula = diagnosis ~ ., data = base_de_datos)
arbol
## n= 569 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
##  1) root 569 212 B (0.62741652 0.37258348)  
##    2) radius_worst< 16.795 379  33 B (0.91292876 0.08707124)  
##      4) concave.points_worst< 0.1358 333   5 B (0.98498498 0.01501502) *
##      5) concave.points_worst>=0.1358 46  18 M (0.39130435 0.60869565)  
##       10) texture_worst< 25.67 19   4 B (0.78947368 0.21052632) *
##       11) texture_worst>=25.67 27   3 M (0.11111111 0.88888889) *
##    3) radius_worst>=16.795 190  11 M (0.05789474 0.94210526) *
#install.packages("rpart.plot")
library(rpart.plot)

rpart.plot(arbol)

prp(arbol,extra=7, prefix="fracción\n")

Paso 4. Crear una gráfica de resultados

  #?ggplot

#install.packages("ggplot")
library("ggplot2")
library("tidyverse")
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ tibble  3.1.8      ✔ dplyr   1.0.10
## ✔ tidyr   1.2.0      ✔ stringr 1.4.1 
## ✔ readr   2.1.2      ✔ forcats 0.5.2 
## ✔ purrr   0.3.4      
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
ggplot(data=base_de_datos, mapping = aes(radius_worst, concave.points_worst)) + geom_point(aes(color =  diagnosis)) + theme_bw()

Conclusión y Aprendizajes

Dentro del árbol de decisión que se hizo para este trabajo, se pudo observar el significado que el tamaño del tumor tiene y la relevancia que esto tiene en correlación de si es benigno o maligno. Ya adentrandonos en el árbol podemos ver que si la célula tiene un radio menor a 17, tiene una mayor posibilidad de que sea benigna con un 67%, si es que solo ponemos ese filtro, después vienen los puntos concavos, que si son menores a 0.14, la probabilidad de que sean benignos sigue siendo mayoritaría en un 59%, pero de no ser así y ser maligno tiene un 8% de los cuales la textura del núcleo juega un rol importante ya que puede ser maligno en un 5% a comparación de benigno que es un 3% en un rango menor a 26 en textura.

Estos resultados nos indican que los canceres benignos de seno son estables mientras se mantengan del mismo tamaño, ya cuando van cambiando de simetría es cuando se comienzan a tornar en malignos y podrían causar una metástasis en otros sitios del cuerpo.

Como parte de la consientización hago referencía al mes de octubre y dejo la página oficial del cancer de mama.

Campaña contra el cancer de mama

knitr::include_url("https://www.nationalbreastcancer.org/breast-cancer-awareness-month/")
LS0tDQp0aXRsZTogPHNwYW4gc3R5bGU9IkNvbG9yOlBpbmsiPiJDw6FuY2VyIGRlIE1hbWEvw4FyYm9sIGRlIERlY2lzacOzbiIgPC9zcGFuPg0KYXV0aG9yOiAiRGFuaWVsYSBDw6FyZGVuYXMgWiAvLyBBMDE3MjA1MzUiDQpkYXRlOiAiMjAyMi0wOS0yMCINCm91dHB1dDogDQogICAgICBodG1sX2RvY3VtZW50Og0KICAgICAgICB0b2M6IHRydWUNCiAgICAgICAgdG9jX2Zsb2F0OiB0cnVlDQogICAgICAgIGNvZGVfZm9sZGluZzogImhpZGUiDQogICAgICAgIGNvZGVfZG93bmxvYWQ6IHRydWUNCi0tLQ0KKioqDQoNCiMgPGltZyBzcmM9ICJDOlxcVXNlcnNcXGRhbnljXFxEb3dubG9hZHNcXGJyZWFzdC5naWYiIC8+DQoNCiMgPHNwYW4gc3R5bGU9IkNvbG9yOiNFQjI2ODQiPiBQYXNvIDEuIEltcG9ydGFyIGJhc2UgZGUgZGF0b3MgPC9zcGFuPg0KDQpgYGB7cn0NCiNmaWxlLmNob29zZSgpIA0KDQpiYXNlX2RlX2RhdG9zIDwtIHJlYWQuY3N2KCAiQzpcXFVzZXJzXFxkYW55Y1xcT25lRHJpdmUgLSBJbnN0aXR1dG8gVGVjbm9sb2dpY28geSBkZSBFc3R1ZGlvcyBTdXBlcmlvcmVzIGRlIE1vbnRlcnJleVxcRGVza3RvcFxcRXhjZWwgeSBDU1ZcXGNhbmNlcl9kZV9tYW1hLmNzdiIpDQoNCmBgYA0KDQoNCiMgPHNwYW4gc3R5bGU9IkNvbG9yOiNFQjI2ODQiPlBhc28gMi4gRW50ZW5kZXIgbGEgYmFzZSBkZSBkYXRvcyA8L3NwYW4+DQpgYGB7cn0NCnN1bW1hcnkoYmFzZV9kZV9kYXRvcykNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJDb2xvcjojRUIyNjg0Ij5QYXNvIDMuIENyZWFyIMOhcmJvbCBkZSBkZWNpc2lvbmVzIDwvc3Bhbj4NCmBgYHtyfQ0KbGlicmFyeShycGFydCkNCmFyYm9sIDwtIHJwYXJ0KGZvcm11bGEgPSBkaWFnbm9zaXMgfiAuLCBkYXRhID0gYmFzZV9kZV9kYXRvcykNCmFyYm9sDQpgYGANCg0KYGBge3J9DQojaW5zdGFsbC5wYWNrYWdlcygicnBhcnQucGxvdCIpDQpsaWJyYXJ5KHJwYXJ0LnBsb3QpDQoNCnJwYXJ0LnBsb3QoYXJib2wpDQoNCnBycChhcmJvbCxleHRyYT03LCBwcmVmaXg9ImZyYWNjacOzblxuIikNCg0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9IkNvbG9yOiNFQjI2ODQiPlBhc28gNC4gQ3JlYXIgdW5hIGdyw6FmaWNhIGRlIHJlc3VsdGFkb3MgPC9zcGFuPg0KDQpgYGB7cn0NCiAgIz9nZ3Bsb3QNCg0KI2luc3RhbGwucGFja2FnZXMoImdncGxvdCIpDQpsaWJyYXJ5KCJnZ3Bsb3QyIikNCmxpYnJhcnkoInRpZHl2ZXJzZSIpDQoNCmdncGxvdChkYXRhPWJhc2VfZGVfZGF0b3MsIG1hcHBpbmcgPSBhZXMocmFkaXVzX3dvcnN0LCBjb25jYXZlLnBvaW50c193b3JzdCkpICsgZ2VvbV9wb2ludChhZXMoY29sb3IgPSAgZGlhZ25vc2lzKSkgKyB0aGVtZV9idygpDQpgYGANCg0KDQoNCiMgPHNwYW4gc3R5bGU9IkNvbG9yOiNFQjI2ODQiPiBDb25jbHVzacOzbiB5IEFwcmVuZGl6YWplcyA8L3NwYW4+DQoNCjxzdHlsZT4NCmRpdi5ibHVlIHsgYmFja2dyb3VuZC1jb2xvcjojRkZCQURCOyBib3JkZXItcmFkaXVzOiA1cHg7IHBhZGRpbmc6IDIwcHg7fQ0KPC9zdHlsZT4NCjxkaXYgY2xhc3MgPSAiYmx1ZSI+DQpEZW50cm8gZGVsIMOhcmJvbCBkZSBkZWNpc2nDs24gcXVlIHNlIGhpem8gcGFyYSBlc3RlIHRyYWJham8sIHNlIHB1ZG8gb2JzZXJ2YXIgZWwgc2lnbmlmaWNhZG8gcXVlIGVsIHRhbWHDsW8gZGVsIHR1bW9yIHRpZW5lIHkgbGEgcmVsZXZhbmNpYSBxdWUgZXN0byB0aWVuZSBlbiBjb3JyZWxhY2nDs24gZGUgc2kgZXMgKmJlbmlnbm8gbyBtYWxpZ25vKi4gWWEgYWRlbnRyYW5kb25vcyBlbiBlbCDDoXJib2wgcG9kZW1vcyB2ZXIgcXVlIHNpIGxhIGPDqWx1bGEgdGllbmUgdW4gcmFkaW8gbWVub3IgYSAxNywgdGllbmUgdW5hIG1heW9yIHBvc2liaWxpZGFkIGRlIHF1ZSBzZWEgYmVuaWduYSBjb24gdW4gNjclLCBzaSBlcyBxdWUgc29sbyBwb25lbW9zIGVzZSBmaWx0cm8sIGRlc3B1w6lzIHZpZW5lbiBsb3MgcHVudG9zIGNvbmNhdm9zLCBxdWUgc2kgc29uIG1lbm9yZXMgYSAwLjE0LCBsYSBwcm9iYWJpbGlkYWQgZGUgcXVlIHNlYW4gYmVuaWdub3Mgc2lndWUgc2llbmRvIG1heW9yaXRhcsOtYSBlbiB1biA1OSUsIHBlcm8gZGUgbm8gc2VyIGFzw60geSBzZXIgbWFsaWdubyB0aWVuZSB1biA4JSBkZSBsb3MgY3VhbGVzIGxhIHRleHR1cmEgZGVsIG7DumNsZW8ganVlZ2EgdW4gcm9sIGltcG9ydGFudGUgeWEgcXVlIHB1ZWRlIHNlciBtYWxpZ25vIGVuIHVuIDUlIGEgY29tcGFyYWNpw7NuIGRlIGJlbmlnbm8gcXVlIGVzIHVuIDMlIGVuIHVuIHJhbmdvIG1lbm9yIGEgMjYgZW4gdGV4dHVyYS4NCg0KRXN0b3MgcmVzdWx0YWRvcyBub3MgaW5kaWNhbiBxdWUgbG9zIGNhbmNlcmVzIGJlbmlnbm9zIGRlIHNlbm8gc29uIGVzdGFibGVzIG1pZW50cmFzIHNlIG1hbnRlbmdhbiBkZWwgbWlzbW8gdGFtYcOxbywgeWEgY3VhbmRvIHZhbiBjYW1iaWFuZG8gZGUgc2ltZXRyw61hIGVzIGN1YW5kbyBzZSBjb21pZW56YW4gYSB0b3JuYXIgZW4gbWFsaWdub3MgeSBwb2Ryw61hbiBjYXVzYXIgdW5hIG1ldMOhc3Rhc2lzIGVuIG90cm9zIHNpdGlvcyBkZWwgY3VlcnBvLg0KDQpDb21vIHBhcnRlIGRlIGxhIGNvbnNpZW50aXphY2nDs24gaGFnbyByZWZlcmVuY8OtYSBhbCAqKm1lcyBkZSBvY3R1YnJlKiogeSBkZWpvIGxhIHDDoWdpbmEgb2ZpY2lhbCBkZWwgY2FuY2VyIGRlIG1hbWEuDQo8L2Rpdj4NCg0KIyA8c3BhbiBzdHlsZT0iQ29sb3I6cGluayI+Q2FtcGHDsWEgY29udHJhIGVsIGNhbmNlciBkZSBtYW1hICA8L3NwYW4+IA0KYGBge3J9DQprbml0cjo6aW5jbHVkZV91cmwoImh0dHBzOi8vd3d3Lm5hdGlvbmFsYnJlYXN0Y2FuY2VyLm9yZy9icmVhc3QtY2FuY2VyLWF3YXJlbmVzcy1tb250aC8iKQ0KYGBgDQoNCg==