Nothing
######################################################################
# write.cross.qtab.R
#
# copyright (c) 2012-2019, Karl W Broman and Danny Arends
# last modified Dec, 2019
# first written Jul, 2012
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License,
# version 3, as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but without any warranty; without even the implied warranty of
# merchantability or fitness for a particular purpose. See the GNU
# General Public License, version 3, for more details.
#
# A copy of the GNU General Public License, version 3, is available
# at http://www.r-project.org/Licenses/GPL-3
#
# Part of the R/qtl package
# Contains: write.cross.qtab
# rqtl.to.qtab.* where * = symbols, location, genotypes, phenotypes, founder
# get.qtlHD.ID, get.indID.for.qtab, getgenonames.for.qtab
# get.qtab.geno.symbols, get.phenotype.type
#
######################################################################
# write cross in a set of qtab-format files
write.cross.qtab <-
function(cross, filestem="data", descr, verbose=TRUE)
{
if(!inherits(cross, "cross"))
stop("Input should have class \"cross\".")
if(missing(descr)) descr <- paste(deparse(substitute(cross)), "from R/qtl")
# for now, omit X chromosome
chr_type <- sapply(cross$geno, chrtype)
if(any(chr_type == "X")) {
cross <- subset(cross, chr=names(chr_type)[chr_type != "X"])
warning("Omitting X chromosome.")
}
if(verbose) cat("Writing symbols\n")
rqtl.to.qtab.symbols(cross, paste(filestem,"_symbols.qtab",sep=""), descr=descr)
if(verbose) cat("Writing founder file\n")
rqtl.to.qtab.founder(cross, paste(filestem,"_founder.qtab",sep=""), descr=descr)
if(verbose) cat("Writing genetic map\n")
rqtl.to.qtab.location(cross, paste(filestem,"_location.qtab",sep=""), descr=descr)
if(verbose) cat("Writing genotypes\n")
rqtl.to.qtab.genotypes(cross, paste(filestem,"_genotypes.qtab",sep=""), descr=descr)
if(verbose) cat("Writing phenotypes\n")
rqtl.to.qtab.phenotypes(cross, paste(filestem,"_phenotypes.qtab",sep=""), descr=descr)
}
# version number for qtlHD
get.qtlHD.ID <-
function(){
VER <- "0.1"
ID <- paste("qtlHD-in-", VER, sep="")
ID
}
# individual IDs for qtab files
get.indID.for.qtab <-
function(cross)
{
id <- getid(cross)
if(is.null(id)) id <- 1:nind(cross)
paste("ID_", id, sep="")
}
# genotype codes for qtab files
getgenonames.for.qtab <-
function(cross)
{
gnames <- getgenonames(crosstype(cross), "A", "full", getsex(cross), attributes(cross))
if(crosstype(cross) == "f2") {
gnames <- c(gnames, paste(gnames[1], "or", gnames[2], sep=""), paste(gnames[2], "or", gnames[3], sep=""))
}
c("-", gnames)
}
# qtab genotypes symbols
get.qtab.geno.symbols <-
function(cross)
{
crtype <- crosstype(cross)
if(crtype == "bc") {
return(c("None", "0,0", "0,1"))
}
if(crtype == "riself" || crtype == "risib") {
return(c("None", "0,0", "1,1"))
}
if(crtype == "f2") {
return(c("None", "0,0", "0,1 1,0", "1,1", "0,0 0,1 1,0", "0,1 1,0 1,1"))
}
stop("cross type \"", crtype, "\" not yet supported for qtab.")
}
# write qtab symbols
rqtl.to.qtab.symbols <-
function(cross, filename="symbols.qtab",descr)
{
if(missing(descr)) descr <- paste(deparse(substitute(cross)), "from R/qtl")
cat(file=filename, "# --- ",get.qtlHD.ID()," Symbol ",descr, "\n",sep="");
cat(file=filename, "# --- Genotype Symbol begin\n", append=TRUE)
gnames <- getgenonames.for.qtab(cross)
symbols <- get.qtab.geno.symbols(cross)
for(i in seq(along=gnames)) {
cat(file=filename, gnames[i], " as ", symbols[i], "\n", sep="", append=TRUE)
}
cat(file=filename, "# --- Genotype Symbol end\n", append=TRUE)
}
# write qtab marker map
rqtl.to.qtab.location <-
function(cross, filename="locations.qtab", descr)
{
if(missing(descr)) descr <- paste(deparse(substitute(cross)), "from R/qtl")
cat(file=filename, "# --- ",get.qtlHD.ID()," Location ", descr, "\n", sep="")
cat(file=filename, "# --- Data Location begin\n", append=TRUE)
cat(file=filename, "#\tChr\tPos\n", append=TRUE)
map <- pull.map(cross, as.table=TRUE)
map <- cbind(rownames(map), map)
write.table(map, file=filename, append=TRUE, quote=FALSE, sep="\t", na="-", row.names=FALSE, col.names=FALSE)
cat(file=filename, "# --- Data Location end\n", append=TRUE)
}
rqtl.to.qtab.genotypes <-
function(cross, filename="genotypes.qtab", descr)
{
if(missing(descr)) descr <- paste(deparse(substitute(cross)), "from R/qtl")
cat(file=filename, "# --- ",get.qtlHD.ID()," Genotype ", descr, "\n", sep="")
cat(file=filename, "# --- Data Genotype begin\n", append=TRUE)
# pull out genotypes data; convert to strings
genotypes <- pull.geno(cross)
genotypes[is.na(genotypes)] <- 0
gnames <- getgenonames.for.qtab(cross)
gstr <- matrix(rep("", prod(dim(genotypes))), ncol=ncol(genotypes))
for(i in seq(along=gnames))
gstr[genotypes == (i-1)] <- gnames[i]
# add column with individual IDs
id <- get.indID.for.qtab(cross)
gstr <- cbind(id, gstr)
# marker names
cat(file=filename, "#", paste(colnames(genotypes), collapse="\t"), "\n", sep="", append=TRUE)
# genotypes
write.table(gstr, file=filename, append=TRUE, quote=FALSE, sep="\t", na="-", row.names=FALSE, col.names=FALSE)
cat(file=filename, "# --- Data Genotype end\n", append=TRUE)
}
rqtl.to.qtab.phenotypes <-
function(cross, filename="phenotypes.qtab", descr)
{
if(missing(descr)) descr <- paste(deparse(substitute(cross)), "from R/qtl")
cat(file=filename, "# --- ",get.qtlHD.ID()," Phenotype ", descr, "\n", sep="")
cat(file=filename, "# --- Type Phenotype begin\n", append=TRUE)
for(phename in colnames(cross$pheno)) {
cat(file=filename, phename, "\t", get.phenotype.type(cross,phename), "\n", sep="", append=TRUE)
}
cat(file=filename, "# --- Type Phenotype end", "\n", sep="", append=TRUE)
cat(file=filename, "# --- Data Phenotype begin", "\n", sep="", append=TRUE)
cat(file=filename, "#", paste(colnames(cross$pheno), collapse="\t"), "\n", sep="", append=TRUE)
# add column with individual IDs
id <- get.indID.for.qtab(cross)
phe <- cbind(id, cross$pheno)
write.table(phe, file=filename, append=TRUE, quote=FALSE, sep="\t", na="-", row.names=FALSE, col.names=FALSE)
cat(file=filename, "# --- Data Phenotype end", "\n", sep="", append=TRUE)
}
get.phenotype.type <-
function(cross, phenotype)
{
if(is.numeric(cross$pheno[,phenotype])) return("Float")
if(is.character(cross$pheno[,phenotype])) return("Char")
if(is.factor(cross$pheno[,phenotype])) return("Char")
return("Float")
}
rqtl.to.qtab.founder <-
function(cross, filename="founder.qtab", descr)
{
if(missing(descr)) descr <- paste(deparse(substitute(cross)), "from R/qtl")
cat(file=filename, "# --- ",get.qtlHD.ID()," Founder ", descr, "\n", sep="")
cat(file=filename, "# --- Set Founder begin\n", append=TRUE)
cat(file=filename, "Cross\t", toupper(crosstype(cross)), "\n", sep="", append=TRUE)
cat(file=filename, "# --- Set Founder end\n", append=TRUE)
}
# end of write.cross.qtab.R
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.