R/ziplinR.R

Defines functions ziplinR

Documented in ziplinR

#'The main function to project positions from one map to another
#'
#'The main function to project positions from one map to another
#'
#'@param map a map containing the positions to be projected. The map format is the same as the one used by Rqtl, ie a list of vectors of positions
#'@param map1 the first reference map
#'@param map2 the second reference map
#'@param map2tomap1 if TRUE the positions of map will be projected from map2 to map1. Default is FALSE
#'@param exclude a vector of marker names to exclude from references, typically showing discrepancies
#'@param shift.extrem if TRUE (default) the new map will be shifted in case some positions are projected to negative values
#'@return a map of new projected positions
#'@author J.-F. Rami \email{rami@@cirad.fr}
#'@examples
#'data(sorgho_p118)
#'genomv2<-as.map(genomv2.df)
#'#create a new dummy map
#'newmap<-as.map(data.frame(mk=paste("m",1:1000,sep=""),chr=c(rep(1,500),rep(2,500)),Pos=round(c(sort(runif(n=500,min=1,max=1e8)),sort(runif(n=500,min=1,max=1e8))),0)))
#'newmap.genet<-ziplinR(map=newmap,map1=genomv2,map2=p118.genet,exclude = "SB_06_045",shift.extrem = T)
ziplinR<-function(map, map1, map2, named.chr=T, map2tomap1 = F, shift.extrem=T,exclude=NULL){
  if (!map2tomap1){
    conv<-make.conv(map1=map1,map2=map2,exclude=exclude)
  } else{
    conv<-make.conv(map1=map2,map2=map1,exclude = exclude)
  }
  if (!named.chr){
    nchr<-length(map)
    if (nchr!=length(map1)) stop("map must have the same number of chromosomes as map1 and map2 when named.chr=F")
    map.cm<-lapply(1:nchr,function(a)
      sapply(map[[a]], function(b)
               new.pos(a = c(a,b),conv)
        )
      )    
  }else{
    nchr<-length(map)
    map.cm<-lapply(1:nchr,function(a){
      chr<-match(names(map)[a],names(map1))
      sapply(map[[a]], function(b)
        new.pos(a = c(chr,b),conv)
      )}
    )
  }
  names(map.cm)<-names(map)
  if (shift.extrem){
    map.cm<-lapply(map.cm, function(a) a-ifelse(min(a)<0,min(a),0))
  }
  return(map.cm)
}
jframi/ziplinR documentation built on April 10, 2020, 4:38 a.m.