app_ML.R

#~~~~~~~~~~~~~~~~~~~ App for random forest analysis of GeoMx-data ~~~~~~~~~~~~~~~~~~~~
# Author: Elias Carlsson
# Email: eeliascarlsson@gmail.com
# Description: An app making a random forest model of geomx data and returning the importance of different parameters.
# Part of apps_for_geomx project
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


# Cleaning
rm(list = ls())
cat("\014")
graphics.off()

# Sourcing
library('shiny')
source("./functions/load_data.R")
source("./functions/ML_functions.R")

# Loading data for app
load("./data/setup.RData")
allprot = proteins
rm(proteins)
location1 = loc[1]
data_sel = load_data(location = location1)

# UI
ui <- fluidPage(
  
  # Sidebar
  sidebarLayout(
    sidebarPanel(
      style = "position:fixed;width:inherit;height: 95vh; overflow-y: auto;",
      width = 3,
      h1("app_ML"),
      h3("Choose dataset"),
      
      selectInput(inputId ="location_norm", label = strong("NormalyzedDE Data set"),
                  choices = loc_nDE,
                  selected = loc_nDE[2]),
      
      uiOutput("location"),
      
      h3("Filter data"),
      
      selectInput(inputId ="filter", label = strong("Filter type"),
                  multiple = T,
                  choices = vec_type,
                  selected = ""), 
      
      uiOutput("filter_ann"),
      
      uiOutput("no_samples1"),
      
      h3("Random forest model inputs"),
      
      uiOutput("sliderdivider"),
      
      radioButtons(inputId = "one_pat", label = "One sample per patient",
                   choices = c("No" = FALSE, "Yes" = TRUE),
                   inline = T),
      
      uiOutput("no_samples2"),
      
      sliderInput(inputId = "split", label = strong("% split train/test"),
                  min = 0, max = 100, step = 10, value = 70),
      
      uiOutput("no_samples3"),
      
      sliderInput(inputId = "ntree", label = strong("Number of trees"),
                  min = 10, max = 500, step = 10, value = 100)
      
      ),
    
    # Main panel
    mainPanel(
      fluidRow(align = "center", h3("Random Forest")),
      fluidRow(align = "center", column(3, selectInput(inputId = "type", label = strong("y-parameter"),
                                                       multiple = F,
                                                       choices = c(vec_type, allprot[! allprot %in% cn], "CD45/PanCk"),
                                                       selected = "Main_class"),),
               column(3, checkboxGroupInput(inputId = "xvar", label = strong("Predictor variables"), 
                                            choices= c("biomarkers","types"), selected = c("biomarkers", "types"),
                                            inline = T),),
               column(3, uiOutput("remove_predictors"),),
               column(3, sliderInput(inputId = "coimp", label = strong("Cutoff no. displayed parameters"),
                                     min = 1, max = 30, value = 10))),
      fluidRow(align = "center", plotOutput("imp_plot")),
      fluidRow(align = "center", column(2), column(4, textOutput("trainacc")), 
               column(4, textOutput("testacc"), column(2))),
      fluidRow(align = "center", h3 ("Plots")),
      fluidRow(align = "center",
               column(2),
               column(2, selectInput(inputId = "yparameter", label = strong("Y-parameter for boxplot"),
                                     choices = c(vec_type, allprot[! allprot %in% cn]), selected = "PanCk"))),
      fluidRow(align = "center", 
               column(7, plotOutput("boxplotxvsy")),
               column(5, plotOutput("distribution")))
    )
  )
)

# Server
server <- function(input, output) {
  location_norm <- reactive({
    location_norm <- req(input$location_norm)
  })
  
  output$location <- renderUI({
    if (location_norm()==0){
      selectInput(inputId = "location", label = strong("Data set"),
                  choices = loc,
                  selected = loc[1])
    }
  })
  
  location <- reactive({
    if (location_norm()==0){
      location <- req(input$location)
    } else {
      location <- loc[1]
    }
  })
  
  filter <- reactive({
    filter = input$filter
  })
  
  output$filter_ann <- renderUI({
    if (!is.null(filter())){
      filter = filter()
      output <- tagList()
      for (i in 1:length(filter)){
        output[[i]] <- selectInput(inputId = filter[i], label = strong(filter[i]),
                                   multiple = T, 
                                   choices = sort(unique(data_sel[[filter[i]]])), 
                                   selected = NA)  
      }
      output
    }
  })
  
  filter_list <- reactive({
    if (!is.null(filter())){
      l = list()
      for (i in 1:length(filter())){
        filter_ann = req(input[[filter()[i]]])
        l[[i]] = filter_ann
      }
      filter_list = l
    } else {
      filter_list = NULL
    }
    
  })
  
  my_df <- reactive({
    df = load_data(location(), location_norm())
    if (!is.null(filter())){
      my_df = filter_data(df, filter(), filter_list())
    } else {
      my_df = df
    }
  })
  
  output$no_samples1 <- renderUI({
    helpText(paste(length(my_df()[[1]]), "samples selected"))
  })
  
  split <- reactive({
    split <- req(input$split)
  })
  
  type <- reactive({
    type <- req(input$type)
  })
  
  onepat <- reactive({
    onepat <- req(input$one_pat)
  })
  
  xvar <- reactive({
    xvar <- req(input$xvar)
  })
  
  output$remove_predictors <- renderUI({
    if (xvar() %>% length() == 1){
      if ( xvar() == "biomarkers"){
        selectInput(inputId = "remove_predictors", label = strong("Remove Predictors"),
                    choices = allprot, selected = NULL, multiple = T)
      } else if (xvar() == "types"){
        selectInput(inputId = "remove_predictors", label = strong("Remove Predictors"),
                    choices = vec_type, selected = NULL, multiple = T)
      }
    } else{
      selectInput(inputId = "remove_predictors", label = strong("Remove Predictors"),
                  choices = c(allprot, vec_type), selected = NULL, multiple = T)
    }
    
  })
  
  coimp <- reactive({
    coimp <- req(input$coimp)
  })
  
  ntree <- reactive({
    ntree <- req(input$ntree)
  })
  
  remove_predictors <- reactive({
    remove_predictors <- input$remove_predictors
  })
  
  yparameter <- reactive({
    yparameter <- req(input$yparameter)
  })
  
  list1 <- reactive({
    list1 <- prepare_data(my_df = my_df(), type = type(), sr = split(), onepat = onepat())
  })
  
  list2 <- reactive({
    fit_rf(list1 = list1(), predictors = xvar(), remove_predictors = remove_predictors(), ntree = ntree())
  })
  
  acclist <- reactive({
    acclist = accuracy(list2())
  })
  
  output$no_samples2 <- renderUI({
    helpText(paste(length(list1()[[1]][[1]]) + length(list1()[[2]][[1]]), "samples selected"))
  })
  
  output$no_samples3 <- renderUI({
    helpText(paste(length(list1()[[1]][[1]]), "training samples and", length(list1()[[2]][[1]]), "test samples"))
  })
  
  output$imp_plot <- renderPlot({
    title = paste("Random Forest", list2()[[1]]$type)
    imp = importance_plot(list2(), coimp(), title = title)
    imp
  }, height = 400, width = 900)
  
  output$trainacc <- renderText(
    if (list2()[[1]]$type == "classification"){
      paste("Accuracy training data:", acclist()[[1]]$overall[[1]] %>% as.numeric() %>% round(3))
    } else {
      paste("Variance (%) explianed in training-data:", acclist()[[1]] %>% as.numeric() %>% round(1))
    }
    )
  
  output$testacc <- renderText(
    if (list2()[[1]]$type == "classification"){
      paste("Accuracy test data:", acclist()[[2]]$overall[[2]] %>% as.numeric() %>% round(3))
    } else {
      paste("Mean absolute error for test data:", acclist()[[2]] %>% as.numeric() %>% round(3))
    }
  )
  
  output$boxplotxvsy <- renderPlot({
    boxplot_xvsy(rbind(list1()[[1]], list1()[[2]]), xvar = c("type",type()), yvar = yparameter(), RFtype = list2()[[1]]$type)
  }, height = 300)
  
  output$distribution <- renderPlot({
    if (list2()[[1]]$type == "classification"){
      distributionplot(rbind(list1()[[1]], list1()[[2]]), xvar = "type")
    }
  }, height = 300)
  
}

# Run the application 
shinyApp(ui = ui, server = server)