optiMod: Launch model with shiny

#
# This is the server logic of a Shiny web application. You can run the
# application by clicking 'Run App' above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)


shinyServer(function(input, output, session) {

  output$hist <- renderAmCharts({

    x <- data[, input$selectDesc]
    if(is.factor(x)){
      x <- as.character(x)
    }

    y <- data[, input$selectDesc2]
    if(is.factor(y)){
      y <- as.character(y)
    }


    if (!input$var2check){
      if(!is.numeric(x)){
        data2 <- as.data.frame(table(x))
        montitre <- paste ("Barplot of", input$selectDesc)
        Graph <- amBarplot(x = "x", y = "Freq"  , data = data2, main = montitre, groups_color = "#ad33ff")
      }else{
        montitre <- paste ("Histogram of", input$selectDesc)
        Graph <- amHist(x= x, xlab = input$selectDesc, ylab = "frequency", freq =TRUE,
                        export= TRUE, main = montitre, col = "#ad33ff", border = "#bd33ff")
      }
    }else{
      if(is.numeric(x) & is.numeric(y)){
        montitre <- paste ("Plot of", input$selectDesc)
        Graph <- amPlot(x = x, y = y, main = montitre, col = "#ad33ff")
      }

      if(is.character(x) & is.character(y)){
        data2 <- as.data.table(table(x, y))
        data2 <- dcast(data2, x~y)
        name <- as.vector(names(data2)[-1])
        ListGraph <- sapply(name, function(j){
          G <- amGraph(balloonText='<b>[[category]]: [[value]]</b>',
                       type = 'column',valueField = j, fillAlphas = 1, lineAlpha = 0, title = j)
          G
        }, simplify = FALSE, USE.NAMES = FALSE)
        Graph <- pipeR::pipeline(
          amSerialChart(categoryField = 'x'),
          setDataProvider(data2),
          setGraphs(ListGraph),
          setLegend(useGraphSettings = TRUE)
        )
      }
      if(is.numeric(x) & is.character(y)){
        formula <- as.formula(paste0(input$selectDesc, "~", input$selectDesc2))
        montitre <- paste ("Boxplot of", input$selectDesc2)

        df <- data.frame(y = y, x = x)
        names(df) <- c(input$selectDesc2, input$selectDesc)

        Graph <- amBoxplot(formula, data = df, main = montitre, col = "#ad33ff")
      }

      if(is.character(x) & is.numeric(y)){

        formula <- as.formula(paste0(input$selectDesc, "~", input$selectDesc2))
        montitre <- paste ("Boxplot of", input$selectDesc)
        df <- data.frame(y = y, x = x)
        names(df) <- c(input$selectDesc, input$selectDesc2)


        Graph <- amBoxplot(formula, data = df, main = montitre, col = "#ad33ff")
      }
      Graph
    }
  })

  #Page 2

  #Cvcol
  cvcol <- reactive({
    if (input$cvcol == 'Select a column'){
      cvcol <- createCv(data, columName = input$SelectColumn)
      return(cvcol)
    }
    if (input$cvcol == 'By kfolds'){
      cvcol <- createCv(data, kfolds = input$selectFolds)
      return(cvcol)
    }
  })

  #ntree
  ntreeReact <- reactive({
    if(!input$ntree){
      ntree <- input$selectNtree
      return(ntree)
    }else{
      ntree <- seq(input$ntreeMin, input$ntreeMax, by = input$ntreeBy)
      return(ntree)
    }
  })

  #mtry
  observe({
    if(!is.factor(data[, input$SelectY])){
      updateNumericInput(session, "selectMtry", value = round(ncol(data)/3,0))
    }else{
      updateNumericInput(session, "selectMtry", value = round(sqrt(ncol(data)), 0))
    }
  })
  observe({
    if(!is.factor(data[, input$SelectY])){
      updateNumericInput(session, "mtryMin", value = round(ncol(data)/3,0)-1)
      updateNumericInput(session, "mtryMax", value = round(ncol(data)/3,0)+1)
      updateNumericInput(session, "mtryBy", value = 1)
    }else{
      updateNumericInput(session, "mtryMin", value = round(sqrt(ncol(data)), 0)-1)
      updateNumericInput(session, "mtryMax", value = round(sqrt(ncol(data)), 0)+1)
      updateNumericInput(session, "mtryBy", value = 1)
    }
  })

  #reactive mtry
  mtryReact <- reactive({
    if(!input$mtry){
      mtry <- input$selectMtry
      return(mtry)
    }else{
      mtry <- seq(input$mtryMin, input$mtryMax, by = input$mtryBy)
      return(mtry)
    }
  })

  #maxnodes
  maxnodesReact <- reactive({
    if(!input$maxnodes){
      maxnodes <- input$selectMaxnodes
      return(maxnodes)
    }else{
      maxnodes <- seq(input$maxnodesMin, input$maxnodesMax, by = input$maxnodesBy)
      return(maxnodes)
    }
  })

  #nodesize
  observe({
    if(!is.factor(data[, input$SelectY])){
      updateNumericInput(session, "selectNodesize", value = 5)
    }else{
      updateNumericInput(session, "selectNodesize", value = 1)
    }
  })

  #reactive nodesize
  nodesizeReact <- reactive({
    if(!input$nodesize){
      nodesize <- input$selectNodesize
      return(nodesize)
    }else{
      nodesize <- seq(input$nodesizeMin, input$nodesizeMax, by = input$nodesizeBy)
      return(nodesize)
    }
  })
  #criterion
  observe({
    if(!is.factor(data[, input$SelectY])){
      updatePickerInput(session, "selectCriterion", choices= c("RMSE", "MAPE", "R2"))
    }else{
      if(nlevels(data[, input$SelectY]) > 2){
        updatePickerInput(session, "selectCriterion", choices= "CONF")
      }else{
        updatePickerInput(session, "selectCriterion", choices= c("AUC", "CONF"))
      }
    }
  })

  #Data
  RFGo <- reactive({
    input$GoModel
    isolate({
      y <- data[, input$SelectY]
      cvcol <- cvcol()
      namesX <- names(data)[which(!names(data)%in% c(input$SelectY))]
      x <- data[, namesX]
      ntree <- ntreeReact()
      mtry <- mtryReact()
      criterion <- input$selectCriterion
      #
      if(input$GoModel != 0){
        res <- rfMod(x = x, y = y, cvcol= cvcol, ntree= ntree, mtry = mtry,  criterion = criterion)
        res

      }
    })
  })

  output$boxparam <- renderUI({
    if(is.null(RFGo()))return(NULL)
    resScore <- RFGo()
    resScore <- resScore[(names(resScore)%in%c("param"))]
    resScore <- as.data.frame(resScore$param)
    resScore <- round(resScore, 3)


    out <- ""
    for(i in 1:length(resScore)){

      out <- paste0(out, exaBox(title = names(resScore)[i], value = resScore[i], icon = "thunParam.png",
                                width = 3, color = "paramCol"))

    }

      HTML(out)
  })

  output$boxscore<- renderUI({
    if(is.null(RFGo()))return(NULL)
    resScore <- RFGo()
    resScore <- resScore[(names(resScore)%in%c("RMSE", "MAPE", "R2", "AUC", "confusion"))]
    resScore <- as.data.frame(resScore)
    resScore <- round(resScore, 3)



    out <- ""
    for(i in 1:length(resScore)){
      out <- paste0(out, exaBox(title = names(resScore)[i], value = resScore[i], icon = ifelse(names(resScore)[i] == RFGo()$criterion, "mainSco.png", "gear.png"),
                                width = 4, color = "scoreCol"))

    }

    HTML(out)
  })


  output$graphOP <- renderAmCharts({
    input$GoModel
    isolate({
    if(is.null(RFGo())){
      return(NULL)
    }
    if(!is.factor(data[, input$SelectY])){
      plot(RFGo(), type = "obsPred", digits = 3, color = "#ad33ff")
    }
    })
  })

  output$varimp <- renderAmCharts({
    input$GoModel
    isolate({
    if(is.null(RFGo())){
      return(NULL)
    }
    # if(!is.factor(data[, input$SelectY])){
      plot(RFGo(), type = "importance", digits = 3, color = "#ad33ff")
    # }
    })
  })

  output$residuals <- renderAmCharts({
    input$GoModel
    isolate({
    if(is.null(RFGo())){
      return(NULL)
    }
    if(!is.factor(data[, input$SelectY])){
      plot(RFGo(), type = "residualPlot", digits = 3, color = "#ad33ff")
    }
  })
  })
  output$matrixConf <- renderAmCharts({
    input$GoModel
    isolate({
    if(is.null(RFGo())){
      return(NULL)
    }
    if(is.factor(data[, input$SelectY])){
      plot(RFGo(), type = "Matconf", digits = 3, color = "#ad33ff")
    }
    })
  })

  output$plotROC <- renderAmCharts({
    input$GoModel
    isolate({
      if(is.null(RFGo())){
        return(NULL)
      }
      if(is.factor(data[, input$SelectY])){
        plot(RFGo(), type = "ROC")
      }
    })
  })

  output$plotDec <- renderAmCharts({
    input$GoModel
    isolate({
      if(is.null(RFGo())){
        return(NULL)
      }
      if(is.factor(data[, input$SelectY])){
        plot(RFGo(), type = "decileProb")
      }
    })
  })

  output$plotDensity <- renderPlot({
    input$GoModel
    isolate({
      if(is.null(RFGo())){
        return(NULL)
      }
      if(is.factor(data[, input$SelectY])){
        plot(RFGo(), type = "density")
      }
    })
  })



  output$graphModel <- renderUI({
    input$GoModel
    isolate({
    if(!is.factor(data[, input$SelectY])){
    return(div(
      fluidRow(
        column(6, align="center",
               amChartsOutput("graphOP")
        ),
        column(6, align="center",
               amChartsOutput("varimp"))


        , width = 9 ),
      br(), br(), br(),
      fluidRow(
        column(width=3),
        column(6, align = "center",
               amChartsOutput("residuals"))

      )

    ))
    }

      if(nlevels(data[, input$SelectY]) == 2){
        return(div(
          fluidRow(
            column(6, align="center",
                   amChartsOutput("matrixConf")
            ),
            column(6, align="center",
                   amChartsOutput("varimp"))


            , width = 9 ),
          br(), br(), br(),
          fluidRow(
            column(6, align="center",
                   amChartsOutput("plotROC")
            ),
            column(6, align="center",
                   amChartsOutput("plotDec"))


            , width = 9 ),
          br(), br(), br(),
          fluidRow(
            column(width=3),
            column(6, align = "center",
                   plotOutput("plotDensity"))

          )
        ))


}
      if(nlevels(data[, input$SelectY]) > 2){
      return(div(
        fluidRow(
          column(12, align="center",
                 amChartsOutput("matrixConf")
          ),
          column(6, align="center",
                 amChartsOutput("varimp"))


          , width = 9 )
      ))
    }

  })
  })



})#fin shinserver