SOM

server1.R

# based on Manuel Bernal's code

######## SOM GENERATOR ###########
#Loading Packages needed
library(png) # For writePNG function
library(kohonen)
library(shiny)
library(ggplot2)
library(jsonlite)
library(Hmisc)
library(gridExtra)
options(shiny.maxRequestSize = 500 * 1024 ^ 2)#maximum 500mb file


#Start shiny server
shinyServer(function(input, output, session) {
  #Reading file, inputs must be numeric
  dataInput <- reactive({
    inFile <- input$file1
    players <- read.csv(inFile$datapath, header = input$header, sep = input$sep,
                        stringsAsFactors = FALSE)
  })
  #Generate SOM
  generateSOM <- reactive({
    head(dataInput())
    set.seed(1234)
    som(scale(dataInput()), grid = somgrid(input$slider1, input$slider2, input$fig)) #fig in "rectangular", "hexagonal"
  })
  #Generate Graphs
  generateGraph <- function(){
    if (is.null(input$file1))
      return(NULL)
    else{
      coolBlueHotRed <- function(n, alpha = 1) {
        rainbow(n, end = 4 / 6, alpha = alpha)[n:1]
      }
      plot(generateSOM(), type = input$select, main = "SOM", palette.name = coolBlueHotRed)
    }
  }
  
  #Converts SOM to table
  somToTable <- function(){
    as.table( as.matrix(generateSOM()) )
  }
  
  #RenderGraph
  output$visual <- renderPlot({
    generateGraph()
  }
  ,height = 800, width = 800 )
  #DownloadImpage
  output$downloadData <- downloadHandler(
    filename = "shiny_som_plot.png",
    content = function(file) {
      png(file, width = 800, height = 800)
      generateGraph()
      dev.off()
    })
  #Download structure
  output$downloadTabla <- downloadHandler(
    filename = "shiny_som_data.csv",
    content = function(file) {
      write.table(somToTable(), file, sep = ",",row.names = FALSE)
    }
  )
  
  output$table <- DT::renderDataTable(
    if (is.null(input$file1))
      return(NULL)
    else{
      DT::datatable(dataInput(), options = list(searching = FALSE))
    }
  )
  
  output$histogram <- renderPlot({
    if (is.null(input$file1)) 
      return(NULL) 
    else {
      hist.data.frame(dataInput())
    }
  }, height = 800, width = 800)
  
  output$property <- renderPlot({
    if (is.null(input$file1))
      return(NULL)
    else{
      coolBlueHotRed <- function(n, alpha = 0.5) {rainbow(n, end = 4/6, alpha = alpha)[n:1]}
      som_model <- generateSOM()
      col <- ncol(som_model$data)
      if (col > 9) {par(mfrow = c(4, 4))}
      else if (col > 4) {par(mfrow = c(3, 3))}
      else {par(mfrow = c(2, 2))}
      for (i in 1:min(col, 9)) {
          #plot(som_model, type = "property", property = som_model$codes[,i], main = colnames(som_model$data)[i], palette.name = coolBlueHotRed)
          var_unscaled <- aggregate(as.numeric(dataInput()[[i]]), by=list(som_model$unit.classif), FUN=mean, simplify=TRUE) 
          names(var_unscaled) <- c("Node", "Value") # Add in NA values for non-assigned nodes. 
          # find missing nodes 
          missingNodes <- which(!(seq(1,nrow(som_model$codes)) %in% var_unscaled$Node)) 
          # Add them to the unscaled variable data frame 
          var_unscaled <- rbind(var_unscaled, data.frame(Node=missingNodes, Value=NA)) 
          # order this data frame 
          var_unscaled <- var_unscaled[order(var_unscaled$Node),]
          impute_var_unscaled <- cbind(var_unscaled, normalised = som_model$codes[,i])
          impute_arg <- aregImpute(normalised ~ Value, data = impute_var_unscaled, n.impute = 1)
          impute_var_unscaled[is.na(impute_var_unscaled$Value),]<-impute_arg$imputed$Value
          plot(som_model, type = "property", property=impute_var_unscaled$Value, main=colnames(som_model$data)[i], palette.name=coolBlueHotRed)
      }
    }
  }
  , height = 800, width = 800 )
  
  output$cluster <- renderPlot({
    if (is.null(input$file1))
      return(NULL)
    else{
      som_model <- generateSOM()
      som_cluster <- cutree(hclust(dist(som_model$codes)), input$clusterSize)
      pretty_palette <- c("#1f77b4", "#ff7f0e", "#2ca02c", "#d62728", "#9467bd", "#8c564b", "#e377c2", "#76b7b2")
      if (input$clusterChart) {
        par(mfrow = c(2, 2))
        codes <- som_model$codes
        wss <- (nrow(codes) - 1) * sum(apply(codes, 2, var))
        for (i in 2:15) {
          wss[i] <- sum(kmeans(codes, centers = i)$withinss)
        }
        plot(wss, main = "Cluster WSS", xlab = "no of clusters", cex = 2, pch = 19)
        #plot.new()
        pca <- prcomp(som_model$codes, center = TRUE, scale. = TRUE)
        plot(pca$x[, 1], pca$x[, 2],col = som_cluster, pch = 19, cex =2, main = "PCA", xlab = "PC1", ylab = "PC2")

      }else{
        par(mfrow = c(1, 2))
      }
      plot(som_model, type = "codes", main = "SOM Code")
      plot(som_model, type = "mapping", bgcol = pretty_palette[som_cluster], main = "Clusters")
      add.cluster.boundaries(som_model, som_cluster)
    }
  }
  , height = 800, width = 800 )
  
  output$info <- renderText({
    if (is.null(input$file1) | is.null(input$plot_click))
      return(NULL)
    else {
      x <- 1
      y <- 4.82
      xmax <- 6
      ymax <- 0.36
      y_offset <- (ymax - y) / 5
      yn <- ceiling( (input$plot_click$y - y) / y_offset)
      if (yn %% 2 == 0) {
        x <- x - 0.5
        xmax <- xmax - 0.5
      }
      x_offset <- (xmax - x) / 5
      xn <- ceiling( (input$plot_click$x - x) / x_offset)
      paste0("x=", input$plot_click$x, "\ny=", input$plot_click$y, "\ncell = ", xn, ",", yn )
      
      # grid <- som_model$grid$pts
      # gridFrame <- data.frame(xvar = grid[,1], yvar = grid[,2])
      # print(str(gridFrame))
      # print(nearPoints(som_model, input$plot_click, xvar = "xvar", yvar = "yvar", maxpoints = 1))
    }
    
  })
  
  output$distribution <- renderPlot({
    if (is.null(input$file1) | is.null(input$plot_click))
      return(NULL)
    else{
      x <- 1
      y <- 4.82
      xmax <- 6
      ymax <- 0.36
      y_offset <- (ymax - y) / 5
      yn <- ceiling( (input$plot_click$y - y) / y_offset)
      if (yn %% 2 == 0) {
        x <- x - 0.5
        xmax <- xmax - 0.5
      }
      x_offset <- (xmax - x) / 5
      xn <- ceiling( (input$plot_click$x - x) / x_offset)
      som_model <- generateSOM()
      population <- cbind(dataInput(), som = som_model$unit.classif)
      column <- input$slider1
      index <- xn + (yn - 1) * column
      print(index)
      cell <- population[population$som == index, ]
      combined <- rbind(cbind(population, label = "population"), cbind(cell, label = "cell"))
      par(mfrow = c(2, 2))
      p1 <- ggplot(combined, aes(x = combined[, 1]) ) + geom_density(aes(fill = label), alpha = 0.2) + xlab(names(combined)[1]) + guides(fill = FALSE)
      p2 <- ggplot(combined, aes(x = combined[, 2]) ) + geom_density(aes(fill = label), alpha = 0.2) + xlab(names(combined)[2]) + guides(fill = FALSE)
      p3 <- ggplot(combined, aes(x = combined[, 3]) ) + geom_density(aes(fill = label), alpha = 0.2) + xlab(names(combined)[3]) + guides(fill = FALSE)
      p4 <- ggplot(combined, aes(x = combined[, 4]) ) + geom_density(aes(fill = label), alpha = 0.2) + xlab(names(combined)[4]) + guides(fill = FALSE)
      grid.arrange(p1, p2, p3, p4, ncol = 2)
    }
  })
})