#shiny poRe recursive - process pass and fail folders with recursive file listing.

library(shiny)
library(data.table)
library(svDialogs) #cross-platform directory choice
library(rhdf5)
library(poRe)

gc()

#Utility functions for reading Attributes and Datasets
F5Aread <- function(f5obj, name) { #Mid-level utility function to read attribute in one statement
  id <- H5Aopen(f5obj, name); att <- H5Aread(id); H5Aclose(id);  return(att)
} #should I combine Aread and Aread_by_name?
F5Aread_by_name <- function(f5obj, objname=".", name) { #Mid-level utility function to read attribute by name in one statement
  id <- H5Aopen_by_name(f5obj, objname, name); att <- H5Aread(id); H5Aclose(id);  return(att)
}
F5Dread <- function(f5loc, name) { #Mid-level utility function to read dataset in one statement
  id <- H5Dopen(f5loc, name); data <- H5Dread(id); H5Dclose(id);  return(data)
}
#Utility functions for folder creation
F5mkdir <- function(loc) {if(!dir.exists(loc)) dir.create(loc)}
F5dir <- function(path,name){
  dest <- file.path(path,name)
  F5mkdir(dest); return(dest)
}

#Using development version of bioconductor for the new version of rhdf5, with R-style error handling
#library(BiocInstaller) 
#useDevel()
#See this page for updates: http://www.bioconductor.org/install/
server <- shinyServer(function(input, output, session) {
  options(showWarnCalls = FALSE)
  #options(show.error.messages = FALSE)
  
  #Fast5 file main groups
  g_tid <- "/UniqueGlobalKey/tracking_id"           #Same for old and new style files
  g_cid <- "/UniqueGlobalKey/channel_id"            #Same for old and new style files
  g_edr <- "/Analyses/EventDetection_000/Reads"     #Same for old and new style files
  g_2d <- "/Analyses/Basecall_2D_000"               #Present in old and new style files - different content
  g_1d <- "/Analyses/Basecall_1D_000"               #Only in new style files (use as marker)
  g_1dc <- "/Analyses/Basecall_1D_CDNA_000"         #Possible 1d_CDNA group (unknown for new files - not implemented currently)
  g_bc <- "/Analyses/Barcoding_000"                 #Possible barcoding group - same for all
  
  #Initialise results data table (data.table package)
  n <- 10^5 #100k table entry spaces to pre-allocate
  #pre-allocate data table to fill in during run - column order is important for set commands below
  DT <- data.table(filename=rep('f5',n),chan_num=rep(-1L,n),read_num=rep(-1L,n),start_time=rep(0,n),PF=rep('F',n),
                   lenT=rep(0L,n),lenC=rep(0L,n),len2D=rep(0L,n),run_id=rep('no_run_id',n),read_id=rep('no_read_id',n),
                   barcode=rep('no_bc',n),exp_start_time=rep('no_start_time',n)) 
  
  #reactive variables
  counts <- reactiveValues(nproc=0L,npass=0L,nfail=0L,nread_error=0L,nwait=0L,n2d=0L,nT=0L,nC=0L) #integer counts
  files <- reactiveValues()
  files$f5_all <- character(length=0) #char vector of all fast5 files metrichor puts into pass,fail folders
  files$f5_process <- character(length=0)  #2 vectors of f5 files to process - initially empty
  files$f5_wait <- character(length=0) #2 char vectors
  
  #Choose directories using popup file browser
  fixed_sourcepath <- dlgDir(default = getwd(),title="Select Metrichor output folder")$res
  fixed_targetpath <- dlgDir(default = "/",title="Select Target folder for sorted files")$res
  #if (length(fixed_sourcepath)==0 || length(fixed_targetpath)==0){print("No folders selected. Stopping");stopApp(1);print("?")}
  destp <- F5dir(fixed_targetpath,"pass") #destination folder for pass files
  destf <- F5dir(fixed_targetpath,"fail") #destination folder for fail files
  desto <- F5dir(fixed_targetpath,"other") #destination folder for other files (unreadable or no_analysis)
  destn <- F5dir(desto,"no_analysis")
  destu <- F5dir(desto,"unreadable")
  destd <- F5dir(desto,"duplicates")

  output$sourcepath <- renderText(fixed_sourcepath)
  output$targetpath <- renderText(fixed_targetpath)
  
  output$mainfig <- renderPlot({
    DT <- process.f5(DT) #update data table - main function
    
    if(counts$n2d>10){ #reactive
      #layout(matrix(c(1,2,3,1,4,5,1,6,7,1,8,9), 3, 4)) #vertical layout
      layout(matrix(c(1,2,6,1,3,7,1,4,8,1,5,9), 3, 4)) #horizontal layout
      par(cex.lab=1.5,cex.axis=1.1,cex.main=1.2)
      
      brk_log <- seq(from=0,to=6,by=0.1) #1 to 1 million
      pass <- DT[1:counts$nproc,PF=="P"] #true for pass, false for fail
      #EXTRACT COUNTS
      #1D Template
      lenT <- DT[1:counts$nproc,lenT]
      lenT_p <- lenT[pass];
      lenT_f <- lenT[!pass]; 
      lenT_f_pos <- lenT_f[lenT_f>0]
      #1D Complement
      lenC <- DT[1:counts$nproc,lenC]
      lenC_p <- lenC[pass];
      lenC_f <- lenC[!pass]; 
      lenC_f_pos <- lenC_f[lenC_f>0]
      #2D
      len2D <- DT[1:counts$nproc,len2D]
      len2D_p <- len2D[pass]
      len2D_f <- len2D[!pass]
      len2D_f_pos <- len2D_f[len2D_f>0]
      
      #start times for cumulative yield plot
      start_time <- (DT[1:counts$nproc,start_time])/3600 #convert from seconds to hours
      start_time_p <- start_time[pass]
      if(length(start_time_p)==0)
        plot(x=0,y=0,type="l",xlab="Read start time (h)",ylab="N pass files",main="Cumulative yield",xlim=c(0,50),xaxp  = c(0,48,8))
      else{
        #plot(x=sort(start_time_p),y=seq_len(length(start_time_p)),type="l",xlab="Read start time (h)",ylab="N pass files",main="Cumulative yield",xlim=c(0,50),xaxp  = c(0,48,8))
        sorted_times <- sort.int(start_time_p,index.return=TRUE)
        #plot(x=sorted_times$x,y=seq_len(length(start_time_p)),type="l",xlab="Read start time (h)",ylab="N pass files",main="Cumulative yield",xlim=c(0,50),xaxp  = c(0,48,8))
        plot(x=sorted_times$x,y=cumsum(len2D_p[sorted_times$ix])/1000,type="l",
             xlab="Read start time (h)",ylab="Cumulative 2d pass kb",main="Cumulative yield",xlim=c(0,50),xaxp  = c(0,48,8))
      }
      #1D Template - pass
      hist(x=log10(lenT_p), breaks=brk_log, col = 'blue', border = 'white',
           xlab=paste('SeqLen (kb). Mean:',signif(mean(lenT_p)/1000,4)),main=paste('Pass T reads:',length(lenT_p)),xaxt="n")
      axis(side=1,at=0:5,c('','',10^(2:5)/1000))
      
      #1D Complement - pass
      hist(x=log10(lenC_p), breaks=brk_log, col = 'green', border = 'white',
           xlab=paste('SeqLen (kb). Mean:',signif(mean(lenC_p)/1000,4)),main=paste('Pass C reads:',length(lenC_p)),xaxt="n")
      axis(side=1,at=0:5,c('','',10^(2:5)/1000))
      
      #2D - pass
      hist(x=log10(len2D_p), breaks=brk_log, col = 'red', border = 'white',
           xlab=paste('SeqLen (kb). Mean:',signif(mean(len2D_p)/1000,4)),main=paste('Pass 2D reads:',length(len2D_p),'/',counts$nproc),xaxt="n")
      axis(side=1,at=0:5,c('','',10^(2:5)/1000))
      
      #T vs C SCATTER PLOTS - pass
      plot(lenT_p/1000,lenC_p/1000,log="xy",asp=1,pch=20,cex=.3,xlim=c(0.01,100),ylim=c(0.01,100),
           xlab="T length (kb)",ylab="C length (kb)",main="Pass T vs C",xaxt="n",yaxt="n")
      abline(0,1)
      axis(side=1,at=c(0.01,0.1,1,10,100),c('',0.1,1,10,100))
      axis(side=2,at=c(0.01,0.1,1,10,100),c('',0.1,1,10,100))

      if(counts$nfail>10){ #plot fail data
        #template fail
        hist(x=log10(lenT_f_pos), breaks=brk_log, col = 'blue', border = 'white',
             xlab=paste('SeqLen (kb). Mean:',signif(mean(lenT_f_pos)/1000,4)),main=paste('Fail T reads:',length(lenT_f_pos)),xaxt="n")
        axis(side=1,at=0:5,c('','',10^(2:5)/1000))
        
        #Complement fail
        hist(x=log10(lenC_f_pos), breaks=brk_log, col = 'green', border = 'white',
             xlab=paste('SeqLen (kb). Mean:',signif(mean(lenC_f_pos)/1000,4)),main=paste('Fail C reads:',length(lenC_f_pos)),xaxt="n")
        axis(side=1,at=0:5,c('','',10^(2:5)/1000))
        
        #2D fail
        hist(x=log10(len2D_f_pos), breaks=brk_log, col = 'red', border = 'white',
             xlab=paste('SeqLen (kb). Mean:',signif(mean(len2D_f_pos)/1000,4)),main=paste('Fail 2D reads:',length(len2D_f_pos),'/',counts$nproc),xaxt="n")
        axis(side=1,at=0:5,c('','',10^(2:5)/1000))
        
        #T vs C scatter
        plot(lenT_f[lenC_f>0]/1000,lenC_f_pos/1000,log="xy",asp=1,pch=20,cex=.3,xlim=c(0.01,100),ylim=c(0.01,100),
             xlab="T length (kb)",ylab="C length (kb)",main="Fail T vs C (red=no 2D)",xaxt="n",yaxt="n")
        with_clen_no2D <- lenC_f>0 & len2D_f==0
        points(lenT_f[with_clen_no2D]/1000,lenC_f[with_clen_no2D]/1000,col="red",pch=20,cex=.5)
        abline(0,1)
        axis(side=1,at=c(0.01,0.1,1,10,100),c('',0.1,1,10,100))
        axis(side=2,at=c(0.01,0.1,1,10,100),c('',0.1,1,10,100))
      }
    }
  })
  #END OF FIGURE PLOTTING
  
  #Main processing function, returning a dataframe of collected results
  process.f5 <- function(dt=NULL){
    if(input$run){
      isolate({
          process<-files$f5_process 
          n_files <- length(process) #list of files already collected for processing
          
          #Process wait list of any files that failed to read on previous cycle
          if(counts$nwait > 0){
            f5_wait<-files$f5_wait
            for (i in 1:counts$nwait){
              f5 <- f5_wait[i]
              fid <- try(H5Fopen(f5),silent = TRUE)
              if(inherits(fid, "try-error")) {
                counts$nread_error <- counts$nread_error+1
                cat("Unreadable: ",f5,'\n')
                move_success <- file.rename(f5,file.path(destu,basename(f5))) #move fast5 file to specified target location
                print(move_success)
              }
              else{
                n_files <- n_files+1
                files$f5_process[n_files] <- f5_wait[i]
                H5Fclose(fid)
              } 
            }
            process<-files$f5_process
            counts$nwait <- 0
          }
          
          if(n_files==0){
            cat('.')
          }
          else{#files added to source folder - do processing
            cat(n_files,'\n')
            for (i in 1:n_files){ #loop over added files since last reaction
              f5 <- process[i]
              
              fid <- try(H5Fopen(f5),silent = FALSE)
              if(inherits(fid, "try-error")) { #Cannot read
                counts$nwait <- counts$nwait+1L
                files$f5_wait[counts$nwait] <- f5 #Put file into wait list to retry read on next cycle
                cat("Wait: ",f5,'\n')
              }
              else{ #readable file - examine further and prepare target directories
                filename <- basename(f5)
                pf <- basename(dirname(f5))
                
                if(H5Lexists(fid,g_tid)){
                  run_id <- F5Aread_by_name(fid,g_tid,"run_id")
                  exp_start_time <- as.character(F5Aread_by_name(fid,g_tid,"exp_start_time"))
                } 
                else{run_id <- "no_run_id";exp_start_time<-"no_exp_time"}
                
                if(H5Lexists(fid,g_cid)){
                  chan_num <- as.integer(F5Aread_by_name(fid,g_cid,"channel_number"))
                  sampling_rate <- F5Aread_by_name(fid,g_cid,"sampling_rate")
                }
                else {
                  chan_num <- -1L
                  sampling_rate <- 3000 #default sampling rate
                }
                
                #New syntax for handling different fast5 file formats - Nov 2015
                if(H5Lexists(fid, g_1d)){ #Only new style files have the /Analyses/Basecall_1D_000 group
                  new_file_type<-TRUE
                  g_top_1d <- g_1d #g_top_1d is the top level group containing 1d basecalling analysis
                  if(H5Lexists(fid, g_2d)) g_top_2d <- g_2d
                  else g_top_2d <- NULL
                } 
                else if(H5Lexists(fid, g_2d)){ #old style file - all basecalling analysis in 2D group
                  new_file_type <- FALSE 
                  g_top_1d <- g_2d #g_top_1d is the top level group containing 1d basecalling analysis
                  g_top_2d <- g_2d
                }
                else{ #if neither 1D nor 2D groups exist - no analysis
                  g_top_1d <- NULL
                  g_top_2d <- NULL
                  analysis <- "no_analysis"
                  #dest2 <- file.path(destn,run_id)
                }
                
                subfolder <- NULL #assume no (barcoding) subfolder initially
                if(!is.null(g_top_1d)){#When we have basecalling data in /Analyses
                  #get analysis name and chimaera version: aname, aversion
                  gid <- H5Gopen(fid,g_top_1d)
                  aname <- F5Aread(gid,"name")
                  #changed from version to chimaera version (Nov 2015)
                  if(H5Aexists(gid,"chimaera version")){aversion <- F5Aread(gid,"chimaera version")}
                  else if(H5Aexists(gid,"version")){aversion <- F5Aread(gid,"version")}
                  else aversion <- "no_version"
                  H5Gclose(gid)
                  
                  analysis <- paste(aname, aversion, sep = "_")
                  analysis <- gsub(" ","_",analysis,fixed=TRUE)#substitute underscores for spaces
                  #set destination for files
                  
                  if(pf=="pass"){dest1 <- F5dir(destp,run_id)}
                  else if(pf == "fail"){dest1 <- F5dir(destf,run_id)} 
                  else{ #check for subfolders - e.g. BARCODING runs
                    subfolder <- pf
                    pf <- basename(dirname(dirname(f5))) #go up a folder level
                    if(pf=="pass"){dest1 <- F5dir(destp,run_id)}
                    else if(pf == "fail"){dest1 <- F5dir(destf,run_id)} 
                    else print("Unknown directory structure")
                  }
                  #F5mkdir(dest1);
                  dest2 <- F5dir(dest1,analysis)
                }
                else {dest2 <- F5dir(destn,run_id)}
                #F5mkdir(dest2);
                if(!is.null(subfolder)){ #subfolder (presume barcoding)
                  dest2 <- F5dir(dest2,subfolder);
                }
                
                targetfile <- file.path(dest2,filename)
                if(file.exists(targetfile)){ #Duplicate file - move to duplicate folder; don't process data
                  dest2 <- F5dir(destd,run_id); #F5mkdir(dest2);
                  targetfile <- file.path(dest2,filename)
                  H5Fclose(fid)
                  move_success <- file.rename(f5,targetfile) #move fast5 file to specified target location
                }
                else{ #Not a duplicate - process (MAIN SECTION)
                  counts$nproc <- counts$nproc+1L #increment count of processed files
                  if(pf=="pass") {
                    counts$npass <- counts$npass+1L #increment count of pass files
                    set(DT,counts$nproc,5L,"P") #col 5 = P/F 
                  }
                  else if(pf == "fail") counts$nfail <- counts$nfail+1L #increment count of fail files
                  
                  ind <- regexpr("_\\d+_\\d+_ch",filename) #underscore, some digits, underscore, some digits, underscore, ch
                  runname <- substr(filename,1,ind-1)
                  
                  #EventDetection Read for start_time and read_num
                  if(H5Lexists(fid, g_edr)){
                    gid <- H5Gopen(fid,g_edr)
                    tmp <- h5ls(gid,recursive=FALSE,datasetinfo=FALSE)
                    g_read <- paste(g_edr,tmp$name,sep="/")
                    if(H5Lexists(fid, g_read)){
                      gid2 <- H5Gopen(fid,g_read)
                      read_num <- as.integer(F5Aread(gid2,"read_number"))
                      start_time <- round(F5Aread(gid2,"start_time")/sampling_rate) #rounded to nearest second
                      set(DT,counts$nproc,3L,read_num) #col 3 = read_num
                      set(DT,counts$nproc,4L,start_time) #col 4 = read data start time (s)
                      if(H5Aexists(gid2,"read_id")){
                        read_id <- F5Aread(gid2,"read_id")
                        set(DT,counts$nproc,10L,read_id) #col 10 = read_id
                      }
                      H5Gclose(gid2)
                    } else print("No start time") #missing data
                    H5Gclose(gid)
                  } else print("No Reads")
                  
                  #BASECALLING
                  gTs <- paste(g_top_1d,"Summary/basecall_1d_template",sep="/") #summary data, 1d template
                  if(H5Lexists(fid, gTs)){ #with template basecalling summary data
                    #TEMPLATE
                    counts$nT <- counts$nT+1L #increment count of template base-called files
                    
                    gTd <- paste(g_top_1d,"BaseCalled_template",sep="/")
                    fastq_T <- F5Dread(fid,paste(gTd,"Fastq",sep="/"))
                    fastq_T_split <- strsplit(fastq_T, "\n")
                    gid<-H5Gopen(fid,gTs) #open template summary group
                    if(H5Aexists(gid,"sequence_length")){ #sequence length should be in the summary data, but may be missing from old files
                      lenT <- F5Aread(gid,"sequence_length")
                    } 
                    else {
                      lenT <- nchar(fastq_T_split[[1]][2])
                    }
                    set(DT,counts$nproc,6L,as.integer(lenT)) #col 6 = lenT
                    H5Gclose(gid)
                    
                    #COMPLEMENT
                    gCs <- paste(g_top_1d,"Summary/basecall_1d_complement",sep="/") #summary data, 1d 
                    if(H5Lexists(fid, gCs)){ #complement call summary exists
                      counts$nC <- counts$nC+1L #increment count of complement base-called files
                      
                      gCd <- paste(g_top_1d,"BaseCalled_complement",sep="/")
                      fastq_C <- F5Dread(fid,paste(gCd,"Fastq",sep="/"))
                      
                      gid<-H5Gopen(fid,gCs) #open complement summary group
                      if(H5Aexists(gid,"sequence_length")){ #sequence length should be in the summary data, but may be missing from old files
                        lenC <- F5Aread(gid,"sequence_length")
                      } 
                      else {
                        fastq_C_split <- strsplit(fastq_C, "\n")
                        lenC <- nchar(fastq_C_split[[1]][2])
                      }
                      set(DT,counts$nproc,7L,as.integer(lenC)) #col 7 = lenC
                      H5Gclose(gid)
                    }
                    
                    #2D
                    g_2ds <- paste(g_top_2d,"Summary/basecall_2d",sep="/") #summary data, 2d
                    if(H5Lexists(fid, g_2ds)){ #If 2D basecall exists
                      counts$n2d <- counts$n2d+1L #increment count of 2D base-called files
                      
                      gid<-H5Gopen(fid,g_2ds) #open group
                      len2d <- F5Aread(gid,"sequence_length")
                      qsc <- F5Aread(gid,"mean_qscore")
                      set(DT,counts$nproc,8L,as.integer(len2d)) #col 8 = len2d
                      H5Gclose(gid)
                      
                      #Get fastq dataset - If summary exists, assume dataset exists too
                      g2d <- paste(g_top_2d,"BaseCalled_2D",sep="/")
                      fastq_2d <- F5Dread(fid,paste(g2d,"Fastq",sep="/"));
                      
                      splits <- strsplit(fastq_2d, "\n")[[1]] #get lines from fastq
                      fasta_2d <- paste(sub("@", ">", splits[1]),'\n',splits[2],'\n',sep="")
                      
                      #ind <- regexpr("_20\\d{6}_",filename) #regexp for date string e.g. _20150511
                      fastq_filename <- paste(runname,"_2d.fastq",sep="")
                      fasta_filename <- sub("fastq","fasta",fastq_filename,fixed=TRUE)
                      
                      cat(fastq_2d,file=paste(dest2,fastq_filename,sep="/"),append=TRUE)
                      cat(fasta_2d,file=paste(dest2,fasta_filename,sep="/"),append=TRUE)
                    } #with 2D basecalling summary data
                  } #with template basecalling summary data
                  
                  #BARCODING
                  g_bcs <- paste(g_bc,"Summary/barcoding",sep="/") #barcoding summary data
                  if(H5Lexists(fid, g_bcs)){ #If barcoding group exists
                    barcode <- F5Aread_by_name(fid,g_bcs,"barcode_arrangement")
                    set(DT,counts$nproc,11L,barcode) #col 11 = barcode
                  }
                  #Write data to data table
                  set(DT,counts$nproc,1L,filename) #use set to rapidly store filename in col 1 of data table DT
                  set(DT,counts$nproc,2L,chan_num) #col 2 = chan_num
                  set(DT,counts$nproc,9L,run_id) #col 9 =  run_id
                  set(DT,counts$nproc,12L,exp_start_time) #col 12 =  exp_start_time
                  
                  #output metadata from DT
                  meta_filename <- paste(runname,"_meta.txt",sep="")
                  meta <- unlist(DT[counts$nproc,])
                  
                  #cat(meta,'\n')
                  cat(meta,'\n',file=paste(dest2,meta_filename,sep="/"),sep='\t',append=TRUE)
                  #write.table(DT[counts$nproc,],file=paste(dest2,meta_filename,sep="/"),append=TRUE)
                  
                  H5Fclose(fid)
                  move_success <- file.rename(f5,targetfile) #move fast5 file to specified target location
                  #print(move_success)

                } #not a duplicate
              } #readable file
            } #for loop over current files
            cat('nFail:',counts$nfail,'nPass:',counts$npass,'n2D:',counts$n2d,'nTotal:',counts$nproc,'\n')
          }
          f5_list <- list.files(path=fixed_sourcepath,recursive=TRUE,full.names=TRUE,pattern="\\.fast5$") #recursive listing
          files$f5_process <- setdiff(f5_list,files$f5_all) 
          files$f5_all <- f5_list
          
          #f5_list <- list.files(path=sourcepath[pf],pattern="\\.fast5$") #check for files
          #files$f5_process[[pf]] <- setdiff(f5_list,files$f5_all[[pf]]) #get new files to process
          #files$f5_all[[pf]]<-f5_list #update full list
      }) #isolate all
      invalidateLater(millis=2000, session=session) #repeat at regular interval if run is selected
    }
    return(dt)
  } #main process.f5 function
}) #shiny server

#UI
ui <- shinyUI(fluidPage(
  titlePanel("PoRe RT GUI"),
  
  fluidRow(
    column(width=6, h4("Source folder (Metrichor output)"),
           verbatimTextOutput('sourcepath')
    ),
    column(width=6, h4("Target folder"),
           verbatimTextOutput('targetpath')
    )
  ),
  
  fluidRow(
    column(width=6,
           checkboxInput(inputId="run", label="Run File Processing", value = FALSE)#,
           #verbatimTextOutput('readytext')
    )
  ),
  plotOutput("mainfig",height="780px") #histograms of sequence lengths and scatterplots vs phred score
))

shinyApp(ui = ui, server = server)

