O objetivo deste projeto é praticar o conhecimento adquirido no modulo Machine Learning do curso de Data Science do Data Science Academy http://www.datascienceacademy.com.br . A rotina de exame da mama permite que a doença seja diagnosticada e tratada antes de causar sintomas perceptíveis. O processo de detecção precoce envolve a análise de nódulos ou massas anormais do tecido da mama. Se um nódulo for encontrado, uma biópsia de aspiração com agulha fina é realizada, que utiliza uma agulha oca para extrair uma pequena amostra de células. Um clínico, em seguida, examina as células sob um microscópio para determinar se a massa é provável que seja maligna ou benigna. Se a aprendizagem de máquina puder automatizar a identificação de células cancerígenas, isso seria uma conquista importante para o sistema de saúde. Os processos automatizados permitem melhorar a eficiência do processo de detecção, permitindo que os médicos possam diagnosticar o problema, avaliar o gasto necessário para resolver e ainda definir o tempo necessário para o tratamento da doença. Um sistema de rastreamento automatizado também pode proporcionar uma maior precisão de detecção através da remoção do componente humano, inerentemente subjetivo, do processo. Iremos investigar a utilidade da aprendizagem de máquina para detectar o câncer, aplicando o algoritmo de classificação k-NN para medições de células provenientes de biópsias de mulheres com nódulos mamários anormais. Usaremos dados reais, fornecidos pelo repositório de Machine Learning da UCI, neste link: http://archive.ics.uci.edu/ml/datasets/Breast+Cancer+Wisconsin+%28Diagnostic%29

library(caret)
## Loading required package: lattice
## Loading required package: ggplot2
library(ggplot2)
library(class)
library(ranger)
dados <- read.csv("breastcancer.csv", stringsAsFactors = FALSE)
str(dados)
## 'data.frame':    569 obs. of  32 variables:
##  $ id               : int  87139402 8910251 905520 868871 9012568 906539 925291 87880 862989 89827 ...
##  $ diagnosis        : chr  "B" "B" "B" "B" ...
##  $ radius_mean      : num  12.3 10.6 11 11.3 15.2 ...
##  $ texture_mean     : num  12.4 18.9 16.8 13.4 13.2 ...
##  $ perimeter_mean   : num  78.8 69.3 70.9 73 97.7 ...
##  $ area_mean        : num  464 346 373 385 712 ...
##  $ smoothness_mean  : num  0.1028 0.0969 0.1077 0.1164 0.0796 ...
##  $ compactness_mean : num  0.0698 0.1147 0.078 0.1136 0.0693 ...
##  $ concavity_mean   : num  0.0399 0.0639 0.0305 0.0464 0.0339 ...
##  $ points_mean      : num  0.037 0.0264 0.0248 0.048 0.0266 ...
##  $ symmetry_mean    : num  0.196 0.192 0.171 0.177 0.172 ...
##  $ dimension_mean   : num  0.0595 0.0649 0.0634 0.0607 0.0554 ...
##  $ radius_se        : num  0.236 0.451 0.197 0.338 0.178 ...
##  $ texture_se       : num  0.666 1.197 1.387 1.343 0.412 ...
##  $ perimeter_se     : num  1.67 3.43 1.34 1.85 1.34 ...
##  $ area_se          : num  17.4 27.1 13.5 26.3 17.7 ...
##  $ smoothness_se    : num  0.00805 0.00747 0.00516 0.01127 0.00501 ...
##  $ compactness_se   : num  0.0118 0.03581 0.00936 0.03498 0.01485 ...
##  $ concavity_se     : num  0.0168 0.0335 0.0106 0.0219 0.0155 ...
##  $ points_se        : num  0.01241 0.01365 0.00748 0.01965 0.00915 ...
##  $ symmetry_se      : num  0.0192 0.035 0.0172 0.0158 0.0165 ...
##  $ dimension_se     : num  0.00225 0.00332 0.0022 0.00344 0.00177 ...
##  $ radius_worst     : num  13.5 11.9 12.4 11.9 16.2 ...
##  $ texture_worst    : num  15.6 22.9 26.4 15.8 15.7 ...
##  $ perimeter_worst  : num  87 78.3 79.9 76.5 104.5 ...
##  $ area_worst       : num  549 425 471 434 819 ...
##  $ smoothness_worst : num  0.139 0.121 0.137 0.137 0.113 ...
##  $ compactness_worst: num  0.127 0.252 0.148 0.182 0.174 ...
##  $ concavity_worst  : num  0.1242 0.1916 0.1067 0.0867 0.1362 ...
##  $ points_worst     : num  0.0939 0.0793 0.0743 0.0861 0.0818 ...
##  $ symmetry_worst   : num  0.283 0.294 0.3 0.21 0.249 ...
##  $ dimension_worst  : num  0.0677 0.0759 0.0788 0.0678 0.0677 ...

Os dados do câncer da mama incluem 569 observações de biópsias de câncer, cada um com 32 variáveis. Uma característica é um número de identificação (ID), outro é o diagnóstico de câncer, e 30 são medidas laboratoriais numéricas. O diagnóstico é codificado como “M” para indicar maligno ou “B” para indicar benigno.

head(dados)
##         id diagnosis radius_mean texture_mean perimeter_mean area_mean
## 1 87139402         B       12.32        12.39          78.85     464.1
## 2  8910251         B       10.60        18.95          69.28     346.4
## 3   905520         B       11.04        16.83          70.92     373.2
## 4   868871         B       11.28        13.39          73.00     384.8
## 5  9012568         B       15.19        13.21          97.65     711.8
## 6   906539         B       11.57        19.04          74.20     409.7
##   smoothness_mean compactness_mean concavity_mean points_mean
## 1         0.10280          0.06981        0.03987     0.03700
## 2         0.09688          0.11470        0.06387     0.02642
## 3         0.10770          0.07804        0.03046     0.02480
## 4         0.11640          0.11360        0.04635     0.04796
## 5         0.07963          0.06934        0.03393     0.02657
## 6         0.08546          0.07722        0.05485     0.01428
##   symmetry_mean dimension_mean radius_se texture_se perimeter_se area_se
## 1        0.1959        0.05955    0.2360     0.6656        1.670   17.43
## 2        0.1922        0.06491    0.4505     1.1970        3.430   27.10
## 3        0.1714        0.06340    0.1967     1.3870        1.342   13.54
## 4        0.1771        0.06072    0.3384     1.3430        1.851   26.33
## 5        0.1721        0.05544    0.1783     0.4125        1.338   17.72
## 6        0.2031        0.06267    0.2864     1.4400        2.206   20.30
##   smoothness_se compactness_se concavity_se points_se symmetry_se
## 1      0.008045       0.011800      0.01683  0.012410     0.01924
## 2      0.007470       0.035810      0.03354  0.013650     0.03504
## 3      0.005158       0.009355      0.01056  0.007483     0.01718
## 4      0.011270       0.034980      0.02187  0.019650     0.01580
## 5      0.005012       0.014850      0.01551  0.009155     0.01647
## 6      0.007278       0.020470      0.04447  0.008799     0.01868
##   dimension_se radius_worst texture_worst perimeter_worst area_worst
## 1     0.002248        13.50         15.64           86.97      549.1
## 2     0.003318        11.88         22.94           78.28      424.8
## 3     0.002198        12.41         26.44           79.93      471.4
## 4     0.003442        11.92         15.77           76.53      434.0
## 5     0.001767        16.20         15.73          104.50      819.1
## 6     0.003339        13.07         26.98           86.43      520.5
##   smoothness_worst compactness_worst concavity_worst points_worst
## 1           0.1385            0.1266         0.12420      0.09391
## 2           0.1213            0.2515         0.19160      0.07926
## 3           0.1369            0.1482         0.10670      0.07431
## 4           0.1367            0.1822         0.08669      0.08611
## 5           0.1126            0.1737         0.13620      0.08178
## 6           0.1249            0.1937         0.25600      0.06664
##   symmetry_worst dimension_worst
## 1         0.2827         0.06771
## 2         0.2940         0.07587
## 3         0.2998         0.07881
## 4         0.2102         0.06784
## 5         0.2487         0.06766
## 6         0.3035         0.08284

Procurando por valores nulos ou vazios

Na pagina de descrição do dataset, temos a informação que o dataset já foi tratado, não possui valores nulos, mas se não tivessemo essa informação poderiamos utilizar esses dois comandos para sabermos onde se encontra os valores

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

Colunas como Identificação, ID etc.. que são únicas e devem ser removidas.

#removendo Id
dados <- dados[,-1]

Plotando informações relativas ao nosso objetivo que é o diagnostico benigno ou não

box.plot <- function(x){
  if(is.numeric(dados[, x])){
    ggplot(dados, aes_string('diagnosis', x)) +
      geom_boxplot( fill=c('#009900','#FF3300')) +
      ggtitle(paste('Diagnósticos por ', x))
  }
}

col.names = names(dados)
sapply(col.names, box.plot)
## $diagnosis
## NULL
## 
## $radius_mean

## 
## $texture_mean

## 
## $perimeter_mean

## 
## $area_mean

## 
## $smoothness_mean

## 
## $compactness_mean

## 
## $concavity_mean

## 
## $points_mean

## 
## $symmetry_mean

## 
## $dimension_mean

## 
## $radius_se

## 
## $texture_se

## 
## $perimeter_se

## 
## $area_se

## 
## $smoothness_se

## 
## $compactness_se

## 
## $concavity_se

## 
## $points_se

## 
## $symmetry_se

## 
## $dimension_se

## 
## $radius_worst

## 
## $texture_worst

## 
## $perimeter_worst

## 
## $area_worst

## 
## $smoothness_worst

## 
## $compactness_worst

## 
## $concavity_worst

## 
## $points_worst

## 
## $symmetry_worst

## 
## $dimension_worst

Note que area, textura, compactness, perimeter somente já nos dão a possibilidade de prever um tumor maligno

Normalizando os dados

Um prática muito comum é normalizar os dados numéricos pois a distancia de valor entre as variáveis eles pode tirar a eficiencia de alguns algoritimos de machine learning

normalizar <- function(x) {
  if(is.numeric(x) )
  {
    return ((x - min(x)) / (max(x) - min(x)))
  }
  else{
    return (x)
  }
}
dados_normalizados <- as.data.frame(lapply(dados, normalizar))

traindata <- dados_normalizados[1:469, -1]
testdata <- dados_normalizados[470:569,-1]

trainLabels <- dados[1:469, 1]
testLabels <- dados[470:569, 1]

#testando a distribuição de dados da coluna diagnosis
prop.table(table(trainLabels))
## trainLabels
##   Benigno   Maligno 
## 0.6311301 0.3688699
prop.table(table(testLabels))
## testLabels
## Benigno Maligno 
##    0.61    0.39

Tuning e salvando modelos para predição Knn

em casos clinicos em que o resultado poê em risco a vida de uma pessoa não podemos levar em conta a acurácia e sim nesse caso os Falsos Positivos, pois um falso Positivo no nosso caso seria um Tumor Maligno não previsto. Com a caret package podemos melhorar esse resultado testando vários outros modelos, podemos passar os parametros pelo expand.grid e o caret cuida de testar os mais eficientes. Além disso podemos testar os resultados para achar o modelo que nos retorne menor desvio padrão, isso pode ser mais importante em um caso em que vidas estão dependendo disso.

set.seed(123)
# Create custom indices: myFolds
myFolds <- createFolds(trainLabels, k = 5)

# Criando um controle reusável para podermos avaliar todos modelos no final
myControl <- trainControl(
  summaryFunction = twoClassSummary,
  classProbs = TRUE, 
  verboseIter = FALSE,
  savePredictions = TRUE,
  index = myFolds,
  search = 'grid',
  
)
model.knn <- train(x=traindata, y=trainLabels,
                  method='knn',
                  trControl = myControl
                  ,tuneLength=30
                  )
## Warning in train.default(x = traindata, y = trainLabels, method = "knn", :
## The metric "Accuracy" was not in the result set. ROC will be used instead.
ggplot(model.knn) + theme(legend.position = "top")

results <- list(knnModel = model.knn)

Glmnet

set.seed(123)
model.glmnet <- train(traindata, trainLabels,
                   method = 'glmnet'
                   ,metric = 'ROC'
                   ,trControl = myControl
                  , tuneGrid = expand.grid(alpha=0:1,lambda=0:10/10)
                  )
ggplot(model.glmnet) + theme(legend.position = "top")
## Warning: Ignoring unknown aesthetics: shape

results$glmnet <- model.glmnet

Random Forest

set.seed(123)
tgrid <- expand.grid(mtry=1:10*2, min.node.size=c(1:12), splitrule=c('extratrees'))
model.ranger <- train(traindata, trainLabels,
                   method = 'ranger'
                   ,metric = 'ROC'
                   ,tuneLength = 10
                   ,trControl = myControl
                  , tuneGrid = tgrid
                  ,verbose = FALSE
                  )


results$ranger <-model.ranger

Plotando e analisando resultados

resamplesmodels <- resamples(results)
bwplot(resamplesmodels, metric = 'ROC' )

densityplot(resamplesmodels, metric = 'ROC')

dotplot(resamplesmodels, metric = 'ROC')

Resultados

Vimos pelos gráficos que o glmnet no entregou o melhor modelo de previsão, seguido pelo ranger, depois o knn, com o caret fica muito tranquilo podermos entregar um modelo de previsão estável e otimizado. Poderiamos obter a máxima probabilidade como vamos fazer agora mesmo, mas tenho certeza que o resultado não seria tão preciso seguindo os passos que fizemos aqui agora. veja abaixo.

Bonus, máxima predictibilidade com SMOTE e Random Forest

library(DMwR)
## Loading required package: grid
set.seed(123)
trainSmote <- SMOTE(diagnosis ~ ., dados_normalizados[1:469,], perc.over = 900, perc.under=100)
table(trainSmote$diagnosis)
## 
## Benigno Maligno 
##    1557    1730
model.rf <- ranger(trainSmote$diagnosis ~ ., trainSmote, 
                   mtry=9, 
                       min.node.size=10, 
                       num.trees = 500,
                       splitrule='extratrees')
pred.rf <- predict(model.rf, testdata)
confusionMatrix(pred.rf$predictions,testLabels)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Benigno Maligno
##    Benigno      61       0
##    Maligno       0      39
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9638, 1)
##     No Information Rate : 0.61       
##     P-Value [Acc > NIR] : < 2.2e-16  
##                                      
##                   Kappa : 1          
##  Mcnemar's Test P-Value : NA         
##                                      
##             Sensitivity : 1.00       
##             Specificity : 1.00       
##          Pos Pred Value : 1.00       
##          Neg Pred Value : 1.00       
##              Prevalence : 0.61       
##          Detection Rate : 0.61       
##    Detection Prevalence : 0.61       
##       Balanced Accuracy : 1.00       
##                                      
##        'Positive' Class : Benigno    
## 

Conclusão

Conseguimos uma acurácia de 100% além de não termos nenhum falso positivo(benigno) que é bastante grave nesse contexto, comparado com os resultados da equipe obtemos uma acurácia ainda maior, mais informações: http://archive.ics.uci.edu/ml/machine-learning-databases/breast-cancer-wisconsin/wdbc.names > Results: - predicting field 2, diagnosis: B = benign, M = malignant - sets are linearly separable using all 30 input features - best predictive accuracy obtained using one separating plane in the 3-D space of Worst Area, Worst Smoothness and Mean Texture. Estimated accuracy 97.5% using repeated 10-fold crossvalidations. Classifier has correctly diagnosed 176 consecutive new patients as of November 1995.