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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
library(snpStats) ## SnpMatrix class
quiet <- suppressWarnings
test_gSM_array_GT <- function() {
mat <- matrix(c(".|.", "0|0", "0|1", "1|0", "1|1",
"./.", "0/0", "0/1", "1/0", "1/1"),
ncol=2, dimnames=list(1:5,1:2))
sm <- new("SnpMatrix",
matrix(as.raw(c(0, 1, 2, 2, 3,
0, 1, 2, 2, 3)),
nrow=2, byrow=TRUE, dimnames=list(1:2,1:5)))
ref <- DNAStringSet(rep("A",5))
alt <- DNAStringSetList("C", "G", "T", "C", "G")
map <- DataFrame(snp.names=rownames(mat),
allele.1=ref,
allele.2=alt,
ignore=rep(FALSE,5))
gtsm <- genotypeToSnpMatrix(mat, ref, alt)
checkIdentical(sm, gtsm$genotypes)
checkIdentical(map, gtsm$map)
}
test_gSM_array_GT_2alt <- function() {
mat <- matrix(c("0|1", "1|0", "1|1",
"1/2", "2/1", "2/2"),
ncol=2, dimnames=list(1:3,1:2))
sm <- new("SnpMatrix",
matrix(as.raw(rep(0,6)),
nrow=2, byrow=TRUE, dimnames=list(1:2,1:3)))
ref <- DNAStringSet(rep("A",3))
alt <- DNAStringSetList(c("C","G"), c("G","T"), c("T","C"))
map <- DataFrame(snp.names=rownames(mat),
allele.1=ref,
allele.2=alt,
ignore=rep(TRUE,3))
gtsm <- quiet(genotypeToSnpMatrix(mat, ref, alt))
checkIdentical(sm, gtsm$genotypes)
checkIdentical(map, gtsm$map)
}
test_gSM_array_GT_nonsnv <- function() {
mat <- matrix(c("0|0", "0|1", "1|0",
"0/0", "0/1", "1/0"),
ncol=2, dimnames=list(1:3,1:2))
sm <- new("SnpMatrix",
matrix(as.raw(rep(0,6)),
nrow=2, byrow=TRUE, dimnames=list(1:2,1:3)))
ref <- DNAStringSet(c("A","ACG","ACG"))
alt <- DNAStringSetList("CGT", "G", "GAC")
map <- DataFrame(snp.names=rownames(mat),
allele.1=ref,
allele.2=alt,
ignore=rep(TRUE,3))
gtsm <- quiet(genotypeToSnpMatrix(mat, ref, alt))
checkIdentical(sm, gtsm$genotypes)
checkIdentical(map, gtsm$map)
}
test_gSM_VCF_GL <- function() {
fl <- system.file("extdata", "gl_chr1.vcf", package="VariantAnnotation")
vcf <- readVcf(fl, "hg19")
gtsm <- quiet(genotypeToSnpMatrix(vcf, uncertain=TRUE))
checkIdentical(colnames(vcf), rownames(gtsm$genotypes))
checkIdentical(rownames(vcf), colnames(gtsm$genotypes))
checkIdentical(rownames(vcf), gtsm$map$snp.names)
checkIdentical(ref(vcf), gtsm$map$allele.1)
checkIdentical(alt(vcf), gtsm$map$allele.2)
checkEquals(unlist(GLtoGP(geno(vcf)$GL)[1,4]),
as.vector(g2post(gtsm$genotypes[4,1])))
}
test_gSM_VCF_structural <- function() {
fl <- system.file("extdata", "structural.vcf", package="VariantAnnotation")
vcf <- readVcf(fl, "hg19")
gtsn <- quiet(genotypeToSnpMatrix(vcf))
checkTrue(nrow(gtsn$genotype) == 1L)
checkTrue(rownames(gtsn$genotype) == "NA00001")
}
test_gSM_VCF_noSamples <- function() {
fl <- system.file("unitTests", "cases",
"FORMAT_header_no_SAMPLEs.vcf",
package="VariantAnnotation")
vcf <- readVcf(fl, "hg19")
gtsm <- quiet(genotypeToSnpMatrix(vcf))
checkEquals(0, nrow(gtsm$genotypes))
}
test_pSM_valid <- function() {
probs <- matrix(c(1,0,0,
0,1,0,
0,0,1,
NA,NA,NA),
ncol=3, byrow=TRUE,
dimnames=list(1:4,c("RR","RA","AA")))
sm <- new("SnpMatrix", matrix(as.raw(c(1,2,3,0)), nrow=1,
dimnames=list(NULL,1:4)))
checkIdentical(sm, probabilityToSnpMatrix(probs))
}
test_pSM_invalid <- function() {
# invalid matrix - probs do not sum to 1
probs <- matrix(c(1,1,0,
0,1,0,
0,0,1,
NA,NA,NA),
ncol=3, byrow=TRUE)
checkException(probabilityToSnpMatrix(probs))
}
test_pSM_onerow <- function() {
probs <- matrix(c(1,0,0,
NA,NA,NA),
ncol=3, byrow=TRUE,
dimnames=list(1:2,c("RR","RA","AA")))
sm <- new("SnpMatrix", matrix(as.raw(c(1,0)), nrow=1,
dimnames=list(NULL,1:2)))
checkIdentical(sm, probabilityToSnpMatrix(probs))
}
test_GLtoGP_array <- function() {
probs <- aperm(array(c(0.4,0.3,0.3,
0.5,0.1,0.4,
0.9,0.05,0.05,
0,1,0,
0,0,1,
1,NA,NA),
dim=c(3,3,2)),
c(2,3,1))
gl <- probs
for (i in 1:nrow(probs)) {
for (j in 1:ncol(probs)) {
gl[i,j,] <- log10(probs[i,j,])
}
}
gp <- GLtoGP(gl)
checkEquals(probs, gp)
}
test_GLtoGP_matrix <- function() {
probs <- matrix(c(list(c(0.4,0.3,0.3)),
list(c(0.5,0.1,0.4)),
list(c(0.9,0.05,0.05)),
list(c(0,1,0)),
list(c(0,0,1)),
list(c(1))),
ncol=2)
gl <- probs
for (i in 1:nrow(probs)) {
for (j in 1:ncol(probs)) {
gl[i,j] <- list(log10(unlist(probs[i,j])))
}
}
gp <- GLtoGP(gl)
checkEquals(probs, gp)
}
test_matrixToArray <- function() {
mat <- matrix(c(list(c(1,2,3)),
list(c(4,5,6)),
list(c(7,8,9)),
list(c(10,11,12)),
list(c(13,14)),
list(c(15))),
ncol=2)
arr <- VariantAnnotation:::.matrixOfListsToArray(mat)
for (i in 1:nrow(mat)) {
for (j in 1:ncol(mat)) {
n <- elementLengths(mat[i,j])
checkEquals(unlist(mat[i,j]), arr[i,j,1:n])
}
}
}
|
