Samoucząca się sieć neuronowa - SOM

library(kohonen)
library(ggplot2)
library(clusterSim)
library(dplyr)

ads <- iris

ads.train <- as.matrix(scale(ads[,-5]))

set.seed(100)
ads.grid <- somgrid(xdim = 5, ydim = 5, topo = "rectangular")

set.seed(100)
ads.model <- som(ads.train, ads.grid, rlen = 500, radius = 2, keep.data = TRUE,
                 dist.fcts = "euclidean")
str(ads.model)

## List of 14
##  $ data            :List of 1
##   ..$ : num [1:150, 1:4] -0.898 -1.139 -1.381 -1.501 -1.018 ...
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ : NULL
##   .. .. ..$ : chr [1:4] "Sepal.Length" "Sepal.Width" "Petal.Length" "Petal.Width"
##   .. ..- attr(*, "scaled:center")= Named num [1:4] 5.84 3.06 3.76 1.2
##   .. .. ..- attr(*, "names")= chr [1:4] "Sepal.Length" "Sepal.Width" "Petal.Length" "Petal.Width"
##   .. ..- attr(*, "scaled:scale")= Named num [1:4] 0.828 0.436 1.765 0.762
##   .. .. ..- attr(*, "names")= chr [1:4] "Sepal.Length" "Sepal.Width" "Petal.Length" "Petal.Width"
##  $ unit.classif    : num [1:150] 17 11 11 11 16 21 16 17 11 11 ...
##  $ distances       : num [1:150] 0.219 0.296 0.274 0.154 0.374 ...
##  $ grid            :List of 6
##   ..$ pts              : int [1:25, 1:2] 1 2 3 4 5 1 2 3 4 5 ...
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ : NULL
##   .. .. ..$ : chr [1:2] "x" "y"
##   ..$ xdim             : num 5
##   ..$ ydim             : num 5
##   ..$ topo             : chr "rectangular"
##   ..$ neighbourhood.fct: Factor w/ 2 levels "bubble","gaussian": 1
##   ..$ toroidal         : logi FALSE
##   ..- attr(*, "class")= chr "somgrid"
##  $ codes           :List of 1
##   ..$ : num [1:25, 1:4] 0.337 -0.49 -0.244 0.522 -0.115 ...
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ : chr [1:25] "V1" "V2" "V3" "V4" ...
##   .. .. ..$ : chr [1:4] "Sepal.Length" "Sepal.Width" "Petal.Length" "Petal.Width"
##  $ changes         : num [1:500, 1] 0.0273 0.0317 0.0285 0.0268 0.0278 ...
##  $ alpha           : num [1:2] 0.05 0.01
##  $ radius          : num [1:2] 2 0
##  $ na.rows         : int(0) 
##  $ user.weights    : num 1
##  $ distance.weights: num 1
##  $ whatmap         : int 1
##  $ maxNA.fraction  : int 0
##  $ dist.fcts       : chr "euclidean"
##  - attr(*, "class")= chr "kohonen"

head(ads.model$unit.classif, 10 )

##  [1] 17 11 11 11 16 21 16 17 11 11

table(ads.model$unit.classif)

## 
##  1  2  3  4  5  6  7  8  9 10 11 13 14 15 16 17 18 19 20 21 22 24 25 
##  4  6  7  8  5  5  9  9  4  7 16  1  8  7  6 14  2  4  7  9  4  5  3

ads.model$grid

## $pts
##       x y
##  [1,] 1 1
##  [2,] 2 1
##  [3,] 3 1
##  [4,] 4 1
##  [5,] 5 1
##  [6,] 1 2
##  [7,] 2 2
##  [8,] 3 2
##  [9,] 4 2
## [10,] 5 2
## [11,] 1 3
## [12,] 2 3
## [13,] 3 3
## [14,] 4 3
## [15,] 5 3
## [16,] 1 4
## [17,] 2 4
## [18,] 3 4
## [19,] 4 4
## [20,] 5 4
## [21,] 1 5
## [22,] 2 5
## [23,] 3 5
## [24,] 4 5
## [25,] 5 5
## 
## $xdim
## [1] 5
## 
## $ydim
## [1] 5
## 
## $topo
## [1] "rectangular"
## 
## $neighbourhood.fct
## [1] bubble
## Levels: bubble gaussian
## 
## $toroidal
## [1] FALSE
## 
## attr(,"class")
## [1] "somgrid"

plot(ads.model, type = "mapping", pchs = 19, shape = "round")

plot(ads.model, type = "codes", main = "Codes Plot", palette.name = rainbow)

plot(ads.model, type = "changes")

plot(ads.model, type = "counts")

plot(ads.model, type = "dist.neighbours")

heatmap.som <- function(model){
  for (i in 1:4) {
    plot(model, type = "property", property = getCodes(model)[,i], 
         main = colnames(getCodes(model))[i]) 
  }
}
par(mfrow=c(2,2))
heatmap.som(ads.model)

KLASYFIKACJA

set.seed(100)
ads.grid <- somgrid(xdim = 10, ydim = 10, topo = "hexagonal")

set.seed(100)
ads.model <- som(ads.train, ads.grid, rlen = 500, radius = 2, keep.data = TRUE,
                 dist.fcts = "euclidean")
str(ads.model)

## List of 14
##  $ data            :List of 1
##   ..$ : num [1:150, 1:4] -0.898 -1.139 -1.381 -1.501 -1.018 ...
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ : NULL
##   .. .. ..$ : chr [1:4] "Sepal.Length" "Sepal.Width" "Petal.Length" "Petal.Width"
##   .. ..- attr(*, "scaled:center")= Named num [1:4] 5.84 3.06 3.76 1.2
##   .. .. ..- attr(*, "names")= chr [1:4] "Sepal.Length" "Sepal.Width" "Petal.Length" "Petal.Width"
##   .. ..- attr(*, "scaled:scale")= Named num [1:4] 0.828 0.436 1.765 0.762
##   .. .. ..- attr(*, "names")= chr [1:4] "Sepal.Length" "Sepal.Width" "Petal.Length" "Petal.Width"
##  $ unit.classif    : num [1:150] 3 32 21 21 1 50 11 13 31 33 ...
##  $ distances       : num [1:150] 0.1094 0.0449 0.137 0.1935 0.236 ...
##  $ grid            :List of 6
##   ..$ pts              : num [1:100, 1:2] 1.5 2.5 3.5 4.5 5.5 6.5 7.5 8.5 9.5 10.5 ...
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ : NULL
##   .. .. ..$ : chr [1:2] "x" "y"
##   ..$ xdim             : num 10
##   ..$ ydim             : num 10
##   ..$ topo             : chr "hexagonal"
##   ..$ neighbourhood.fct: Factor w/ 2 levels "bubble","gaussian": 1
##   ..$ toroidal         : logi FALSE
##   ..- attr(*, "class")= chr "somgrid"
##  $ codes           :List of 1
##   ..$ : num [1:100, 1:4] -1.235 -1.013 -0.845 -0.496 -0.425 ...
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ : chr [1:100] "V1" "V2" "V3" "V4" ...
##   .. .. ..$ : chr [1:4] "Sepal.Length" "Sepal.Width" "Petal.Length" "Petal.Width"
##  $ changes         : num [1:500, 1] 0.018 0.0215 0.0213 0.0212 0.0229 ...
##  $ alpha           : num [1:2] 0.05 0.01
##  $ radius          : num [1:2] 2 0
##  $ na.rows         : int(0) 
##  $ user.weights    : num 1
##  $ distance.weights: num 1
##  $ whatmap         : int 1
##  $ maxNA.fraction  : int 0
##  $ dist.fcts       : chr "euclidean"
##  - attr(*, "class")= chr "kohonen"

plot(ads.model, type = "mapping", pchs = 19, shape = "round")

neurony<-as.data.frame( ads.model$codes)

dd = (dist(neurony, method = "euclidean"))
fitc <- hclust(dd, method="ward.D")

plot(fitc, hang=-1)

source("http://addictedtor.free.fr/packages/A2R/lastVersion/R/code.R")
op = par(bg = "#EFEFEF")
par(mfrow=c(1,1))

wys<-c(0,fitc$height)
Mojena1<-mean(wys)+1.25* sd(wys)
Mojena1

## [1] 12.05832

A2Rplot(fitc, k =3 , boxes = TRUE, col.up = "gray50", 
        col.down = c("#FF6B6B","#8470FF","green4","#66CDAA","#8B7E66","grey"), main="Klasyfikacja" )

groupes <- cutree(fitc,k=3)
table(groupes)

## groupes
##  1  2  3 
## 25 39 36

plot(ads.model,type="mapping",bgcol=c("steelblue1","sienna1","yellowgreen","grey","pink")[groupes])
add.cluster.boundaries(ads.model,clustering=groupes)

wnk.korelacje.kofenetyczne <- c()
met.dist <- c( "euclidean")
met.hcl <- c("single", "complete", "average","ward.D","centroid")

for(i in 1:1){ for(j in 1:5){ dds = dist(neurony, method = met.dist[i])
hcdds = hclust((dds), method = met.hcl[j])
hcdds.c = cophenetic(hcdds)
korelacja.kofenetyczna = cor(hcdds.c, dds)
wnk.korelacje.kofenetyczne = c(wnk.korelacje.kofenetyczne, korelacja.kofenetyczna)}}

wnk.korelacje.kofenetyczne = matrix(round( wnk.korelacje.kofenetyczne, 5), ncol = 1)

colnames(wnk.korelacje.kofenetyczne)<-"euclidean"
met.hcl1 <- c("single", "complete", "average","ward.D", "centroid")
rownames(wnk.korelacje.kofenetyczne)<-met.hcl1
wnk.korelacje.kofenetyczne

##          euclidean
## single     0.66778
## complete   0.58527
## average    0.78267
## ward.D     0.74987
## centroid   0.77579