Clasificación de imágenes con Redes Neuronales

Librerias aplicadas

library(caret)
library(raster)

Carga de las bandas de imágenes satelitales.

band1 <- raster("/Users/elianaalizchuquillanquijulcapari/Documents/workspace-r/demos/capturas-landsat/roma/LC81910312013208LGN00/LC81910312013208LGN00_B1.TIF")
band2 <- raster("/Users/elianaalizchuquillanquijulcapari/Documents/workspace-r/demos/capturas-landsat/roma/LC81910312013208LGN00/LC81910312013208LGN00_B2.TIF")
band3 <- raster("/Users/elianaalizchuquillanquijulcapari/Documents/workspace-r/demos/capturas-landsat/roma/LC81910312013208LGN00/LC81910312013208LGN00_B3.TIF")
band4 <- raster("/Users/elianaalizchuquillanquijulcapari/Documents/workspace-r/demos/capturas-landsat/roma/LC81910312013208LGN00/LC81910312013208LGN00_B4.TIF")
band5 <- raster("/Users/elianaalizchuquillanquijulcapari/Documents/workspace-r/demos/capturas-landsat/roma/LC81910312013208LGN00/LC81910312013208LGN00_B5.TIF")
band6 <- raster("/Users/elianaalizchuquillanquijulcapari/Documents/workspace-r/demos/capturas-landsat/roma/LC81910312013208LGN00/LC81910312013208LGN00_B6.TIF")
band7 <- raster("/Users/elianaalizchuquillanquijulcapari/Documents/workspace-r/demos/capturas-landsat/roma/LC81910312013208LGN00/LC81910312013208LGN00_B7.TIF")
band10 <- raster("/Users/elianaalizchuquillanquijulcapari/Documents/workspace-r/demos/capturas-landsat/roma/LC81910312013208LGN00/LC81910312013208LGN00_B10.TIF")
band11 <- raster("/Users/elianaalizchuquillanquijulcapari/Documents/workspace-r/demos/capturas-landsat/roma/LC81910312013208LGN00/LC81910312013208LGN00_B11.TIF")

roma_rst_lan <- brick(band1,band2,band3,band4,band5,band6,band7,band10,band11)
names(roma_rst_lan) <- c(paste("Banda",1:7,sep=""),"Banda10","Banda11")

Procesado de datos

#Carga de muestras de entrenamiento
rstTrainroma <- raster("/Users/elianaalizchuquillanquijulcapari/Documents/workspace-r/demos/DataTraining/rome_lcz_GT.tif")

# Remover ceros (fondo NA)
rstTrainroma[rstTrainroma==0] <- NA

# Convertir a tipo discreto
rstTrainroma <- ratify(rstTrainroma)

# Cambiamos el nombre
names(rstTrainroma) <- "layer"

#Muestras de valores
table(values(rstTrainroma))

   2    3    5    6    8   10   11   12   14   17 
1551  104 1495  480  435   51  284  555  984  500 

# Eliminación de NAs 
rstDFlanroma.df <- na.omit(values(stack(rstTrainroma, roma_rst_lan)))

# Viualizamos las muestras
cols <- c("#fde725","#b5de2b", "#6ece58","#35b779", "#1f9e89","#26828e", "#31688e", "#3e4989", "#482878", "#440154")
plot(rstTrainroma, main="Muestras de entrenamiento de Roma", col = cols)

Fase de Clasificación

#Si es la primera vez se ejecuta, sino ya esta guardado los datos del dataframe.
write.csv(rstDFlanroma.df,"rstDFRoma.csv", row.names = FALSE)

#Leemos los datos
samplesLanroma = read.csv("rstDFRoma.csv")

# Se divide las muestras en 70 y 30
trainx = list(0)
evalx = list(0)
for (i in 1:17){ # se itera en todas las posibles categorías
  cls = samplesLanroma[samplesLanroma$layer == i,]
  smpl <- floor(0.70 * nrow(cls))
  tt <- sample(seq_len(nrow(cls)), size = smpl)
  trainx[[i]] <- cls[tt,]
  evalx[[i]] <- cls[-tt,]
}


# Se combina en dataframe referenciados s entrenamiento y evaluación
trn = do.call(rbind, trainx) 
eva = do.call(rbind, evalx)

Algoritmo Redes neuronales

# Definiendo el control del entrenamiento
fitControl <- trainControl(method = "repeatedcv", # repeated cross-validation of the training data
                   number = 10, # number of folds
                   repeats = 3) # view the training iterations


# Entrenamiento con Redes Neuronales
nnet_grid <- expand.grid(size = c(5, 10, 15),
                         decay = c(0.001, 0.01, 0.1))

nnet_model_roma <- caret::train(x = trn[,(2:ncol(trn))], y = as.factor(trn$layer),
                               method = "nnet", metric="Accuracy", 
                               maxit = 100,
                               tuneGrid = nnet_grid,
                               preProcess = c("center", "scale"),
                               trControl = fitControl,
                               trace = FALSE)

nnet_grid2 = expand.grid(size = seq(from = 2, to = 10, by = 2), 
                        decay = seq(from = 0.1, to = 0.5, by = 0.1))

nnet_model_roma2 <- caret::train(x = trn[,(2:ncol(trn))], y = as.factor(trn$layer),
                               method = "nnet", metric="Accuracy",
                               maxit = 100,
                               tuneGrid = nnet_grid2,
                               preProcess = c("center", "scale"),
                               trControl = fitControl,
                               trace = FALSE)

Estructura de la red

library(NeuralNetTools)
plotnet(nnet_model_roma$finalModel)

#modelo 2
plotnet(nnet_model_roma2$finalModel)

Exploración del modelo

#Información modelo nnet
print(nnet_model_roma)

Neural Network 

4502 samples
   9 predictor
  10 classes: '2', '3', '5', '6', '8', '10', '11', '12', '14', '17' 

Pre-processing: centered (9), scaled (9) 
Resampling: Cross-Validated (10 fold, repeated 3 times) 
Summary of sample sizes: 4051, 4052, 4054, 4050, 4052, 4052, ... 
Resampling results across tuning parameters:

  size  decay  Accuracy   Kappa    
   5    0.001  0.7892113  0.7474936
   5    0.010  0.7864620  0.7441364
   5    0.100  0.7852068  0.7422215
  10    0.001  0.8109036  0.7739284
  10    0.010  0.8115595  0.7747506
  10    0.100  0.8074964  0.7697054
  15    0.001  0.8173485  0.7818004
  15    0.010  0.8158028  0.7799476
  15    0.100  0.8162342  0.7802712

Accuracy was used to select the optimal model using the largest value.
The final values used for the model were size = 15 and decay = 0.001.

print(nnet_model_roma2)

Neural Network 

4502 samples
   9 predictor
  10 classes: '2', '3', '5', '6', '8', '10', '11', '12', '14', '17' 

Pre-processing: centered (9), scaled (9) 
Resampling: Cross-Validated (10 fold, repeated 3 times) 
Summary of sample sizes: 4051, 4052, 4052, 4051, 4053, 4052, ... 
Resampling results across tuning parameters:

  size  decay  Accuracy   Kappa    
   2    0.1    0.7056884  0.6428292
   2    0.2    0.7033307  0.6397061
   2    0.3    0.6973017  0.6317135
   2    0.4    0.7033842  0.6392924
   2    0.5    0.6879770  0.6189391
   4    0.1    0.7688343  0.7222316
   4    0.2    0.7647635  0.7172468
   4    0.3    0.7568483  0.7073791
   4    0.4    0.7555907  0.7056245
   4    0.5    0.7553609  0.7054173
   6    0.1    0.7941506  0.7533604
   6    0.2    0.7902373  0.7484191
   6    0.3    0.7884554  0.7461338
   6    0.4    0.7871946  0.7446072
   6    0.5    0.7837177  0.7402162
   8    0.1    0.8028976  0.7641201
   8    0.2    0.7968212  0.7564817
   8    0.3    0.7931874  0.7519018
   8    0.4    0.7923107  0.7507579
   8    0.5    0.7917109  0.7499887
  10    0.1    0.8051750  0.7668082
  10    0.2    0.8014789  0.7621894
  10    0.3    0.7974046  0.7571338
  10    0.4    0.7968178  0.7562008
  10    0.5    0.7928177  0.7512634

Accuracy was used to select the optimal model using the largest value.
The final values used for the model were size = 10 and decay = 0.1.

#Gráfica del modelo nnet
plot(nnet_model_roma)

plot(nnet_model_roma2)

Evaluación del modelo 1.

pred_nnet_model_roma<- predict(nnet_model_roma,
                              newdata = eva)

cm <- confusionMatrix(data = pred_nnet_model_roma, as.factor(eva$layer))
cm

Confusion Matrix and Statistics

          Reference
Prediction   2   3   5   6   8  10  11  12  14  17
        2  376  13  79   4   3   2   0   0   0   0
        3    4  13   3   2   0   0   0   0   0   0
        5   80   3 321  28  10   8   1   8   1   0
        6    3   3  22  99   0   0   1   3   3   0
        8    2   0   9   0 117   1   0   0   0   0
        10   0   0   0   0   0   4   0   0   0   0
        11   0   0   0   0   0   0  80   2   0   0
        12   0   0  10   5   0   0   4 146   6   0
        14   1   0   5   6   1   1   0   8 286   0
        17   0   0   0   0   0   0   0   0   0 150

Overall Statistics
                                          
               Accuracy : 0.8219          
                 95% CI : (0.8041, 0.8387)
    No Information Rate : 0.2406          
    P-Value [Acc > NIR] : < 2.2e-16       
                                          
                  Kappa : 0.787           
                                          
 Mcnemar's Test P-Value : NA              

Statistics by Class:

                     Class: 2 Class: 3 Class: 5 Class: 6 Class: 8 Class: 10
Sensitivity            0.8069 0.406250   0.7149  0.68750  0.89313  0.250000
Specificity            0.9313 0.995276   0.9066  0.98048  0.99336  1.000000
Pos Pred Value         0.7883 0.590909   0.6978  0.73881  0.90698  1.000000
Neg Pred Value         0.9384 0.990078   0.9133  0.97504  0.99226  0.993792
Prevalence             0.2406 0.016520   0.2318  0.07434  0.06763  0.008260
Detection Rate         0.1941 0.006711   0.1657  0.05111  0.06040  0.002065
Detection Prevalence   0.2463 0.011358   0.2375  0.06918  0.06660  0.002065
Balanced Accuracy      0.8691 0.700763   0.8108  0.83399  0.94324  0.625000
                     Class: 11 Class: 12 Class: 14 Class: 17
Sensitivity            0.93023   0.87425    0.9662   1.00000
Specificity            0.99892   0.98588    0.9866   1.00000
Pos Pred Value         0.97561   0.85380    0.9286   1.00000
Neg Pred Value         0.99677   0.98811    0.9939   1.00000
Prevalence             0.04440   0.08622    0.1528   0.07744
Detection Rate         0.04130   0.07537    0.1477   0.07744
Detection Prevalence   0.04233   0.08828    0.1590   0.07744
Balanced Accuracy      0.96458   0.93006    0.9764   1.00000

Matriz de confusión modelo 1

cm_d <- as.data.frame(cm$table)

cm_st <-data.frame(cm$overall)

cm_st$cm.overall <- round(cm_st$cm.overall,2)

cm_p <- as.data.frame(prop.table(cm$table))
cm_d$Perc <- round(cm_p$Freq*100,2)

# dibujando la matriz
ggplot(data = cm_d, aes(x = Prediction , y =  Reference, fill = Freq))+
  geom_tile(color = "white", lwd = 0.5) +
  geom_text(aes(label = paste("",Freq)), color = 'white', size = 3.5)+ 
  theme_minimal() +
  ggtitle("Matriz de Confusión")

Evaluación del modelo 2

pred_nnet_model_roma2<- predict(nnet_model_roma2,
                              newdata = eva)

cm <- confusionMatrix(data = pred_nnet_model_roma2, as.factor(eva$layer))
cm

Confusion Matrix and Statistics

          Reference
Prediction   2   3   5   6   8  10  11  12  14  17
        2  394  13  91   3   4   2   0   0   0   0
        3    1  14   2   6   0   0   0   0   0   0
        5   66   2 313  27  12   7   2  12   3   0
        6    3   3  19  95   1   0   0   1   4   0
        8    2   0  10   0 113   0   0   0   0   0
        10   0   0   1   0   1   5   0   0   0   0
        11   0   0   1   0   0   0  79   3   0   0
        12   0   0   5   9   0   0   4 136  11   0
        14   0   0   7   4   0   2   1  15 278   0
        17   0   0   0   0   0   0   0   0   0 150

Overall Statistics
                                          
               Accuracy : 0.8141          
                 95% CI : (0.7961, 0.8312)
    No Information Rate : 0.2406          
    P-Value [Acc > NIR] : < 2.2e-16       
                                          
                  Kappa : 0.7774          
                                          
 Mcnemar's Test P-Value : NA              

Statistics by Class:

                     Class: 2 Class: 3 Class: 5 Class: 6 Class: 8 Class: 10
Sensitivity            0.8455 0.437500   0.6971  0.65972  0.86260  0.312500
Specificity            0.9232 0.995276   0.9120  0.98271  0.99336  0.998959
Pos Pred Value         0.7771 0.608696   0.7050  0.75397  0.90400  0.714286
Neg Pred Value         0.9497 0.990596   0.9089  0.97294  0.99007  0.994301
Prevalence             0.2406 0.016520   0.2318  0.07434  0.06763  0.008260
Detection Rate         0.2034 0.007228   0.1616  0.04904  0.05834  0.002581
Detection Prevalence   0.2617 0.011874   0.2292  0.06505  0.06453  0.003614
Balanced Accuracy      0.8843 0.716388   0.8045  0.82122  0.92798  0.655729
                     Class: 11 Class: 12 Class: 14 Class: 17
Sensitivity            0.91860   0.81437    0.9392   1.00000
Specificity            0.99784   0.98362    0.9823   1.00000
Pos Pred Value         0.95181   0.82424    0.9055   1.00000
Neg Pred Value         0.99622   0.98251    0.9890   1.00000
Prevalence             0.04440   0.08622    0.1528   0.07744
Detection Rate         0.04078   0.07021    0.1435   0.07744
Detection Prevalence   0.04285   0.08518    0.1585   0.07744
Balanced Accuracy      0.95822   0.89899    0.9608   1.00000

Matriz de confusión modelo 2

cm_d <- as.data.frame(cm$table)

cm_st <-data.frame(cm$overall)

cm_st$cm.overall <- round(cm_st$cm.overall,2)

cm_p <- as.data.frame(prop.table(cm$table))
cm_d$Perc <- round(cm_p$Freq*100,2)

# dibujando la matriz
ggplot(data = cm_d, aes(x = Prediction , y =  Reference, fill = Freq))+
  geom_tile(color = "white", lwd = 0.5) +
  geom_text(aes(label = paste("",Freq)), color = 'white', size = 3.5)+ 
  theme_minimal() +
  ggtitle("Matriz de Confusión")

Predicción y visualización Modelo 1.

classi_nnet_model_roma <- raster::predict(roma_rst_lan, model=nnet_model_roma)
plot(classi_nnet_model_roma, main="Clasificación Redes neuronales Modelo 1",col = cols)

Predicción y visualización Modelo 2.

classi_nnet_model_roma2 <- raster::predict(roma_rst_lan, model=nnet_model_roma2)
plot(classi_nnet_model_roma2, main="Clasificación Redes neuronales Modelo 2", col = cols)