R/server.R

Defines functions server

server = function(input, output, session) {
  ##################################################

                    #load data

  ##################################################
  results = shiny::reactive({
    results = getData(get_data_path())

    # replace names of feature selection methods
    results$fs_results$ids = sapply(results$fs_results$ids, replaceMethodName, USE.NAMES = F)
    results$agg_fs_results$ids = sapply(results$agg_fs_results$ids, replaceMethodName, USE.NAMES = F)

    results$fs_results$classifier = sapply(results$fs_results$classifier, replaceClassifierName, USE.NAMES = F)
    results$agg_fs_results$classifier = sapply(results$agg_fs_results$classifier, replaceClassifierName, USE.NAMES = F)


    results$fs_results$dataset = sapply(results$fs_results$dataset, replaceDatasetName, USE.NAMES = F)
    results$agg_fs_results$dataset = sapply(results$agg_fs_results$dataset, replaceDatasetName, USE.NAMES = F)



    return(results)
  })

  resultsFilterred = shiny::reactive({
    req(results())

    # save results temporarly
    results = results()$fs_results

    input$submit_loc
    datasetsSelected = isolate(input$datasetsSelected)
    methodsSelected = isolate(input$methodsSelected)
    classifiersSelected = isolate(input$classifiersSelected)

    # filter by dataset if given
    if (!is.null(datasetsSelected) && length(datasetsSelected) > 0) {
      results = results %>%
        dplyr::filter(dataset %in% datasetsSelected)
    }

    # filter by method if given
    if (!is.null(methodsSelected) && length(methodsSelected) > 0) {
      methodsSelected = c(methodsSelected, c("full_predictor"))
      results = results %>%
        dplyr::filter(ids %in% methodsSelected)
    }

    # filter by classifier if given
    if (!is.null(classifiersSelected) && length(classifiersSelected) > 0) {
      results = results %>%
        dplyr::filter(classifier %in% classifiersSelected)
    }

    return(results)
  })

  aggrResultsFilterred = shiny::reactive({
    req(resultsFilterred())
    req(results())

    loadAggrResults(resultsFilterred(), results()$agg_fs_results)
  })

  fullPredResults = shiny::reactive({
    data = loadFullPredResults(get_data_path())
    data$classifier = sapply(data$classifier, replaceClassifierName, USE.NAMES = F)
    data$dataset = sapply(data$dataset, replaceDatasetName, USE.NAMES = F)

    return(data)
  })

  fullPredResultsFilterred = shiny::reactive({
    req(fullPredResults())

    # save results temporarly
    results = fullPredResults()

    input$submit_loc
    datasetsSelected = isolate(input$datasetsSelected)
    classifiersSelected = isolate(input$classifiersSelected)

    # filter by dataset if given
    if (!is.null(datasetsSelected) && length(datasetsSelected) > 0) {
      results = results %>%
        dplyr::filter(dataset %in% datasetsSelected)
    }

    # filter by classifier if given
    if (!is.null(classifiersSelected) && length(classifiersSelected) > 0) {
      results = results %>%
        dplyr::filter(classifier %in% classifiersSelected)
    }

    return(results)
  })

  iterationResults = shiny::reactive({
    results = getIterationData(get_data_path())
    results$method = sapply(results$method, replaceMethodName, USE.NAMES = F)
    results$classifier = sapply(results$classifier, replaceClassifierName, USE.NAMES = F)
    results$dataset = sapply(results$dataset, replaceDatasetName, USE.NAMES = F)

    return(results)
  })

  iterationResultsAggrFilterred = shiny::reactive({
    req(iterationResults())

    input$submit_loc
    datasetsSelected = isolate(input$datasetsSelected)
    methodsSelected = isolate(input$methodsSelected)
    classifiersSelected = isolate(input$classifiersSelected)

    results = iterationResults() %>%
      dplyr::group_by(dataset, method, classifier, fw.abs, dob) %>%
      dplyr::summarize(acc = 1 - mean(mmce.test.mean)) %>%
      dplyr::group_by(dataset, method, classifier, fw.abs) %>%
      dplyr::summarize(acc = max(acc))

    # filter by dataset if given
    if (!is.null(datasetsSelected) && length(datasetsSelected) > 0) {
      results = results %>% dplyr::filter(dataset %in% datasetsSelected)
    }

    # filter by method if given
    if (!is.null(methodsSelected) && length(methodsSelected) > 0) {
      methodsSelected = c(methodsSelected, c("full_predictor"))
      results = results %>%
        dplyr::filter(method %in% methodsSelected)
    }

    # filter by classifier if given
    if (!is.null(classifiersSelected) && length(classifiersSelected) > 0) {
      results = results %>%
        dplyr::filter(classifier %in% classifiersSelected)
    }
  })

  tableResults = shiny::reactive({
    req(aggrResultsFilterred())

    table_results(aggrResultsFilterred(), fullPredResultsFilterred())
  })

  accDiffResults = shiny::reactive({
    req(aggrResultsFilterred())
    req(fullPredResultsFilterred())

    getAccDiffData(aggrResultsFilterred(), fullPredResultsFilterred())
  })

  datasets = shiny::reactive({
    req(results())
    unique(results()$fs_results$dataset)
  })

  methods = shiny::reactive({
    req(results())
    unique(((results()$fs_results) %>% dplyr::filter(ids != "full_predictor"))$ids)
  })

  classifiers = shiny::reactive({
    req(results())
    unique(results()$fs_results$classifier)
  })

  ##################################################

                      #Filters

  ##################################################
  # filter for datasets
  output$datasetFilter = renderUI({
    shinyWidgets::pickerInput(
      "datasetsSelected",
      label = "Choose a data set",
      choices = datasets(),
      multiple = T,
      options = list(
        'actions-box' = TRUE
      )
    )
  })

  # filter for methods
  output$methodFilter = renderUI({
    shinyWidgets::pickerInput(
      "methodsSelected",
      label = "Choose a method",
      choices = methods(),
      multiple = T,
      options = list('actions-box' = TRUE, 'liveSearch' = TRUE)
    )
  })

  # filter for classifier
  output$classiferFilter = renderUI({
    shinyWidgets::pickerInput(
      "classifiersSelected",
      label = "Choose a classifer",
      choices = classifiers(),
      multiple = T,
      options = list('actions-box' = TRUE)
    )
  })

  ##################################################

                  #plots and tables

  ##################################################
  # calculate height for method scatter based on number of classifiers and datasets selected
  plotheightScatter = reactive({
    req(aggrResultsFilterred())

    height = input$dimension[1] / 1.5 / as.numeric(length(unique(aggrResultsFilterred()$classifier))) * as.numeric(length(unique(aggrResultsFilterred()$dataset)))

    if(length(unique(aggrResultsFilterred()$dataset)) <= 1 && length(unique(aggrResultsFilterred()$classifier)) > 2) {
      height = height * as.numeric(length(unique(aggrResultsFilterred()$classifier)))
    }

    return(height)
  })

  # method scatter plot
  methodScatterPlot = reactive({
    req(aggrResultsFilterred())
    req(fullPredResultsFilterred())

    if (!is.null(isolate(input$datasetsSelected)) && !is.null(isolate(input$methodsSelected)) && !is.null(isolate(input$classifiersSelected))) {
      plotAggrResult(aggrResultsFilterred(), fullPredResultsFilterred())
    }
  })

  output$method_scatter_plot = renderPlot({
    req(methodScatterPlot())
    methodScatterPlot()
  }, height = plotheightScatter)

  # calculate height for acc_diff plot based on number of datasets selected
  plotheightAccDiff = reactive({
    req(aggrResultsFilterred())
    # browser()

    return((input$dimension[1] / 2) * ceiling((as.numeric(length(unique(aggrResultsFilterred()$dataset)))) / 2))
  })

  accDiffPlot = reactive({
    req(accDiffResults())
    req(plotheightAccDiff())

    if (!is.null(isolate(input$datasetsSelected)) && !is.null(isolate(input$methodsSelected)) && !is.null(isolate(input$classifiersSelected))) {
      createAccDiffBarPlot(accDiffResults()) %>%
        plotly::layout(
          height = plotheightAccDiff(),
          margin = list(l = 100, t = 25, r = 250, b = 200)
        )
    }
  })

  # method acc_diff_plot
  output$acc_diff_plot = plotly::renderPlotly({
    req(accDiffPlot())
    accDiffPlot()
  })

  # create plot for accuracy difference compared to full_predictor
  output$acc_diff_ui = renderUI({
    req(plotheightAccDiff())
    plotly::plotlyOutput("acc_diff_plot", height = paste(plotheightAccDiff(), "px", sep = ""))
  })

  output$acc_diff_table = DT::renderDataTable({
    req(accDiffResults())
    accDiffResults()
  }, options = list(scrollX = TRUE))

  # create table for results
  output$table_results = DT::renderDataTable({
    req(tableResults())

    tableResults()
  }, options = list(scrollX = TRUE))

  # format table result to latex
  output$table_results_latex = renderPrint({
    req(tableResults())

    formatAggrResultsToLatex(tableResults())
  })

  # create table for selected features
  output$table_selected_features =  DT::renderDataTable({
    req(resultsFilterred())
    input$submit_loc

    resultsFilterred() %>%
      dplyr::filter(ids != "full_predictor") %>%
      dplyr::select(ids, dataset, classifier, features, numFeatures)

  }, filter = "top")

  feat_freq_plot = reactive({
    req(resultsFilterred())

    if(!is.null(input$datasetsSelected) && length(input$datasetsSelected) > 0) {
      plot_feature_freq(resultsFilterred())
    }
  })



  # create plot for feature freq
  output$feature_freq_plot = plotly::renderPlotly({
    # input$submit_loc
    req(feat_freq_plot())
    feat_freq_plot()
  })









  iteration_line_height = reactive({
    req(iterationResultsAggrFilterred())

    height = input$dimension[1] / as.numeric(length(unique(iterationResultsAggrFilterred()$classifier))) * as.numeric(length(unique(iterationResultsAggrFilterred()$dataset)))

    return(height)
  })


  iteration_line = reactive({
    req(iterationResultsAggrFilterred())

    if (!is.null(isolate(input$datasetsSelected)) && !is.null(isolate(input$methodsSelected)) && !is.null(isolate(input$classifiersSelected))) {
      plotIterationResults(iterationResultsAggrFilterred())
    }
  })

  output$iteration_line_graph = shiny::renderPlot({
    req(iteration_line())
    req(iteration_line_height())

    iteration_line()
  }, height = iteration_line_height)

  output$pixel_plot = renderPlot({
    req(resultsFilterred())

    # input$submit_loc

    if (!is.null(isolate(input$datasetsSelected)) && !is.null(isolate(input$methodsSelected)) && !is.null(isolate(input$classifiersSelected))) {
      # browser()
      plot_pixel((resultsFilterred() %>% dplyr::filter(dataset == "MNIST" | dataset == "PixRaw10P")))
    }
  })


  runtime_bar = reactive({
    req(aggrResultsFilterred())

    if (!is.null(isolate(input$datasetsSelected)) && !is.null(isolate(input$methodsSelected)) && !is.null(isolate(input$classifiersSelected))) {
      plot_runtime((aggrResultsFilterred() %>% dplyr::filter(ids != "full_predictor")))
    }
  })

  output$plot_runtime = plotly::renderPlotly({
    req(runtime_bar())
    runtime_bar()
  })


  ##################################################

                  # Downloads

  ##################################################

  download_method_scatter <- downloadHandler(
    filename = function() { "method_scatter.png" },
    content = function(file) {
      ggplot2::ggsave(
        file,
        plot = methodScatterPlot(),
        width = input$methodScatterWidth,
        height = input$methodScatterHeight,
        dpi = input$methodScatterDpi,
        units = "in",
        device = "png"
      )
    }
  )

  output$downloadbtn_method_scatter = renderUI({
    input$submit_loc
    req(download_method_scatter)
    shinyWidgets::dropdownButton(
      shiny::numericInput(inputId = "methodScatterWidth", label = "width", value = 12),
      shiny::numericInput(inputId = "methodScatterHeight", label = "height", value = 12),
      shiny::numericInput(inputId = "methodScatterDpi", label = "dpi", value = 300),
      download_method_scatter,
      circle = F,
      status = "success",
      width = "50px",
      icon = shiny::icon("file-download"),
      size = "xs"
    )
  })

  download_acc_diff_plot <- downloadHandler(
    filename = function() { "acc_diff_plot.png" },
    content = function(file) {
      # get path of file and split by "/
      path = strsplit(file, "/")[[1]]

      # get filename
      filename = path[length(path)]

      # create path without filename
      path_wo_file = paste(path[-length(path)], collapse = "/")

      # create file with orca in current folder
      plotly::orca(
        accDiffPlot(),
        file = filename,
        width = input$accDiffWidth,
        height = input$accDiffHeight
      )

      # move file to path expected by downloadHandler
      filesstrings::file.move(filename, path_wo_file)
    }
  )

  output$downloadbtn_acc_diff_plot = renderUI({
    input$submit_loc
    req(download_method_scatter)
    shinyWidgets::dropdownButton(
      shiny::numericInput(inputId = "accDiffWidth", label = "width", value = 500),
      shiny::numericInput(inputId = "accDiffHeight", label = "height", value = 500),
      # shiny::numericInput(inputId = "accDiffDpi", label = "dpi", value = 300),
      download_acc_diff_plot,
      circle = F,
      status = "success",
      width = "50px",
      icon = shiny::icon("file-download"),
      size = "xs"
    )
  })

  download_feature_freq_bar <- downloadHandler(
    filename = function() { "feature_freq_bar.png" },
    content = function(file) {
      req(feat_freq_plot())
      # get path of file and split by "/
      path = strsplit(file, "/")[[1]]

      # get filename
      filename = path[length(path)]

      # create path without filename
      path_wo_file = paste(path[-length(path)], collapse = "/")

      # create file with orca in current folder
      plotly::orca(
        feat_freq_plot() %>% plotly::layout(margin = list(l = 250)),
        file = filename,
        width = input$featFreqWidth,
        height = input$featFreqHeight
      )

      # move file to path expected by downloadHandler
      filesstrings::file.move(filename, path_wo_file)
    }
  )

  output$downloadbtn_feat_freq_bar = renderUI({
    input$submit_loc
    req(download_feature_freq_bar)
    shinyWidgets::dropdownButton(
      shiny::numericInput(inputId = "featFreqWidth", label = "width", value = 500),
      shiny::numericInput(inputId = "featFreqHeight", label = "height", value = 500),
      # shiny::numericInput(inputId = "accDiffDpi", label = "dpi", value = 300),
      download_feature_freq_bar,
      circle = F,
      status = "success",
      width = "50px",
      icon = shiny::icon("file-download"),
      size = "xs"
    )
  })

  download_iteration_line <- downloadHandler(
    filename = function() { "iteration_line_graph.png" },
    content = function(file) {
      req(iteration_line())

      ggplot2::ggsave(
        file,
        plot = iteration_line(),
        width = input$iterationLineWidth,
        height = input$iterationLineHeight,
        dpi = input$iterationLineDpi,
        units = "in",
        device = "png"
      )
      # get path of file and split by "/
      # path = strsplit(file, "/")[[1]]
      #
      # # get filename
      # filename = path[length(path)]
      #
      # # create path without filename
      # path_wo_file = paste(path[-length(path)], collapse = "/")
      #
      # # create file with orca in current folder
      # plotly::orca(
      #   iteration_line(),
      #   file = filename,
      #   width = input$iterationLineWidth,
      #   height = input$iterationLineHeight
      # )
      #
      # # move file to path expected by downloadHandler
      # filesstrings::file.move(filename, path_wo_file)
    }
  )

  output$downloadbtn_iteration_line = renderUI({
    input$submit_loc
    req(download_iteration_line)
    shinyWidgets::dropdownButton(
      shiny::numericInput(inputId = "iterationLineWidth", label = "width", value = 12),
      shiny::numericInput(inputId = "iterationLineHeight", label = "height", value = 12),
      shiny::numericInput(inputId = "iterationLineDpi", label = "dpi", value = 300),
      # shiny::numericInput(inputId = "accDiffDpi", label = "dpi", value = 300),
      download_iteration_line,
      circle = F,
      status = "success",
      width = "50px",
      icon = shiny::icon("file-download"),
      size = "xs"
    )
  })














  download_runtime_bar <- downloadHandler(
    filename = function() { "runtime.png" },
    content = function(file) {
      req(runtime_bar())
      # get path of file and split by "/
      path = strsplit(file, "/")[[1]]

      # get filename
      filename = path[length(path)]

      # create path without filename
      path_wo_file = paste(path[-length(path)], collapse = "/")

      # create file with orca in current folder
      plotly::orca(
        runtime_bar() %>% plotly::layout(margin = list(l = 250)),
        file = filename,
        width = input$runtimeWidth,
        height = input$runtimeHeight
      )

      # move file to path expected by downloadHandler
      filesstrings::file.move(filename, path_wo_file)
    }
  )

  output$downloadbtn_runtime_bar = renderUI({
    input$submit_loc
    req(download_runtime_bar)
    shinyWidgets::dropdownButton(
      shiny::numericInput(inputId = "runtimeWidth", label = "width", value = 500),
      shiny::numericInput(inputId = "runtimeHeight", label = "height", value = 500),
      # shiny::numericInput(inputId = "accDiffDpi", label = "dpi", value = 300),
      download_runtime_bar,
      circle = F,
      status = "success",
      width = "50px",
      icon = shiny::icon("file-download"),
      size = "xs"
    )
  })









}
creil94/FeatureSelectionDashboard documentation built on Nov. 4, 2019, 9:17 a.m.