#shiny PoRe static GUI - PARALLEL version
library(shiny)
library(svDialogs) #cross-platform directory choice
library(rhdf5)
library(parallel)
gc()

#Utility functions for reading Attributes and Datasets
F5Aread <- function(f5obj, name) { #Mid-level utility function to read attributes in one statement
  id <- H5Aopen(f5obj, name); att <- H5Aread(id); H5Aclose(id);  return(att)
} 
F5Aread_by_name <- function(f5obj, objname=".", name) { #Mid-level utility function to read attributes 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 function for folder creation
F5dir <- function(path,name){
  dest <- file.path(path,name)
  if(!dir.exists(dest)){
    dir.create(dest,recursive=TRUE,showWarnings=FALSE)
  }
  return(dest)
}

#Shiny server top level function
server <- shinyServer(function(input, output, session){
  options(showWarnCalls = FALSE)

  RV <- reactiveValues(nf5=0L,f5_list=NULL,sourcedir=NULL,targetdir=NULL,status=NULL,metafile=NULL,files_created=NULL)
  
  output$statustxt <- renderText(RV$status)
  
  observeEvent(input$source_button,{
    RV$sourcedir <- dlgDir(default = getwd(),title="Select Source folder with Basecalled Files")$res
    setwd(RV$sourcedir)
    if(input$recursive){
      RV$f5_list <- list.files(path=RV$sourcedir,recursive=TRUE,full.names=FALSE,pattern="\\.fast5$") #recursive listing
    }
    else{
      RV$f5_list <- list.files(path=RV$sourcedir,recursive=FALSE,full.names=FALSE,pattern="\\.fast5$") #non-recursive listing
    }
    RV$nf5 <- length(RV$f5_list)
    RV$status <- paste("Updated Source Folder. Found", RV$nf5, "fast5 files")
    if(is.null(RV$targetdir)) RV$targetdir <- RV$sourcedir
  })
  observeEvent(input$target_button,{
    RV$targetdir <- dlgDir(default = getwd(),title="Select Target folder for Output Files")$res
  })
  output$sourcedirtxt <- renderText(RV$sourcedir)
  output$targetdirtxt <- renderText(RV$targetdir)
  
  observe({ #Implement Select All/None Button
    if (input$selectall > 0) {
      if (input$selectall %% 2 == 0){
        updateCheckboxGroupInput(session=session,inputId="file_types",selected = character(0))
        updateCheckboxGroupInput(session=session,inputId="dataset",selected = character(0))
      }
      else{
        updateCheckboxGroupInput(session=session,inputId="file_types",selected = c('fastq','fasta','meta'))
        updateCheckboxGroupInput(session=session,inputId="dataset",selected = c('2d','template','complement'))
      }
    }
  })
  
  observeEvent(input$meta_button,{
    RV$metafile <- dlgOpen(default = getwd(),title="Select Metadata File")$res
    RV$status <- "Metadata file selected"
  })
  output$metafiletxt <- renderText(RV$metafile)
  
  output$mainfig <- renderPlot({
    input$plot_button
    isolate({
      if(input$plot_button>0){
        if(is.null(RV$metafile)){
          RV$status <- "You need to select a metadata file for plotting. Please try again."
        }
        else{ #metafile selected - load data and show plots
          DT <- read.delim(RV$metafile,stringsAsFactors = FALSE) #read in metadata from file
          meta.plot(DT) #use meta.plot() function to generate a compound output plot 
        } #with metafile
      } #plot button>0
    }) #isolate
  }) #renderPlot
  
  meta.plot <- function(DT){
    #EXTRACT counts, start times and pass/fail
    lenT <- DT$lenT #1D Template
    lenC <- DT$lenC #1D Complement
    len2D <- DT$len2D #2D
    pass <- DT$pass #pass? true/false
    start_time <- DT$start_time
    npass <- sum(pass)
    nmeta <- length(lenT)
    
    layout(matrix(c(1,2,5,1,3,6,1,4,7), 3, 3)) #full layout - yield over read length hists
    par(cex.lab=1.5,cex.axis=1.1,cex.main=1.2)
    brk_log <- seq(from=0,to=6,by=0.1) #log10 histogram break points: 1 to 1 million
    xt <- c(1,10,100,1000,10000,100000) #x/y tick locations for seq len scatter plot
    xl <- c('1','10','100','1k','10k','100k') #x labels for seq len plots
    
    if(npass>1){ #with pass data
      lenT_p <- lenT[pass];
      
      lenC_p <- lenC[pass];
      lenC_p_pos <- lenC_p[lenC_p>0] #With R9 1D files without complement can pass
      if(length(lenC_p_pos)>0){
        pass_comp_txt <- paste('SeqLen. Mean:',round(mean(lenC_p_pos)))
      }
      else{
        pass_comp_txt <- 'SeqLen. NA'
      }
      
      len2D_p <- len2D[pass];
      len2D_p_pos <- len2D_p[len2D_p>0] #With R9 1D files without complement can pass
      if(length(len2D_p_pos)>0){
        pass_2d_txt <- paste('SeqLen. Mean, Max:',round(mean(len2D_p_pos)),',',round(max(len2D_p_pos)))
        
      }
      else{
        pass_2d_txt <- 'SeqLen. NA'
      }
      
      #start times for cumulative yield plot
      start_time <- start_time/3600 #convert from seconds to hours
      start_time_p <- start_time[pass]
      sorted_times <- sort.int(start_time_p,index.return=TRUE)
      last_time <- tail(sorted_times$x,n=1) #Use this time to scale cumulative yield plot by data
      xmax <- 6*ceiling(last_time/6)
      #LAYOUT PLOT 1 - Cumulative Yield
      y1 <- cumsum(lenT_p[sorted_times$ix])/1e6 #template mb
      if(length(len2D_p_pos)>0){ #if there is 2D pass data to plot
        y2 <- cumsum(len2D_p[sorted_times$ix])/1e6 #2d mb
        ymax <- max(tail(y1,n=1),tail(y2,n=1))
        plot(x=sorted_times$x,y=y1,type="l", col = 'blue', xlab="Read start time (h)",ylab="Cumulative mb",
             main="Cumulative Pass Yield. Blue=Template, Red=2D",ylim=c(0,ymax),xlim=c(0,xmax),xaxp  = c(0,xmax,6))
        lines(x=sorted_times$x,y=y2,type="l", col = 'red')
      }
      else{
        plot(x=sorted_times$x,y=y1,type="l", col = 'blue', xlab="Read start time (h)",ylab="Cumulative mb",
             main="Cumulative Pass Yield. Blue=Template, Red=2D",xlim=c(0,xmax),xaxp  = c(0,xmax,6))
      }
      
      #LAYOUT PLOT 2: 1D Template - pass
      hist(x=log10(lenT_p), breaks=brk_log, col = 'blue', border = 'white',xlab=paste('SeqLen. Mean:',round(mean(lenT_p))),
           main=paste('Pass T reads:',length(lenT_p)),xaxt="n")
      axis(side=1,at=0:5,labels=xl)
      
      #LAYOUT PLOT 3: 1D Complement - pass
      hist(x=log10(lenC_p), breaks=brk_log, col = 'green', border = 'white',xlab=pass_comp_txt,
           main=paste('Pass C reads:',length(lenC_p_pos)),xaxt="n")
      axis(side=1,at=0:5,labels=xl)
      
      #LAYOUT PLOT 4: 2D - pass
      hist(x=log10(len2D_p), breaks=brk_log, col = 'red', border = 'white',xlab=pass_2d_txt,
           main=paste('Pass 2D reads:',length(len2D_p_pos),'/',nmeta),xaxt="n")
      axis(side=1,at=0:5,labels=xl)
    }
    else { #no pass data. LAYOUT PLOT 1 - empty
      plot(x=0,y=0,type="l",xlab="Read start time (h)",ylab="Cumulative mb",
           main="Cumulative Pass Yield. NA: No Pass Data",xlim=c(0,6),xaxp  = c(0,6,6),ylim=c(0,1))
    }
    if(nmeta>npass){ #with fail data
      lenT_f <- lenT[!pass]; 
      lenT_f_pos <- lenT_f[lenT_f>0]
      if(length(lenT_f_pos)>0){
        lenC_f <- lenC[!pass]; 
        lenC_f_pos <- lenC_f[lenC_f>0]
        
        if(length(lenC_f_pos)>0){
          fail_comp_txt <- paste('SeqLen. Mean:',round(mean(lenC_f_pos)))
        }
        else{
          fail_comp_txt <- 'SeqLen. NA'
        }
        
        len2D_f <- len2D[!pass]
        len2D_f_pos <- len2D_f[len2D_f>0]
        
        if(length(len2D_f_pos)>0){
          fail_2d_txt <- paste('SeqLen. Mean, Max:',round(mean(len2D_f_pos)),',',round(max(len2D_f_pos)))
        }
        else{
          fail_2d_txt <- 'SeqLen. NA'
        }
        
        #LAYOUT PLOT 5: 1D Template - fail
        hist(x=log10(lenT_f_pos), breaks=brk_log, col = 'blue', border = 'white',xlab=paste('SeqLen. Mean:',round(mean(lenT_f_pos))),
             main=paste('Fail T reads:',length(lenT_f_pos)),xaxt="n")
        axis(side=1,at=0:5,labels=xl)
        
        #LAYOUT PLOT 6: 1D Complement - fail
        hist(x=log10(lenC_f_pos), breaks=brk_log, col = 'green', border = 'white',xlab=fail_comp_txt,
             main=paste('Fail C reads:',length(lenC_f_pos)),xaxt="n")
        axis(side=1,at=0:5,labels=xl)
        
        #LAYOUT PLOT 7: 2D - fail
        hist(x=log10(len2D_f_pos), breaks=brk_log, col = 'red', border = 'white',xlab=fail_2d_txt,
             main=paste('Fail 2D reads:',length(len2D_f_pos),'/',nmeta),xaxt="n")
        axis(side=1,at=0:5,labels=xl)
      }
    }
  } #meta.plot
  
  #DATA EXTRACTION OBSERVER. Looping version - prefer to invalidateLater for reliability
  obs <- observe({
    input$proc_button
    isolate({
      if(input$proc_button>0){
        if( (length(RV$sourcedir)==0) | (length(RV$targetdir)==0) ){
          RV$status <- "You need to select both source and target folders for Data extraction. Please try again."
        }
        else if(is.null(input$file_types))
          RV$status <- "You need to select at least one file type. Please try again."
        else if(is.null(input$dataset) && (('fasta' %in% input$file_types) || ('fastq' %in% input$file_types)))
          RV$status <- "You need to select at least one dataset to extract fastq or fasta data. Please try again."
        else if(RV$nf5>0){ #Source and target folder defined and fast5 files to process
          RV$status <- ""
          
          #Set Flags according to UI check box selections
          flag_fastq <- ("fastq" %in% input$file_types)
          flag_fasta <- ("fasta" %in% input$file_types)
          flag_meta <- ("meta" %in% input$file_types)
          flag_dt <- ("template" %in% input$dataset)
          flag_dc <- ("complement" %in% input$dataset)
          flag_d2d <- ("2d" %in% input$dataset)
          
          #collect flags to pass as input into processing function
          flags <- c(fastq=flag_fastq,fasta=flag_fasta,meta=flag_meta,dt=flag_dt,dc=flag_dc,d2d=flag_d2d)
          
          #Processing in runname-specified batches
          filenames <- RV$f5_list
          full_filenames <- file.path(RV$sourcedir,RV$f5_list) #filenames with full path
          filenames <- basename(filenames) #for recursive mode, strips out path elements in filenames
          
          #Get run names from file names
          inds <- regexpr("_\\d+_ch",filenames) #underscore, some digits, underscore, ch
          runnames <- substr(filenames,1,inds-1)
          runs <- unique(runnames)
          runs <- runs[nzchar(runs)]
          
          #print(runnames)
          
          cat("\n")
          start_msg <- paste0("Running Data Extraction on ",RV$nf5," fast5 files")
          print(start_msg)
          
          #PARALLEL CODE
          ptmp <- proc.time()
          cl <- makeCluster(input$ncore)
          clusterEvalQ(cl,library(rhdf5))
          for(r in 1:length(runs)){
            run <- runs[r]
            run_prefix <- paste("Run",r,"of",length(runs))
            print(paste(run_prefix,"-",run,"- Starting.."))
            
            target_run <- F5dir(RV$targetdir,run) #Output target: run name folder in target directory
            f5 <- full_filenames[runnames==run] #use filename with full path
            nf <- length(f5)
            
            #batch parallel code
            batch_size <- 5040 #fixed batch size for testing
            n_batch <- ceiling(nf/batch_size)
            batch_start <- 1
            withProgress(message = paste('Processing',run_prefix), value = 0, {
              for(b in 1:n_batch){
                pbatch <- proc.time()
                batch_txt <- paste("Batch",b,"of",n_batch)
                incProgress(0, detail = batch_txt)
                if(b == n_batch) batch_end <- nf
                else batch_end <- b*batch_size
                f5_batch <- f5[batch_start:batch_end]
                n_in_batch <- (1+batch_end-batch_start)
                dat <- parLapply(cl,f5_batch,extract.fast5,flags=flags) #main parallel process
                udat <- unlist(dat) #unlist the returned data from parLapply
                if(length(udat)>0){ #only proceed when returned data is present
                  dat_mat <- matrix(udat,ncol=18,byrow=TRUE,dimnames=list(NULL,names(udat[1:18]))) #convert to character matrix
                  
                  #remove error entries after matrix conversion 
                  errs <- (dat_mat[,'chan_num'] == 'error')
                  if(any(errs)) dat_mat <- dat_mat[!errs,]
                  yield_txt <- paste0(nrow(dat_mat),"/",n_in_batch," readable & basecalled files")
                  
                  if(input$use_pf){ #use pass/fail folder presence in source path to direct output to pass/fail folders (keep separate)
                    f5_test <- f5_batch[!errs]
                    
                    pass_ind <- grepl("/pass/",f5_test) #/pass/ in source file path
                    fail_ind <- grepl("/fail/",f5_test) #/fail/ in source file path
                    if(any(pass_ind&fail_ind)){ #some files have both pass and fail in source path
                      print("Warning: Some files in this batch have both /pass/ and /fail/ in source path. Redirecting data to fail")
                      pass_ind[fail_ind] <- F
                    }
                    other_ind <- !(pass_ind|fail_ind) #neither /pass/ or /fail/ in source file path
                    
                    if (any(pass_ind)){ #pass file output
                      target <- F5dir(target_run,'pass') #make output dir (if not present)
                      write.output(dat_mat[pass_ind, ,drop=F],flags,file.path(target,run))
                    }
                    
                    if (any(fail_ind)){ #fail file output
                      target <- F5dir(target_run,'fail') #make output dir (if not present)
                      write.output(dat_mat[fail_ind, ,drop=F],flags,file.path(target,run))
                    }
                    
                    if (any(other_ind)){ #not pass or fail file output
                      target <- F5dir(target_run,'other') #make output dir (if not present)
                      write.output(dat_mat[other_ind, ,drop=F],flags,file.path(target,run))
                    }
                  }
                  else{ #no pass fail folder redirection - aggregate output
                    write.output(dat_mat,flags,file.path(target_run,run))
                  }
                } #end of data writing
                time_batch <- proc.time()-pbatch
                batch_res_txt <- paste0(batch_txt,": ",yield_txt," extracted in ",round(time_batch[3],digits=1),"s")
                print(batch_res_txt)
                batch_start <- batch_start+batch_size
                incProgress(1/n_batch)
              } #for loop over batches
            })
            print(paste(run_prefix,"-",run,"- Complete"))
          } #for loop over runs
          stopCluster(cl)
          time_elapsed <- proc.time()-ptmp
          
          status_message <- paste0("Done. Processed ",RV$nf5," fast5 files in ",round(time_elapsed[3],digits=1),"s")
          RV$status <- status_message
          print(status_message)
        }
      } #processing button check
    }) #isolate
  }) #data extraction observer
  
  write.seq <- function(x,file){ #utility for writing sequence data
    append <- (file %in% RV$files_created)
    cat(x,sep='',file=file,append=append)
    if(!append) RV$files_created <- c(RV$files_created,file)
  }
  
  write.output <- function(dat_mat_init,flags,run_pre_init){ 
    #write desired output to file. 
    #dat_mat_init is a matrix of data with cols 1:12 metadata and 13:18 seq data
    #run_pre_init is a fixed, full path (run-dependent) prefix to the output file names
    barcodes <- dat_mat_init[,'barcode']
    bcs <- unique(barcodes)
    for(b in 1:length(bcs)){ #loop over barcodes
      bc <- bcs[b] #get barcode
      bc_ind <- barcodes==bc #set of data entries with the current barcode
      run_pre <- paste0(run_pre_init,"_",bc) #append barcode to run prefix
      dat_mat <- dat_mat_init[bc_ind, ,drop=F] #select data matrix rows for this barcode (drop defends against matrix -> vector dimension loss)

      if(flags['meta']){ #write metadata
        meta_file <- paste0(run_pre,"_meta.txt")
        append <- (meta_file %in% RV$files_created) #only append data to files we have created, otherwise overwrite
        write.table(dat_mat[,1:12,drop=F],file=meta_file,quote=FALSE,col.names=(!append),row.names=FALSE,sep="\t",append=append)
        if(!append){
          RV$files_created <- c(RV$files_created,meta_file)
        }
      }
      if(flags['fastq']){ #write fastq
        write_dt <- flags['dt'] && any(nzchar(dat_mat[,'fastqT']))
        write_dc <- flags['dc'] && any(nzchar(dat_mat[,'fastqC']))
        write_d2d <- flags['d2d'] && any(nzchar(dat_mat[,'fastq2D']))
        if(write_dt) write.seq(dat_mat[,'fastqT'],file=paste0(run_pre,"_T.fastq"))
        if(write_dc) write.seq(dat_mat[,'fastqC'],file=paste0(run_pre,"_C.fastq"))
        if(write_d2d) write.seq(dat_mat[,'fastq2D'],file=paste0(run_pre,"_2d.fastq"))
      }
      if(flags['fasta']){ #write fasta
        write_dt <- flags['dt'] && any(nzchar(dat_mat[,'fastaT']))
        write_dc <- flags['dc'] && any(nzchar(dat_mat[,'fastaC']))
        write_d2d <- flags['d2d']&& any(nzchar(dat_mat[,'fasta2D']))
        if(write_dt) write.seq(dat_mat[,'fastaT'],file=paste0(run_pre,"_T.fasta"))
        if(write_dc) write.seq(dat_mat[,'fastaC'],file=paste0(run_pre,"_C.fasta"))
        if(write_d2d) write.seq(dat_mat[,'fasta2D'],file=paste0(run_pre,"_2d.fasta"))
      }
    } #Loop over barcodes in this batch
  }
  
  #Function for data extraction from a single basecalled fast5 file (suitable for parallel processing)
  extract.fast5 <- function(filename,flags){
    fid <- try(H5Fopen(filename),silent = TRUE)
    filename_short <- basename(filename)
    
    data_line <- c(filename=filename_short,chan_num='-1',read_num='-1',start_time='-1',pass='F',lenT='0',lenC='0',len2D='0',
                   run_id='no_run_id',read_id='no_read_id',barcode='noBC',exp_start_time='-1',
                   fastqT='',fastaT='',fastqC='',fastaC='',fastq2D='',fasta2D='') #default data output values
    
    if(inherits(fid, "try-error")) { #Cannot read
      cat('\n',"Unreadable: ",filename_short,'\n')
      data_line['chan_num'] <- "error" #mark error in chan_num
      data_line['read_num'] <- "Unreadable" #store error type in read_num
      return(data_line)
    }
    else{ #Readable file - Run data extraction
      #Check for basecalled data, and 1d basecalled data location
      g_a2d <- "/Analyses/Basecall_2D_000"                      #Present in old and new style files with 2d basecall
      g_a1d <- "/Analyses/Basecall_1D_000"                      #Only in newer style files (use as marker)
      with_a1d <- FALSE; with_a2d <- FALSE
      
      if(H5Lexists(fid, g_a2d)){ #new 2017 code to check for basecalls beyond 000
        with_a2d <- TRUE
        stub <- "/Analyses/Basecall_2D_00"
        for (bcn in 1:9){ 
          test <- paste0(stub,bcn); #concatenate stub with base call number (bcn)
          if(H5Lexists(fid, test)){
            g_a2d <- test #update g_a2d
          }
          else{
            break
          }
        }
      }
      
      if(H5Lexists(fid, g_a1d)){
        g_top <- g_a1d #Post Nov 2015
        with_a1d <- TRUE
        #test for subsequent basecalls after 000
        stub <- "/Analyses/Basecall_1D_00"
        for (bcn in 1:9){ 
          test <- paste0(stub,bcn);
          if(H5Lexists(fid, test)){
            g_top <- test
          }
          else{
            break
          }
        }
      }
      else if(with_a2d) {
        g_top <- g_a2d #Pre Nov 2015
      }
      else{
        cat('\n',"Not Basecalled: ",filename_short,'\n')
        H5Fclose(fid)
        data_line['chan_num'] <- "error" #mark error in chan_num
        data_line['read_num'] <- "no_basecall" #store error type in read_num
        return(data_line)
      }
      g_ft <- paste0(g_top,"/BaseCalled_template/Fastq")        #template fastq data
      with_ft <- H5Lexists(fid, g_ft) #with template fastq data
      if(!with_ft){ #Error condition for no template fastq
        #cat('\n',"No T Fastq: ",filename_short,'\n')
        H5Fclose(fid)
        data_line['chan_num'] <- "error" #mark error in chan_num
        data_line['read_num'] <- "no_basecall" #store error type in read_num
        return(data_line)
      } #with_ft is TRUE below
      
      g_fc <- paste0(g_top,"/BaseCalled_complement/Fastq")      #complement fastq data
      with_fc <- H5Lexists(fid, g_fc) #with complement fastq data
      if(with_fc){
        g_f2d <- paste0(g_a2d,"/BaseCalled_2D/Fastq")  #2d fastq dataset
        with_f2d <- H5Lexists(fid, g_f2d) #with 2d fastq data
      }
      else with_f2d <- FALSE
      
      #Unbundle flags indicating required file types to guide data extraction
      flag_meta <- flags['meta']; flag_fastq <- flags['fastq']; flag_fasta <- flags['fasta']
      
      #Unconditionally extract barcode if present (March 2017)
      g_bc <- "/Analyses/Barcoding_000"
      if(H5Lexists(fid, g_bc)){ #check for barcode folder beyond 000
        stub <- "/Analyses/Barcoding_00"
        for (bcn in 1:9){ 
          test <- paste0(stub,bcn); #concatenate stub with number (bcn)
          if(H5Lexists(fid, test)){
            g_bc <- test #update g_bc (get latest numbered barcode data group)
          }
          else{
            break
          }
        }
        g_bc2 <- paste0(g_bc,"/Barcoding")
        data_line['barcode'] <- F5Aread_by_name(fid,g_bc2,"barcode_arrangement")
      }
      
      if(flag_meta){ #metadata output selected
        g_tid <- "/UniqueGlobalKey/tracking_id"                 #Same for all files
        if(H5Lexists(fid,g_tid)){ #Tracking ID
          gid <- H5Gopen(fid,g_tid) 
          data_line['run_id'] <- F5Aread(gid,"run_id") #get run_id
          data_line['exp_start_time'] <- as.character(F5Aread(gid,"exp_start_time"))
          H5Gclose(gid)
        }
        g_cid <- "/UniqueGlobalKey/channel_id"   #Same for all files
        if(H5Lexists(fid,g_cid)){ #Channel ID
          gid <- H5Gopen(fid,g_cid) 
          data_line['chan_num'] <- as.character(F5Aread(gid,"channel_number")) #get channel number
          sampling_rate <- as.numeric(F5Aread(gid,"sampling_rate")) #get sampling rate
          H5Gclose(gid)
        }
        else{sampling_rate <- 4000.0} #default sampling rate 4khz
        
        g_s2d <- paste0(g_a2d,"/Summary/basecall_2d")  #Summary data, 2d
        g_et <- paste0(g_top,"/BaseCalled_template/Events") #template basecall events 
        g_st <- paste0(g_top,"/Summary/basecall_1d_template") #template basecall summary - present in all basecalled minion files
        gid_st <- H5Gopen(fid,g_st) #summary template group
        #Initial file type diagnostics - and pass/fail
        no_config <- FALSE
        if(with_a1d){ #not old R7 file - could be newer R7 or R9
          with_raw <- H5Lexists(fid, "/Raw") #R9
          if(with_raw){ #R9
            g_config <- paste0(g_top,"/Configuration")
            if(H5Lexists(fid,g_config)){ #minKNOW basecalled files have no config; all other files have this
              if(H5Lexists(fid,paste0(g_top,"/Configuration/basecall_2d"))){ #R9, full 2D protocol
                if(with_fc) data_line['pass'] <- 'T'#ONT rule appears to be: pass if complement dataset is present
              }
              else{ #1D rapid protocol, Metrichor or Albacore
                g_c1d <- paste0(g_top,"/Configuration/basecall_1d")
                gid_c1d <- H5Gopen(fid,g_c1d)
                if(H5Aexists(gid_c1d,"min_mean_qscore")){
                  #pass if template mean quality >= 'min_mean_qscore'
                  min_mean_qscore <- as.numeric(F5Aread(gid_c1d,"min_mean_qscore"))
                  mean_qscore <- as.numeric(F5Aread(gid_st,"mean_qscore"))
                  if(mean_qscore >= min_mean_qscore) data_line['pass'] <- 'T'
                }
                else data_line['pass'] <- 'T' #Pass by default on 2017 Albacore files with no min_mean_qscore
                H5Gclose(gid_c1d)
              }
            }
            else{
              no_config <- TRUE
              mean_qscore <- as.numeric(F5Aread(gid_st,"mean_qscore"))
              if(mean_qscore >= 6.0) data_line['pass'] <- 'T' #assume 6 as min mean q score - not stored in file
            }
            #Find g_read group in /Raw/Reads
            gid <- H5Gopen(fid,"/Raw/Reads")
            tmp <- h5ls(gid,recursive=FALSE,datasetinfo=FALSE)
            H5Gclose(gid)
            g_read <- paste0("/Raw/Reads/",tmp$name)
          }
          with_slen <- TRUE #sequence_length attribute in basecall summary groups
        }
        else{ #Older R7
          with_raw <- FALSE
          with_slen <- H5Aexists(gid_st,"sequence_length") #check for slen
        }
        
        #Check pass/fail for R7 files
        if(!with_raw){ #R7
          if(with_f2d){ #with 2d fastq
            mean_qscore_2d <- as.numeric(F5Aread_by_name(fid,g_s2d,"mean_qscore")) #Get mean_qscore from 2d summary
            min_mean_qscore <- as.numeric(F5Aread_by_name(fid,paste0(g_a2d,"/Configuration/basecall_2d"),"min_mean_qscore"))
            if(mean_qscore_2d >= min_mean_qscore) data_line['pass'] <- 'T' #pass only true for 2d q score >= min
          }
          #Find g_read group in /Analyses/EventDetection_000/Reads
          g_edr <- "/Analyses/EventDetection_000/Reads"
          gid <- H5Gopen(fid,g_edr)
          tmp <- h5ls(gid,recursive=FALSE,datasetinfo=FALSE)
          H5Gclose(gid)
          g_read <- paste(g_edr,tmp$name,sep="/")
        }
        
        #Get read_num, start_time and read_id from g_read. For R9: /Raw/Reads/Read_n, For R7: EventDetection_000/Reads/Read_n
        if(H5Lexists(fid, g_read)){
          gid <- H5Gopen(fid,g_read)
          data_line['read_num'] <- as.character(F5Aread(gid,"read_number")) #store read number as character
          start_time <- as.numeric(F5Aread(gid,"start_time")) #start time in integer samples
          start_time <- floor(start_time/sampling_rate) #start time to nearest second
          data_line['start_time'] <- as.character(start_time) #store start_time as character
          if(H5Aexists(gid,"read_id")){
            data_line['read_id'] <- as.character(F5Aread(gid,"read_id")) #store read_id hash as character
          }
          H5Gclose(gid)
        }
        
        #Get sequence lengths from basecall summaries
        if(with_slen){
          data_line['lenT'] <- as.character(F5Aread(gid_st,"sequence_length"))
          if(with_fc){
            g_sc <- paste0(g_top,"/Summary/basecall_1d_complement") #complement basecall summary
            data_line['lenC'] <- as.character(F5Aread_by_name(fid,g_sc,"sequence_length"))
            if(with_f2d){ #get len2D
              data_line['len2D'] <- as.character(F5Aread_by_name(fid,g_s2d,"sequence_length"))
            }
          }
        }
        H5Gclose(gid_st)
      } #metadata
      
      #FASTQ and/or FASTA Extraction
      if(flag_fastq || flag_fasta){
        #TEMPLATE
        if (flags['dt']){
          fastq <- F5Dread(fid,g_ft) #read fastq dataset
          if(flag_fastq) data_line['fastqT'] <- fastq #output fastq
          if(flag_fasta){
            splits <- strsplit(fastq,split="\n",fixed=TRUE)[[1]] #get lines from fastq
            data_line['fastaT'] <- get.fasta(splits,filename)
          }
        }
        
        #COMPLEMENT
        if (flags['dc'] && with_fc){
          fastq <- F5Dread(fid,g_fc) #read fastq dataset
          if(flag_fastq) data_line['fastqC'] <- fastq #output fastq
          if(flag_fasta) {
            splits <- strsplit(fastq,split="\n",fixed=TRUE)[[1]] #get lines from fastq
            data_line['fastaC'] <- get.fasta(splits,filename)
          }
        }
        
        #2D
        if (flags['d2d'] && with_f2d){
          fastq <- F5Dread(fid,g_f2d) #read fastq dataset
          if(flag_fastq) data_line['fastq2D'] <- fastq #output fastq
          if(flag_fasta){
            splits <- strsplit(fastq,split="\n",fixed=TRUE)[[1]] #get lines from fastq
            data_line['fasta2D'] <- get.fasta(splits,filename)
          }
        }
      }
      
      H5Fclose(fid)
      return(data_line)
    } #If readable file
  } #function extract.fast5

  get.fasta <- function(fastq_splits,filename){ #get nanopolish-compatible fasta string from fastq
    header_space_ind <- regexpr(" ",fastq_splits[1],fixed=TRUE)
    #header <- paste0(">",substring(fastq_splits[1],2,header_space_ind),filename,'\n') #assumes full filename with path
    header <- paste0(">",sub("@", "",fastq_splits[1])," ",filename,'\n') #assumes full filename with path
    fasta <- paste0(header,fastq_splits[2],'\n')
  }
}) #shiny server

#UI
ui <- shinyUI(fluidPage(
  titlePanel("poRe Parallel GUI"),
  
  fluidRow(
    column(width=6, h4("Source Folder"),verbatimTextOutput('sourcedirtxt')
           #actionButton('source_button',"Choose Source Folder"),
           #checkboxInput(inputId="recursive",label="Recursive",value=TRUE)
    ),
    column(width=6, h4("Target Folder"),verbatimTextOutput('targetdirtxt')
           #actionButton('target_button',"Choose Target Folder")
    )
  ), 
  fluidRow(
    column(width=3,actionButton('source_button',"Choose Source Folder")),
    column(width=3,checkboxInput(inputId="recursive",label="Recursive Fast5 Search",value=TRUE)),
    column(width=3,actionButton('target_button',"Choose Target Folder")),
    column(width=3,checkboxInput(inputId="use_pf",label="Use pass/fail folder redirection",value=TRUE))
  ), 
  
  hr(),
  fluidRow(
    column(width=3,checkboxGroupInput(inputId="file_types",label="Select output file type(s)",
                              choices = c("Fastq" = "fastq","Fasta" = "fasta","Meta" = "meta"),
                              selected = "fastq")
    ),
    column(width=3,checkboxGroupInput(inputId="dataset",label="Select Dataset(s)",
                              choices = c("2D" = "2d","Template / 1D" = "template","Complement" = "complement"),
                              selected = "2d")
    ),
    column(width=3,sliderInput(inputId="ncore",label="Select N cores to use",
                                min=2,max=detectCores(),step=1,value=detectCores(),ticks=FALSE)
    )
  ),
  fluidRow(
    column(width=6,actionButton('selectall',"Select All/None")
    ),
    column(width=6,actionButton('proc_button',"Run Data Extraction")
    )
  ), hr(),
  fluidRow(
    column(width=12,h4("Status"),verbatimTextOutput('statustxt')
    )
  ), hr(),
  fluidRow(
    column(width=12,h4("Metadata File"),verbatimTextOutput('metafiletxt')
    )
  ),
  fluidRow(
    column(width=6,actionButton('meta_button',"Choose Metadata File")
    ),
    column(width=6,actionButton('plot_button',"Show/Update Plots")
    )
  ), hr(),
  fluidRow(
    column(width=12,plotOutput("mainfig",height = "600px") #Cumulative yield, and sequence length histograms and scatterplots
    )
  )
))

shinyApp(ui = ui, server = server)