# TODO: Add comment # # Author: E.Korsching Jul 2, 2012, GPL licence ############################################################################### tins.import <- function( raw="/path/to/file", raw.header=F, raw.sample.name=F, mapping="/path/to/file", log="/path/to/file", result="/path/to/file", library.path="/path/to/libray") { # import input and output data of the Fortran programs # purpose: to plot graphs in R from the results and make additional downstream analyses etc. # additionally a correlation matrix (Pearson) for the start situation will be created # to keep things in a line, we will use here a Fortran library to keep the numerical results # identical to what the pure fortran programs are doing # This library can also be used to create every other correlation matrix # For comparison reasons also a correlation matrix created by the R function will be given # two examples of a function call can be found in tma.inspiration.examples.R # import input data: # raw: give here the path to the raw data file (tab separated format) # mapping: give here the path to the mapping file (one line, tab separated format) # import output data: # accepted result types: (a) all combinations or (b) one combination and resampling # log: give here the path to the log file of the corresponding input file(s) / chosen start parameters # result: give here the path to the result file of the corresponding log file # library.path: give a path to the provided Fortran dynamic link library (libsCor.so) # return value: a list with all necessary data objects # marker: list of markers in the order of the log file # nref: number of reference factors/markers # data: raw input data # corTableF: correlation matrix of start combination by the Fortran library # corTableR: correlation matrix of start combination by the R function # result: data frame of ssqg values and orders # combination: (left to right): column with ssqg value, reference columns, test columns, order of test columns # order numbers refer to the test column order which point to the log file order # sampling: (left to right): column with ssqg value, order of test columns # numbers refer to the log file order # result.file.name: record the used result file name # log.file.name: record the used log file name # file.date: record the result file date # import.date: record the time of the import function call # get file name raw.file.name <- basename(raw) mapping.file.name <- basename(mapping) result.file.name <- basename(result) log.file.name <- basename(log) # get file date file.date <- file.info(result)$mtime # import mapping M <- read.table(file=mapping, header=F, sep="\t", dec=".", na.strings="NA", colClasses=NA, check.names=TRUE, blank.lines.skip=TRUE, comment.char="#", stringsAsFactors=FALSE ) M.1 <- as.integer(M[ , -c(1,2)]) # strip the col header and row header flags # import raw data dat <- read.table(file=raw, header=raw.header, sep="\t", dec=".", na.strings="NA", colClasses=NA, check.names=TRUE, blank.lines.skip=TRUE, comment.char="#", stringsAsFactors=FALSE ) if(raw.sample.name==T){ row.names(dat) <- dat[,1] dat <- dat[,-1] } dat <- as.matrix(dat) # import log L <- readLines(con=log) #line by line # import result res <- read.table(file=result, header=FALSE, sep="\t", dec=".", na.strings="NA", colClasses=NA, check.names=TRUE, blank.lines.skip=TRUE, comment.char="#", stringsAsFactors=FALSE ) # extract number of reference factors from log # we need this for interpretation of the mapping file x.position <- grep(pattern="reference:", x=L, ignore.case=FALSE) #x.position : line number if(length(x.position)<1 | length(x.position)>1){ cat("\n Problem: Did not find term 'reference:' in log file."); stop() } x.str <- paste(L[x.position], collapse="") # extract line, results in a vector with one element tmp <- regexpr(pattern=":", text=x.str) # evaluate extra - error as argument in another function call tmp2 <- nchar(x.str) x.str.vec <- substr(x=x.str, start=tmp+1, stop=tmp2) # extract number x.str.vec <- sub(pattern="^[ \t]+", replacement="", x=x.str.vec) # remove leading spaces/tabs, sub(): only one action at time x.str.vec <- sub(pattern="[ \t]+$", replacement="", x=x.str.vec) # remove trailing spaces/tabs nref <- as.integer(x.str.vec) # convert into number # extract marker line from log x.position <- grep(pattern="marker:", x=L, ignore.case=FALSE) #x.position : line number if(length(x.position)<1 | length(x.position)>1){ cat("\n Problem: Did not find term 'marker:' in log file."); stop() } x.str <- paste(L[x.position], collapse="") # extract line, results in a vector with one element tmp <- regexpr(pattern=":", text=x.str) # evaluate extra - error as argument in another function call tmp2 <- nchar(x.str) x.str.vec <- substr(x=x.str, start=tmp+1, stop=tmp2) # extract marker names x.str.vec <- sub(pattern="^[ \t]+", replacement="", x=x.str.vec) # remove leading spaces/tabs, sub(): only one action at time x.str.vec <- sub(pattern="[ \t]+$", replacement="", x=x.str.vec) # remove trailing spaces/tabs marker <- unlist(strsplit(x=x.str.vec, split="[ ]{1,}")) # split by one or multiple spaces ## Fortran definitions; to be sure the data format is right # and creation of data structures for the Fortran dll n <- as.integer(length(marker)) ndat <- as.integer(nrow(dat)) cref <- M.1[1:nref] mode(cref) <- 'integer' ctest <- M.1[(nref+1):length(M.1)] mode(ctest) <- 'integer' mode(dat) <- 'single' ntest <- n-nref corrmatrix <- matrix(0, ntest, nref) mode(corrmatrix) <- 'single' #Fortran call dyn.load(library.path) f.back <- .Fortran("workflow", n=n, # n: total number of markers k=nref, # k: number of markers to be in the reference set nrow=ndat, # nrow: number of data rows cref=cref, # cref: vector of indices of reference set ctest=ctest, # ctest: vector of indices of test set rawdata=dat, # rawdata: the raw data from the data file corrmatrix=corrmatrix # corrmatrix: correlation matrix ) dyn.unload(library.path) # check (manually) for numerical differences between Fortan and R cor functions # have in mind that the main Fortran program will in cases where SD=0 randomly generate some very small cor values (see documentation) # so you might find in this R based cor table some corresponding rows of NA values test.cor <- matrix(0, ntest, nref) l1 <- 1 for(i in cref){ l2 <- 1 for(j in ctest){ test.cor[l2, l1] <- cor(x=dat[ , i],y=dat[ , j]) l2 <- l2+1 } l1 <- l1+1 } ## customize names etc. # extract or create raw data col names if(raw.header){ dat.names <- dimnames(dat)[[2]] }else{ dat.names <- paste("c", seq(1, ncol(dat)), sep="") } # create reference group and initial order / create test group and initial order cref.names <- dat.names[cref] ctest.names <- dat.names[ctest] # crosscheck to avoid a mixup of different files (this check is limited but worth to do) cat("\n data file") cat("\n data REF ", cref.names) cat("\n data TEST ", ctest.names, "\n") if( sum(c(cref.names,ctest.names)!=marker)>0 ){ cat("\n Please check your files - they do not correspond") cat("\n log file") cat("\n log ", marker, "\n") return() } # place names at the appropriate places of the data structures f.corrmatrix <- f.back$corrmatrix dimnames(f.corrmatrix)[[1]] <- ctest.names dimnames(f.corrmatrix)[[2]] <- cref.names # dimnames(test.cor)[[1]] <- ctest.names dimnames(test.cor)[[2]] <- cref.names # nc.res <- ncol(res) if( nc.res == (ntest+1) ){ dimnames(res)[[2]] <- c( "ssqg", rep("order", times=ntest) ) }else{ dimnames(res)[[2]] <- c( "ssqg", c(rep("ref", times=nref), rep("test", times=ntest), rep("order", times=ntest)) ) } # sort the result file according to the ssqg values ascending # the row index is given in the row names and enables to find the start order in the that case # where the choosen situation is not the best ssqg situation between all the sampling situations res <- res[order(res[,1]), ] ## customize data.frame erg <- list(marker=marker, nref=nref, data=dat, corTableF=f.corrmatrix, corTableR=test.cor, result=res, result.file.name=result.file.name, log.file.name=log.file.name, file.date=file.date, import.date=format(Sys.time(), "%Y %m %d %H:%M:%S") ) return(erg) }