#
# postprocessing.R
#
# Copyright (c) 2010-2012 GBIC: Danny Arends, Konrad Zych and Ritsert C. Jansen
# last modified May, 2012
# first written Nov, 2011
# Contains: orderChromosomes, majorityRule.internal, mergeChromosomes.internal,
# switchChromosomes.internal, removeChromosomes.internal
# removeChromosomesSub.internal
#
# mergeChromosomes.internal
#
# DESCRIPTION:
# Subfunction of segragateChromosomes.internal, merging multiple chromosomes into one
# PARAMETERS:
# - cross - object of class cross
# - chromosomes - chromosomes to be merged
# - name - name of merged chromosome
# OUTPUT:
# An object of class cross
#
mergeChromosomes.internal <- function(cross, chromosomes, name, verbose=FALSE){
if(verbose)cat("Merging chromosomes",chromosomes,"to form chromosome",name,"names:",names(cross$geno),"\n")
geno <- cross$geno
markerNames <- NULL
for(j in chromosomes){
if(j!=name) markerNames <- c(markerNames, colnames(geno[[j]]$data))
}
for(k in markerNames) cross <- movemarker(cross, k, name)
invisible(cross)
}
############################################################################################################
# *** switchChromosomes.internal ***
#
# DESCRIPTION:
# switching two chromosomes of cross object
#
# cross - object of R/qtl cross type
# chr1, chr2 - numbers of chromosomes to be switched (1,2) == (2,1)
#
############################################################################################################
switchChromosomes.internal <- function(cross, chr1, chr2){
cat(chr1,chr2,"\n")
if(chr1!=chr2){
geno <- cross$geno
cross$geno[[chr1]] <- geno[[chr2]]
cross$geno[[chr2]] <- geno[[chr1]]
cross <- est.rf(cross)
}
invisible(cross)
}
############################################################################################################
# *** reduceChromosomesNumber ***
#
# DESCRIPTION:
# Function to remove chromosomes from cross object. Those can specified in three ways described below.
#
# PARAMETERS:
# cross - object of class cross
# numberOfChromosomes - how many chromosomes should stay (remove all but 1:numberOfChromosomes)
# verbose - be verbose
#
# OUTPUT:
# object of class cross
#
############################################################################################################
reduceChromosomesNumber <- function(cross, numberOfChromosomes,verbose=FALSE){
if(is.null(cross)&&!(any(class(cross)=="cross"))) stop("Not a cross object!\n")
if(!(missing(numberOfChromosomes))){
if(numberOfChromosomes<length(cross$geno)){
for(i in length(cross$geno):(numberOfChromosomes+1)){
cross <- removeChromosomesSub.internal(cross,i,verbose)
}
}
}else{
stop("You have to provide one of following: numberOfChromosomes, chromosomes or minLength")
}
invisible(cross)
}
############################################################################################################
# *** removeChromosomes ***
#
# DESCRIPTION:
# Function to remove chromosomes from cross object. Those can specified in three ways described below.
#
# PARAMETERS:
# numberOfChromosomes - how many chromosomes should stay (remove all but 1:numberOfChromosomes)
# chromosomesToBeRmv - explicitly provide functions with NAMES of chromosomes to be removed
# verbose - be verbose
#
# OUTPUT:
# object of class cross
#
############################################################################################################
removeChromosomes <- function(cross, chromosomesToBeRmv, verbose=FALSE){
if(is.null(cross)&&!(any(class(cross)=="cross"))) stop("Not a cross object!\n")
if(!(missing(chromosomesToBeRmv))){
for(i in chromosomesToBeRmv){
if(!(i%in%names(cross$geno))){
stop("There is no chromosome called ",i,"\n")
}else{
cross <- removeChromosomesSub.internal(cross,i,verbose)
}
}
}else{
stop("You have to provide one of following: numberOfChromosomes, chromosomes or minLength")
}
invisible(cross)
}
############################################################################################################
# *** removeTooSmallChromosomes ***
#
# DESCRIPTION:
# Function to remove chromosomes from cross object. Those can specified in three ways described below.
#
# PARAMETERS:
# cross - object of class cross
# verbose - be verbose
# minNrOfMarkers - specify minimal number of markers chromosome is allowed to have (remove all that have
# less markers than that)
#
# OUTPUT:
# object of class cross
#
############################################################################################################
removeTooSmallChromosomes <- function(cross, minNrOfMarkers, verbose=FALSE){
if(is.null(cross)&&!(any(class(cross)=="cross"))) stop("Not a cross object!\n")
if(!(missing(minNrOfMarkers))){
if(length(cross$geno)>1){
if(length(cross$geno[[1]]$map)<minNrOfMarkers) minNrOfMarkers <- length(cross$geno[[1]]$map)-1
for(i in length(cross$geno):1){
if(length(cross$geno[[i]]$map)<minNrOfMarkers){
cross <- removeChromosomesSub.internal(cross,i,verbose)
}
}
}
}else{
stop("You have to provide one of following: numberOfChromosomes, chromosomes or minLength")
}
invisible(cross)
}
############################################################################################################
# *** removeChromosomesSub.internal ***
#
# DESCRIPTION:
# subfunction of removeChromosomes.internal, removing from given cross object specified chromosome
#
# PARAMETERS:
# cross - object of class cross
# chr - chromosome to be removed (number or name)
#
# OUTPUT:
# object of class cross
#
############################################################################################################
removeChromosomesSub.internal <- function(cross, chr,verbose=FALSE){
if(verbose)cat("removing chromosome:",chr," markers:",names(cross$geno[[chr]]$map),"\n")
cross$rmv <- cbind(cross$rmv,cross$geno[[chr]]$data)
cross <- drop.markers(cross, names(cross$geno[[chr]]$map))
invisible(cross)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.