R/testmegawrapper.R

Defines functions runMega

Documented in runMega

#' Test of MEGA in R
#' 
#' @param analysis_file Filename of MAO file generated by prototyper
#' @param data_file Filename of data file
#' @param out_file Name of temporary output file
#' @param out_parse Datatype of MEGA output
#' 
#' @return Data from MEGA
#' 
#' @author Jared Knoblauch
#' 
#' @export
#' @import ape
#' 
#' 



runMega <- function(analysis_file,data_file,out_prefix="mega_out",calib_file="",groups_file="",tree_file="",delete_file=FALSE) {
  
  getMegaName <- function() {
    sp = Sys.info()['sysname']
    if (sp == "Linux" || sp == "Darwin") {
      return("megacc")
    }
    return('megacc.exe')
  }
  
  
  getFileNo <- function(f,prefix) {
    start_pos = nchar(prefix)+1
    end_pos = attr(regexpr(paste(prefix,"[0-9]*",sep=""),f),'match.length')
    if(start_pos > end_pos) { return(0) }
    file_no = as.integer(substr(f,start_pos,end_pos))
    #if (is.na(file_no)) { return(0) }
    return(file_no)
  }
  
  getNextFileNo <- function(prefix) {
    files = list.files(pattern=paste(prefix,'.*summary\\.txt',sep=''))
    max_fileno = 0
    for (f in files) {
      max_fileno = max(max_fileno,getFileNo(f,prefix))
    }
    return(max_fileno+1)
    
  }
  
  getOutFiles <- function(run_prefix) {
    files = list.files(pattern=paste(run_prefix,"[^0-9]",sep=""))
    out_files = list()
    for (f in files) {
      is_summary = attr(regexpr('summary\\.txt',f),'match.length')
      if (is_summary == -1) {
        file_suffix = substr(f,nchar(run_prefix)+2,100000)
        print(file_suffix)
        #out_files[[file_suffix]] = f
        ftds = fileToDataStructure(f)
        if (!is.null(ftds)) {
          out_files[[file_suffix]] = fileToDataStructure(f)
        }
        #out_files = append(out_files,f)
      }
    }
    return(out_files)
  }
  
  fileToDataStructure <- function(filename) {
    ss = strsplit(filename,"\\.")
    print(filename)
    file_ext = ss[[1]][length(ss[[1]])]
    if (file_ext == "csv") {
      ret = read.csv(filename,row.names=1)
    } else if(file_ext == 'nwk') {
      ret = read.tree(filename)
    } else if(file_ext == 'tre') {
      ret = read.nexus(filename)
    } else {
      #ret = read.table(filename,sep="\t")
      ret = NULL
    }
    return(ret)
  }
  
  next_fileno = getNextFileNo(out_prefix)
  run_prefix = paste(out_prefix,next_fileno,sep="")
  cmd_string = paste("-a",analysis_file,"-d",data_file,"-o",run_prefix)
  if (nchar(calib_file) != 0) {
    cmd_string = paste(cmd_string,"-c",calib_file)
  }
  if (nchar(groups_file) != 0) {
    cmd_string = paste(cmd_string,"-g",groups_file)
  }
  if (nchar(tree_file) != 0) {
    cmd_string = paste(cmd_string,"-t",tree_file)
  }
  system2(getMegaName(),args=cmd_string)
  out_files = getOutFiles(run_prefix)
  return(out_files)
}


#a <- runMega("a.txt","b.txt")
#print (a)
jaredgk/megarwrapper documentation built on May 14, 2021, 8:59 p.m.