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
fitControl2 <- trainControl(method = "cv",
                           number = 10) 


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

nnet_model1 <- 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 = fitControl2,
                               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_model2 <- 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 = fitControl2,
                               trace = FALSE)

Estructura de la red

library(NeuralNetTools)
plotnet(nnet_model1$finalModel)

#modelo 2
plotnet(nnet_model2$finalModel)

Exploración del modelo

#Información modelo nnet
print(nnet_model1)

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) 
Summary of sample sizes: 4051, 4053, 4050, 4053, 4050, 4052, ... 
Resampling results across tuning parameters:

  size  decay  Accuracy   Kappa    
   5    0.001  0.7905492  0.7489957
   5    0.010  0.7900939  0.7486960
   5    0.100  0.7798814  0.7358023
  10    0.001  0.8020930  0.7634893
  10    0.010  0.8107474  0.7738227
  10    0.100  0.8023038  0.7633621
  15    0.001  0.8194205  0.7841215
  15    0.010  0.8174244  0.7817979
  15    0.100  0.8145379  0.7780627

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_model2)

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) 
Summary of sample sizes: 4050, 4051, 4051, 4051, 4055, 4052, ... 
Resampling results across tuning parameters:

  size  decay  Accuracy   Kappa    
   2    0.1    0.6998890  0.6357927
   2    0.2    0.7014655  0.6370732
   2    0.3    0.6961524  0.6300352
   2    0.4    0.6943411  0.6278677
   2    0.5    0.6985539  0.6329553
   4    0.1    0.7656527  0.7181410
   4    0.2    0.7611954  0.7128442
   4    0.3    0.7618695  0.7132727
   4    0.4    0.7567607  0.7069744
   4    0.5    0.7563024  0.7068344
   6    0.1    0.7929794  0.7518206
   6    0.2    0.7885424  0.7465611
   6    0.3    0.7867567  0.7440150
   6    0.4    0.7871986  0.7444643
   6    0.5    0.7783196  0.7337570
   8    0.1    0.8014106  0.7621855
   8    0.2    0.7967587  0.7562352
   8    0.3    0.7925380  0.7511900
   8    0.4    0.7898663  0.7477558
   8    0.5    0.7912007  0.7493691
  10    0.1    0.8065268  0.7685354
  10    0.2    0.7980817  0.7581390
  10    0.3    0.7963024  0.7557925
  10    0.4    0.7958669  0.7549861
  10    0.5    0.7916515  0.7498582

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_model1)

plot(nnet_model2)

Evaluación del modelo 1.

pred_nnet_model1<- predict(nnet_model1,
                              newdata = eva)

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

Confusion Matrix and Statistics

          Reference
Prediction   2   3   5   6   8  10  11  12  14  17
        2  371  10  80   5   3   1   0   0   0   0
        3    4  16   6   2   0   0   0   0   0   0
        5   84   1 321  21  10   5   1  10   2   0
        6    4   5  19 106   0   0   0   5   2   0
        8    2   0   9   0 117   0   0   0   0   0
        10   0   0   0   0   0   8   0   0   0   0
        11   0   0   0   1   0   0  80   1   0   0
        12   0   0   9   4   0   0   4 146   6   0
        14   1   0   5   5   1   2   1   5 286   0
        17   0   0   0   0   0   0   0   0   0 150

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

Statistics by Class:

                     Class: 2 Class: 3 Class: 5 Class: 6 Class: 8 Class: 10
Sensitivity            0.7961  0.50000   0.7149  0.73611  0.89313   0.50000
Specificity            0.9327  0.99370   0.9099  0.98048  0.99391   1.00000
Pos Pred Value         0.7894  0.57143   0.7055  0.75177  0.91406   1.00000
Neg Pred Value         0.9352  0.99162   0.9136  0.97884  0.99226   0.99585
Prevalence             0.2406  0.01652   0.2318  0.07434  0.06763   0.00826
Detection Rate         0.1915  0.00826   0.1657  0.05472  0.06040   0.00413
Detection Prevalence   0.2426  0.01446   0.2349  0.07279  0.06608   0.00413
Balanced Accuracy      0.8644  0.74685   0.8124  0.85830  0.94352   0.75000
                     Class: 11 Class: 12 Class: 14 Class: 17
Sensitivity            0.93023   0.87425    0.9662   1.00000
Specificity            0.99892   0.98701    0.9878   1.00000
Pos Pred Value         0.97561   0.86391    0.9346   1.00000
Neg Pred Value         0.99677   0.98812    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.08725    0.1580   0.07744
Balanced Accuracy      0.96458   0.93063    0.9770   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_model2<- predict(nnet_model2,
                              newdata = eva)

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

Confusion Matrix and Statistics

          Reference
Prediction   2   3   5   6   8  10  11  12  14  17
        2  396  13  87   5   4   2   0   0   0   0
        3    0  15   0   7   0   0   0   0   0   0
        5   63   2 311  20   9   8   0  10   1   0
        6    4   2  19  96   0   0   0   1   3   0
        8    2   0  10   0 117   0   0   0   0   0
        10   0   0   0   0   0   5   0   0   0   0
        11   0   0   3   0   0   0  82   3   0   0
        12   0   0  11  12   0   0   2 143  16   0
        14   1   0   8   4   1   1   2  10 276   0
        17   0   0   0   0   0   0   0   0   0 150

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

Statistics by Class:

                     Class: 2 Class: 3 Class: 5 Class: 6 Class: 8 Class: 10
Sensitivity            0.8498 0.468750   0.6927  0.66667  0.89313  0.312500
Specificity            0.9245 0.996325   0.9241  0.98383  0.99336  1.000000
Pos Pred Value         0.7811 0.681818   0.7335  0.76800  0.90698  1.000000
Neg Pred Value         0.9510 0.991123   0.9088  0.97351  0.99226  0.994306
Prevalence             0.2406 0.016520   0.2318  0.07434  0.06763  0.008260
Detection Rate         0.2044 0.007744   0.1606  0.04956  0.06040  0.002581
Detection Prevalence   0.2617 0.011358   0.2189  0.06453  0.06660  0.002581
Balanced Accuracy      0.8872 0.732538   0.8084  0.82525  0.94324  0.656250
                     Class: 11 Class: 12 Class: 14 Class: 17
Sensitivity            0.95349   0.85629    0.9324   1.00000
Specificity            0.99676   0.97684    0.9835   1.00000
Pos Pred Value         0.93182   0.77717    0.9109   1.00000
Neg Pred Value         0.99784   0.98631    0.9878   1.00000
Prevalence             0.04440   0.08622    0.1528   0.07744
Detection Rate         0.04233   0.07383    0.1425   0.07744
Detection Prevalence   0.04543   0.09499    0.1564   0.07744
Balanced Accuracy      0.97512   0.91656    0.9580   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_model1 <- raster::predict(roma_rst_lan, model=nnet_model1)
plot(classi_nnet_model1, main="Clasificación Redes neuronales Modelo 1",col = cols)

Predicción y visualización Modelo 2.

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