/usr/lib/R/site-library/GenABEL/unitTests/runit.exports.R is in r-cran-genabel 1.7-6-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | ### --- Test setup ---
#
# regression tests
#
if(FALSE) {
## Not really needed, but can be handy when writing tests
library(RUnit)
library(GenABEL)
}
### do not run
#stop("SKIP THIS TEST")
###
### ---- common functions and data -----
#source(paste("../inst/unitTests/shared_functions.R"))
#source(paste(path,"/shared_functions.R",sep=""))
### --- Test functions ---
test.exports <- function()
{
data(ge03d2.clean)
nTestIds <- sample(c(10:min(100,nids(ge03d2.clean))),1)
nTestSnps <- sample(c(10:min(1000,nsnps(ge03d2.clean))),1)
dta <- ge03d2.clean[sort(sample(1:nids(ge03d2.clean),nTestIds)),
sort(sample(1:nsnps(ge03d2.clean),nTestSnps))]
export.plink(dta,filebasename="tmpOld",dpieceFun="old")
export.plink(dta,filebasename="tmpNew",dpieceFun="new")
xO <- read.table(file="tmpOld.ped",head=FALSE,strings=FALSE)
xN <- read.table(file="tmpNew.ped",head=FALSE,strings=FALSE)
checkIdentical(xN,xO)
xO <- read.table(file="tmpOld.map",head=FALSE,strings=FALSE)
xN <- read.table(file="tmpNew.map",head=FALSE,strings=FALSE)
checkIdentical(xN,xO)
xO <- read.table(file="tmpOld.map.ext",head=FALSE,strings=FALSE)
xN <- read.table(file="tmpNew.map.ext",head=FALSE,strings=FALSE)
checkIdentical(xN,xO)
unlink("tmpOld*")
unlink("tmpNew*")
export.merlin(dta,pedfile="tmpOld.ped",datafile="tmpOld.dat",
mapfile="tmpOld.map",dpieceFun="old")
export.merlin(dta,pedfile="tmpNew.ped",datafile="tmpNew.dat",
mapfile="tmpNew.map",dpieceFun="new")
xO <- read.table(file="tmpOld.ped",head=FALSE,strings=FALSE)
xN <- read.table(file="tmpNew.ped",head=FALSE,strings=FALSE)
checkIdentical(xN,xO)
xO <- read.table(file="tmpOld.map",head=FALSE,strings=FALSE)
xN <- read.table(file="tmpNew.map",head=FALSE,strings=FALSE)
checkIdentical(xN,xO)
xO <- read.table(file="tmpOld.map.ext",head=FALSE,strings=FALSE)
xN <- read.table(file="tmpNew.map.ext",head=FALSE,strings=FALSE)
checkIdentical(xN,xO)
xO <- read.table(file="tmpOld.dat",head=FALSE,strings=FALSE)
xN <- read.table(file="tmpNew.dat",head=FALSE,strings=FALSE)
checkIdentical(xN,xO)
unlink("tmpOld*")
unlink("tmpNew*")
export.plink(dta,filebasename="tmpTrans",transpose=TRUE)
convert.snp.tped(tpedfile="tmpTrans.tped",tfamfile="tmpTrans.tfam",out="tmpTrans.raw")
xBack <- load.gwaa.data(gen="tmpTrans.raw",phe="tmpTrans.phe",id="IID")
strand(xBack) <- strand(dta)
phdata(xBack) <- phdata(xBack)[,-1]
sameCode <- which(coding(dta) == coding(xBack))
checkIdentical(xBack[,sameCode],dta[,sameCode])
swappedCode <- which(refallele(dta)==effallele(xBack) & effallele(dta)==refallele(xBack))
for (i in swappedCode) {
gtDta <- c(2,1,0)[as.vector(as.numeric(dta[,i]))+1]
gtBack <- as.vector(as.numeric(xBack[,i]))
print(checkIdentical(gtBack,gtDta))
}
unlink("tmpTrans*")
}
test.export.merlin.bug2525 <- function()
{
data(srdta)
export.merlin(
srdta[,1:2],dpieceFun="new",
mapfile="tmpNew.map",pedfile="tmpNew.ped",datafile="tmpNew.dat"
)
export.merlin(
srdta[,1:2],dpieceFun="old",
mapfile="tmpOld.map",pedfile="tmpOld.ped",datafile="tmpOld.dat"
)
xO <- read.table(file="tmpOld.ped",head=FALSE,strings=FALSE)
xN <- read.table(file="tmpNew.ped",head=FALSE,strings=FALSE)
checkIdentical(xN,xO)
}
|