R/init_kohonen.R

In lorenalves/SITSSA:

# Call kohonen-dtw
# @title Cluster a set of satellite image time series using SOM
# @description
# This function runs Kohonen t times.
# @data Satelite image time series (result de get_time_series)

init_kohonen <-
  function (data.tb,
            grid_xdim = 5,
            grid_ydim = 5,
            rlen = 100,
            alpha = c(1),
            radius = 6,
            distance = "euclidean",
            iterations = 1) {


    samples = as_tibble(data.tb[[1]])
    samples$id_sample<- rep(1:dim(samples)[1])
    time_series = data.tb[[2]]

    #Inicializar as tibbles
    neurons_info_t.tb<-as_tibble()
    samples_info_t.tb<-as_tibble()

    k = 1
    for (k in 1:iterations)
    {
      som.ts <-
        kohonen::supersom(
          time_series,
          grid = somgrid(grid_xdim, grid_ydim , "rectangular", "gaussian", toroidal = FALSE),
          rlen = rlen,
          alpha = alpha,
          radius = radius,
          dist.fcts = distance,
          normalizeDataLayers = TRUE
        )


      #Adiciona no conjunto de dados de amostras o numero do neuronio onde ela foi alocada e o campo cluster.

      data_som.tb <- add_som_info_samples(samples, som.ts)


      #obtem o tamanho da grid de neuronios
      grid_size <- dim(som.ts$grid$pts)[1]

      #Label of neurons 1:size(grid_size)
      class_vector <- get_label_neurons (data_som.tb, grid_size)

      #atribui um inteiro as classes
      class_vector_int <- as.integer(factor(class_vector))

      #concatena  label e numero que representa o inteiro
      #na ordem dos neuronios 1 a n
      class_matrix <- cbind(class_vector, class_vector_int)

      table_class_matrix_id <- (unique(class_matrix))

      #Colocar na amostra o label do neuronio
      Neurons_ <- data_som.tb$id_neuron
      #Captura em  qual cluster a amostra foi alocada.
      label_neuron_sample <- class_matrix[Neurons_]
      data_som.tb$neuron_label <- label_neuron_sample


      table_samples<-tibble::as_tibble(list(
        id_sample= as.integer(data_som.tb$id_sample),
        original_label = as.character(data_som.tb$label),
        neuron_label = as.character(data_som.tb$neuron_label),
        id_neuron = as.integer(data_som.tb$id_neuron),
        iteration = as.integer(k)

      ))

      neighborhood<-get_neighbor_neurons(class_vector, som.ts)
      table_neurons<-neighborhood
      table_neurons$iteration<-k

      #Essas tabelas contem informacao com  todas as amostras em todas as iteracoes
      #ID_sample, original_label, neuron_label, ID_neuron, Iteration
      #Id_Neuron Neuron_label Iteration_Neuron
      samples_info_t.tb <- rbind(samples_info_t.tb,table_samples)
      neurons_info_t.tb <- rbind(neurons_info_t.tb,table_neurons)

    }
    result_som <-  structure(list(
      data = samples,
      sample_t.tb = samples_info_t.tb,
      neuron_t.tb = neurons_info_t.tb
    ),
    class = "SITSSA")
  }

add_som_info_samples <- function(data.tb, som.ts)
{
  #Adicionar numero do neuronio que a amostra foi alocada
  data.tb$id_neuron <- som.ts$unit.classif

  #adicionar campo cluster (Este campo mostra o label para que a amostra pertence de acordo com o SOM)
  data.tb$neuron_label <- "neuron_label"

  return (data.tb)

}

get_neighbor_neurons <- function (class_vector, som.ts,radius=1)
{
  Vizinhança_neuronios.tb <- as_tibble()
  grid_size <- dim(som.ts$grid$pts)[1]
  neuron=1
  for (neuron in 1:grid_size)
  {
    neurons_vizinhos<-which(unit.distances(som.ts$grid)[,neuron] == radius)
    class_vizinhos<-class_vector[neurons_vizinhos]

    count_vizinhos<-table(class_vizinhos)
    result_vizinhos_temporary.tb <- tibble::as_tibble(list(
      id_neuron= as.integer(neuron),
      neuron_label= as.character(class_vector[neuron]),
      #Id_Neighbor_Neuron = as.integer(neurons_vizinhos),
      label_neighbor_neuron =names(count_vizinhos),
      F_Neighbor = as.integer(count_vizinhos),
      P_Neighbor  = as.numeric(prop.table(count_vizinhos))
    ))

    Vizinhança_neuronios.tb <- rbind(Vizinhança_neuronios.tb, result_vizinhos_temporary.tb)

  }
  return (Vizinhança_neuronios.tb)

}


#Coloca o label em cada nome de acordo com a maioria
get_label_neurons <- function (data.tb, grid_size)
{
  class_vector <- vector()
  #Quantidade de neuronios alocados
  for (i in 1:grid_size)
  {
    #Pega os id's das amostras que foram alocadas no neuronio i
    #neuron_i <- which(dataResult.tb$neuron == i)
    neuron_i <- filter(data.tb, data.tb$id_neuron == i)$id_sample
    vb = neuron_i

    #o neuronio ? vazio?
    # vb <- is.null(neuron_i)
    if (length(vb) != 0)
    {
      alloc_neurons_i <- data.tb[neuron_i,]
      #count_i<- as.matrix(sits_labels(alloc_neurons_i))

      data.vec <- table(alloc_neurons_i$label)
      result.tb <- tibble::as_tibble(list(
        label = names(data.vec),
        count = as.integer(data.vec),
        freq  = as.numeric(prop.table(data.vec))
      ))

      max_class <- summarize(result.tb, max.pt = max(count))
      neuron_class <-
        filter(result.tb, result.tb$count == as.integer(max_class))$label
    } else if (length(vb) == 0)
    {
      neuron_class <- 'Noclass'
      #print("Empty Neuron")


    }
    #este vector contem o rotulo de cada neuronio
    class_vector[i] <- neuron_class


  }

  return (class_vector)

}