
## Installation of Packages

my_packages <- c("shiny", "shinyWidgets", "shinythemes", "data.table", "shinyalert") 
## Find the non-installed ones 
not_installed <- my_packages[!(my_packages %in% installed.packages()[ , "Package"])]
## install them
if(length(not_installed)) install.packages(not_installed)                             

## Load packages 
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(data.table)
library(shinyalert)


cpgs <- read.csv("./Predictors_Shiny_by_Groups.csv", header = T) 


timeoutSeconds <- 300

inactivity <- sprintf("function idleTimer() {
                      var t = setTimeout(logout, %s);
                      window.onmousemove = resetTimer; // catches mouse movements
                      window.onmousedown = resetTimer; // catches mouse movements
                      window.onclick = resetTimer;     // catches mouse clicks
                      window.onscroll = resetTimer;    // catches scrolling
                      window.onkeypress = resetTimer;  //catches keyboard actions
                      
                      function logout() {
                      Shiny.setInputValue('timeOut', '%ss')
                      }
                      
                      function resetTimer() {
                      clearTimeout(t);
                      t = setTimeout(logout, %s);  // time is in milliseconds (1000 is 1 second)
                      }
                      }
                      idleTimer();", timeoutSeconds*1000, timeoutSeconds, timeoutSeconds*1000)
## User Interface Portion 
ui <- fluidPage(theme = shinytheme("united"),
                tags$head(
                  tags$style(      ".title {margin-left: 370px; width: 1000px}",
                    HTML(".shiny-notification {
                         position:fixed;
                         top: calc(50%);
                         left: calc(50%);
                         }
                         "
                         
                    ),
                    ".modal-body {padding: 20px}
                    .modal-header {background-color: #8ae9ff}
                    .modal { text-align: center}"
                  )
                    ),    tags$div(class="title", titlePanel("MethylDetectR - Calculate Your Scores")), 
                tags$script(inactivity),
                sidebarLayout(
                  sidebarPanel(
                    useShinyalert(),
                    fileInput("file1", "Upload RDS File - Methylation",
                              multiple = TRUE,
                              accept = c(".rds")),
                    
                    fileInput("file2", "Upload CSV File - Sex and Age Information (Optional)",
                              multiple = TRUE,
                              accept = c("text/csv",
                                         "text/comma-separated-values,text/plain",
                                         ".csv")),
                    
                    actionButton("go", "Run the Analysis"),
                    
                    br(),
                    br(),
                    
                    uiOutput("downloadData"),
                    
                    
                    br(),
                    br(),
                    
                    actionButton("reset", "Press Here to Reset - Please Reset If Running New Dataset")),
                  
                  
                  mainPanel(tabsetPanel(tabPanel("Calculating the Scores", verbatimTextOutput("text"), verbatimTextOutput("text1"),
                                                 verbatimTextOutput("text2"), verbatimTextOutput("text_m2beta"), verbatimTextOutput("text3"),verbatimTextOutput("text_scale"), 
                                                 verbatimTextOutput("text4"), verbatimTextOutput("text7"), verbatimTextOutput("text8"),
                                                 verbatimTextOutput("text9")
                  )))
                ))

## Server Portion 
server <- function(input, output,session) {
  options(shiny.maxRequestSize = 5000*1024^2)
  
  
  dat <- reactive ({ req(input$file1)
    df1 <- readRDS(input$file1$datapath)
    output$text <- renderText("Finished Reading Methylation File")
    return(df1) 
  })
  
  
  
  sexageinfo <-  reactive({ 
    if (is.null(input$file2)) return(NULL)
    df2 <- read.csv(input$file2$datapath)
    output$text1 <- renderText("Finished Reading Sex and Age Info File")
    return(df2)
  })
  
  observeEvent(input$reset, { 
    session$reload()    
  } ) 
  
  dat3 <- reactive({ if(ncol(dat()) <= nrow(dat())){
    data1 <- dat()
    return(data1)} else{ 
      data2 <- t(dat())
      return(data2)}  }) 
  
  
  
  observeEvent(input$go, { 
    
    if(is.null(input$file1))
    {
      # show pop-up ...
      showModal(modalDialog(
        title = "Methylation File Not Yet Uploaded",
        paste0("Please Allow For Upload. To Dismiss Click Anywhere Else On Page"),
        easyClose = TRUE,
        footer = NULL
      ))} 
    else if(nrow(dat()) == 0 | ncol(dat()) ==0){
      shinyalert("Sorry, An Error Has Occurred","There Were No Individuals Detected in the Dataset",type = "warning",  showCancelButton = TRUE, inputId = "foo4")
      observeEvent(input$foo4, {
        session$reload()
      })
    }
    
    else if(withProgress(message = "Performing Quality Control Checks", {
      t<- vector()
      for(i in 1:ncol(dat3())){
        t[i] <- is.numeric(dat3()[,i])
        incProgress(1/ncol(dat3()), detail = paste((i/ncol(dat3()))*100, "% complete"))
        Sys.sleep(0.2)
      } 
      length(which(as.data.frame(t)[,1] %in% "FALSE")) >  0}) ){
      shinyalert("Sorry, An Error Has Occurred","Non-Numeric Values Have Been Detected - Please Check You Have The Correct Input Format",type = "warning",  showCancelButton = TRUE, inputId = "foo1")
      observeEvent(input$foo1, {
        session$reload()
      })
    }  else { 
    
      
      ## Set up function to convert NAs to sample mean 
      
      na_to_mean <-function(methyl){
        methyl[is.na(methyl)]<-mean(methyl,na.rm=T)
        return(methyl)
      }
      
      ## Set up function to convert M values to beta values 
      
      m_to_beta <- function (val) 
      { 
        beta <- 2^val/(2^val + 1)
        return(beta)
      }
      
      
      
      ## Transposing step 
      
      dat1 <- reactive({ 
        
        if(ncol(dat()) > nrow(dat())){
          output$text2 <- renderText("Data Is Being Transposed")
          data1 <-t(dat())
          data1 <- t(apply(data1,1,function(x) na_to_mean(x)))
          return(data1)} else{ 
            output$text2 <- renderText("Data Does Not Need To Be Transposed") 
            data2 <- dat()
            data2 <- t(apply(data2,1,function(x) na_to_mean(x)))
            return(data2)}
      }) 
      
    
      # Overlap of CpGs with those for predictors + conversion of M to beta values if needs be
      
      coef <- reactive({ 
        coef1.1 <- dat1()[intersect(rownames(dat1()), cpgs$CpG_Site),]
        output$text3 <- renderText("Subsetting CpG Sites To Those Needed by Predictors...") 
        if((range(coef1.1,na.rm=T)> 1)[[2]] == "TRUE"){
        output$text_m2beta <- renderText("M Values Detected - Converting to Beta Values") 
        fix <- m_to_beta(coef1.1)
        return(fix)
        } else { 
          output$text_m2beta <- renderText("Beta Values Detected") 
          safe <- coef1.1 
          return(safe)
          }
        })
    
      
      
      
      coef1 <- reactive({ if(nrow(coef()) == 6452) {  
        output$text4 <- renderText("No Missing CpG Sites") 
        x <- coef()
        return(x) 
      } else if(nrow(coef()) == 0) { 
        shinyalert("Sorry, There Are No Neccessary CpG Sites Present", "This Means All Individuals Will Have Same Values For Predictors. Analysis Will Not Be Informative",type = "warning",  showCancelButton = TRUE, inputId = "foo2")
        observeEvent(input$foo2, {
          session$reload()
        })
      } 
        
        else {
          missing_cpgs = cpgs[-which(cpgs$CpG_Site %in% rownames(coef())),c("CpG_Site","Mean_Beta_Value")]
          message(paste(length(unique(missing_cpgs$CpG_Site)), "unique sites are missing - add to dataset with mean Beta Value from Training Sample", sep = " "))
          mat = matrix(nrow=length(unique(missing_cpgs$CpG_Site)),ncol = ncol(coef()))
          row.names(mat) <- unique(missing_cpgs$CpG_Site)
          colnames(mat) <- colnames(coef()) 
          mat[is.na(mat)] <- 1
          missing_cpgs1 <- if(length(which(duplicated(missing_cpgs$CpG_Site))) > 1) { 
            missing_cpgs[-which(duplicated(missing_cpgs$CpG_Site)),]
          } else {missing_cpgs
          }  
          ids = unique(row.names(mat))
          missing_cpgs1 = missing_cpgs1[match(ids,missing_cpgs1$CpG_Site),]
          mat=mat*missing_cpgs1$Mean_Beta_Value
          coef.2=rbind(coef(),mat)
          output$text4 <- renderText(paste(paste("Substituting in", length(unique(missing_cpgs$CpG_Site)), sep = " "), "Missing CpG Sites With Mean Beta Values from Training Sample"))
          return(coef.2)} 
      })
      
  
    
      
      coef3 <- reactive({ coef2.1 <- t(apply(coef1(),1,function(x) na_to_mean(x)))
      return(coef2.1)
      }) 
      
      out1 <- reactive({
        loop = unique(cpgs$Predictor)
        out <- data.frame()
        for(i in loop){ 
          tmp=coef3()[intersect(row.names(coef3()),cpgs[cpgs$Predictor %in% i,"CpG_Site"]),]
          tmp_coef = cpgs[cpgs$Predictor %in% i, ]
          if(nrow(tmp_coef)>1){ 
            tmp_coef = tmp_coef[match(row.names(tmp),tmp_coef$CpG_Site),]
            out[colnames(coef3()),i]=colSums(tmp_coef$Coefficient*tmp)
            output$text7 <- renderText("Calculating the Predictors...") } else { 
              tmp2 = as.matrix(tmp)*tmp_coef$Coefficient 
              out[colnames(coef3()),i] = tmp2[,1]
              output$text7 <- renderText("Calculating the Predictors...")
            }
        }
        
        out$'Biological Age' <- out$'Biological Age' + 65.79295
        out$ID <- row.names(out) 
        out <- out[,c(ncol(out),1:(ncol(out)-1))] 
        
        
        if (is.null(sexageinfo())){
          out$'True Age' <- NA
          out$Sex <- NA 
          out3 <- out[,c(1,ncol(out),(ncol(out)-1), 2:c(ncol(out)-2))]
          output$text8 <- renderText("No Sex/Age Info File - Sex and 'True Age' Listed As 'NA'.")
          return(out3)
        } else { 
          ids = out$ID
          linker = sexageinfo()[match(ids, sexageinfo()$ID),] 
          out$'True Age' <- linker$Age
          out$Sex <- linker$Sex 
          out3 <- out[,c(1,ncol(out),(ncol(out)-1), 2:c(ncol(out)-2))]
          output$text8 <- renderText("Sex/Age Info File Included - Sex and 'True Age' Incorporated Into Output File!")
          return(out3)} 
      })
      
      
      
      output$text9 <-if(nrow(out1()) >0){ 
        renderText("Analysis is Finished. Thank You For Using Our Application!") } 
      else { 
        renderText("Analysis in Progress!")}
      
      
      
      ## Save File and Finish Up 
      
      output$downloadData <- renderUI({
        req(input$file1, out1())
        downloadButton("download", "Download Your Results!")
      })
      
      
      output$download <- downloadHandler(
        filename = function(){paste("Epigenetic_Scores", ".csv", sep = "")}, 
        content = function(file){
          fwrite(out1(), file, row.names = F,dateTimeAs = "write.csv")
          
        } 
        
      )
    }
  })
  
  observeEvent(input$timeOut, { 
    print(paste0("Session (", session$token, ") timed out at: ", Sys.time()))
    showModal(modalDialog(
      title = "Timeout",
      paste("Session Time Due To", input$timeOut, "Inactivity -", Sys.time()),
      footer = NULL
    ))
    session$close()
    stopApp()
  })
  
}

shinyApp(ui=ui,server=server)
