R/mod_phenotypic.R

In Viinky-Kevs/microsoftAI: GUI for phenotypic and genotypic analysis

#' phenotypic UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
mod_phenotypic_ui <- function(id){
  ns <- NS(id)
  tagList(
    sidebarLayout(
      sidebarPanel(tags$h3("Phenotypic analysis in genebanks"),
                   tags$p('This work is in the framework of the project "
                          To use AI tools for multidimensional data analysis 
                          to understand and promote biodiversity in plant 
                          germplasm banks (Phaseolus case)" led by AGROSAVIA, 
                          UNAL and Alianza Bioversity-CIAT from a cooperation 
                          agreement. the project objective is to "To use AI 
                          tools for multidimensional data analysis to understand 
                          and promote biodiversity in plant germplasm banks 
                          (Phaseolus case).'),
                   shiny::fileInput(ns("filecsv"), "Choose a CVS file",
                                    multiple = F,
                                    accept = c("text/csv",
                                               "text/comma-separated-values, text/plain",
                                               ".csv"),
                                    buttonLabel = "Uploading...")
      ),
      mainPanel(
                tags$h3("Model"),
                verbatimTextOutput(ns('modelF')),
                plotOutput(ns("modFit")),
                tags$h3('Confusion matrix'),
                tags$p('Table of confusion of the training data of 
                       the common bean races classification.'),
                plotOutput(ns('con_matrix'))
      )
    )
  )
}
    
#' phenotypic Server Functions
#'
#' @noRd 
#' @import readr
#' @import tidyverse
#' @import dplyr
#' @import readxl
#' @import readr
#' @import mice
#' @import imputeTS
#' @import knitr
#' @import rgl
#' @import randomForest
#' @import caTools
#' @import randomForestExplainer
#' @import dplyr
#' @import ranger
#' @import vegan
#' @import pvclust
#' @import ape
#' @import nnet
#' @import NeuralNetTools
#' @import tidyr
#' @import ggplot2
#' @import openxlsx
#' @import cluster
#' @import ggdendro
#' @import factoextra
#' @import foreach
#' @import gridExtra
#' @import DT
#' @import caret
#' @import NbClust
#' @import dendextend
#' @import pals
#' @import expss
#' @import e1071
#' @import ROCR
#' @import pROC
#' @import aricode
#' @import dendextend
#' @import fpc
#' @import mclust
#' @import corrplot
#' @import scales
#' @import ggpubr 

mod_phenotypic_server <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    mod_import_data_server("import_data_ui_1")
    
    
    model <- reactive({
      tryCatch(
        {
          # Import data from module import_data
          racesR <- read.csv(input$filecsv$datapath)
        },
        error = function(e){
          stop(safeError(e))
        }
      )
      
      ## Name data #### 
      
      data <- racesR
      
      ### Convert double data to factor ### 
      indx <- sapply(data, is.double)
      data[indx] <- lapply(data[indx], function(data) as.factor(as.double(data)))
      
      ### Convert factor data to double ### 
      
      data$P100S <- as.numeric(data$P100S) 
      data$DAF <- as.numeric(data$DAF)
      data$DAM <- as.numeric(data$DAM)
      data$LONG_SEM <- as.numeric(data$LONG_SEM)
      data$ANCHO_SEM <- as.numeric(data$ANCHO_SEM)
      data$GRUESO_SEM <- as.numeric(data$GRUESO_SEM)
      data$Races <- as.factor(data$Races)
      
      ######### ML ######################
      
      Datos <- as.data.frame(data[,-1]) 
      missingcols <- sapply(Datos, function(x) { any(is.na(x)) })
      tcontrol <- trainControl(method="repeatedcv", number=50, repeats=3)
      set.seed(123)
      
      # replace data by keeping only those variables that don't have missing data
      data <- Datos[ , !missingcols]
      
      data %>% dplyr::group_by(Races) %>% summarise(n = n()) 
      
      # create training and test sets
      inTrain <- caret::createDataPartition(y = data$Races, p = 0.6, list = FALSE)
      
      # subset
      training <- data[inTrain, ]
      testing <- data[-inTrain, ]
      
      training$Races<-as.factor(training$Races)
      testing$Races<-as.factor(testing$Races)
      
      metric <- "Accuracy"
      mtry <- sqrt(ncol(training))
      modFitN <- caret::train(Races~., method = "rf", 
                              data = training[], trControl = tcontrol, 
                              metric=metric, tuneLength=15)
    })
    
    output$modelF <- renderPrint({
      modFitN <- model()
      
      print(modFitN)
      
    })
    
    output$modFit <- renderPlot({
      
      modFitN <- model()
      
      plot(modFitN)
      
    })
    
    output$con_matrix <- renderPlot({
      
      modFitN <- model()
      
      modFit.rfN <- randomForest::randomForest(Races ~., data = training[], 
                                               mtry= modFitN$bestTune$mtry)
      
      ### Confusion matrix ### 
      
      TablaE <- as.table(modFit.rfN$confusion)
      TablaE<-as.data.frame(TablaE)
      
      TablaE <- TablaE[1:36, ]
      
      ### Training confusion ### 
      
      ggplot(TablaE, aes(x=Var1, y=Var2, fill=Freq)) +
        geom_tile(color="black") + theme_bw() + coord_equal() +
        scale_fill_distiller(palette="Greys", direction=1) +
        guides(fill=F) + # removing legend for `fill`
        labs(title = "Training Confusion Matrix") + # using a title instead
        geom_text(aes(label=Freq), color="black") + theme(axis.text.x = element_text(angle = 90, hjust = 1), axis.title.x=element_blank(), axis.title.y=element_blank()) 
      
    })
    
  })
}
    
## To be copied in the UI
# mod_phenotypic_ui("phenotypic_ui_1")
    
## To be copied in the server
# mod_phenotypic_server("phenotypic_ui_1")