Skip to content

Commit

Permalink
version 0.3-3
Browse files Browse the repository at this point in the history
  • Loading branch information
mcneney authored and cran-robot committed May 17, 2018
1 parent 0c897f9 commit 6e5f23a
Show file tree
Hide file tree
Showing 20 changed files with 543 additions and 492 deletions.
14 changes: 7 additions & 7 deletions DESCRIPTION
@@ -1,18 +1,18 @@
Package: CrypticIBDcheck
Type: Package
Title: Identifying cryptic relatedness in genetic association studies
Version: 0.3-1
Date: 2012-04-14
Title: Identifying Cryptic Relatedness in Genetic Association Studies
Version: 0.3-3
Date: 2018-05-14
Author: Annick Joelle Nembot-Simo, Jinko Graham and Brad McNeney
Maintainer: Brad McNeney <mcneney@sfu.ca>
Depends: R (>= 2.14.0), rJPSGCS (>= 0.2-5), car (>= 2.0-9), ellipse (>=
0.3-5)
Imports: chopsticks
Imports: chopsticks, methods
Suggests: parallel
Description: Exploratory tools to identify closely related subjects using autosomal genetic marker data.
License: GPL-3
LazyData: yes
Packaged: 2013-09-20 21:38:23 UTC; mcneney
LazyData: true
NeedsCompilation: yes
Packaged: 2018-05-17 08:25:12 UTC; mcneney
Repository: CRAN
Date/Publication: 2013-09-21 08:05:29
Date/Publication: 2018-05-17 09:01:55 UTC
36 changes: 19 additions & 17 deletions MD5
@@ -1,43 +1,45 @@
c9e1369b3052a28ab6e5c29871f59a9f *DESCRIPTION
ae6f75a3bfe1fb6b19e7df3326d80a04 *NAMESPACE
cb5dc2fed06a71aadba624d7765f5447 *DESCRIPTION
78bad058e0b14992204d55dccccfe2d4 *NAMESPACE
c167da9c7d2348be9e64e76300fc03cd *R/IBD-class.R
5323a70bc518f476eceec57898a586be *R/IBDcheck.R
1744013d2d0a486bfa17a149290a6f6a *R/SNPgenmap.R
f1e89194f810ed51af67a6f3fab55ba7 *R/SNPgenmap.R
3e252d6126e262418d5ded38ad4c1cc5 *R/cdlIBS.R
403d47447311294933407f27e2cbeec1 *R/countIBS.R
ca814b6e6587d75f2bd1955bde57fa01 *R/estIBD.R
d099b23b9abe86b9152c21bee57d114c *R/filters.R
57447c03248b5786e8cc4edb67ce9a0f *R/countIBS.R
98150553fa3605aab1f6d34c8d89a057 *R/estIBD.R
227d208765f76d1c14b6eb9cc7194e96 *R/filters.R
5ba5635674011597fa380a74af480be3 *R/plotIBD.R
cfc9f31f8fb4efeb134ce813576016c9 *R/simIBD.R
01a917e915046457a52bfea0b1300534 *R/simIBD.R
027e232095609bfdc25372ee00aca23f *R/snpinfos.R
5f437b99811e93a818b3aa3b3db26647 *R/zzz.R
70188af9e6c3778de620efc00f369473 *build/vignette.rds
8864223892c8609e62161f48b2f873a5 *build/vignette.rds
f8e6a03a523edea22a42cafd23765630 *data/Nhlsim.RData
56867363d807115eef7760673f3803b7 *data/RutgersMapB36.RData
a93d8e49de436746a32b274041e0ee80 *data/datalist
fe946fb4d7ddb1edcc37e987c7899ee4 *inst/CITATION
baa6acd62946cf31338b348bc713eba5 *inst/doc/CrypticIBDcheck.Rnw
33ffb287358af405c9f9b55345a9ee78 *inst/doc/CrypticIBDcheck.pdf
28c888e13e4f8bce5e261251437c11b5 *inst/doc/CrypticIBDcheck.Rnw
fe609367f79f3696faddecb6a973373f *inst/doc/CrypticIBDcheck.pdf
293d211d4c739711fee2b0b4ce0606e5 *inst/doc/IBDcheck-hapmap.R
ac6a847d6b4918ee9d88fdec8b0c7a5c *inst/doc/IBDcheck-hapmap.Rnw
62248e95904c151e349c87984e30a9fe *inst/doc/IBDcheck-hapmap.pdf
9454119f3882881e210a8887f8f2a61a *inst/doc/IBDcheck-hapmap.pdf
2f5dbbbd1d759d8467a3a1c60be01650 *inst/scripts/thin.R
00ab1ba102fc885fb385a2046dfe3b8b *man/CrypticIBDcheck-package.Rd
4bbecb413eb3b22244ecae0b0acd7add *man/IBD.Rd
9429978fc495e28e80a813cd00883201 *man/IBDcheck.Rd
7308e6838e402ba0559cac1464d2ef98 *man/IBDcheck.Rd
cd88caf8b810aa62626930aa61979ea7 *man/Nhlsim.Rd
c48a8e94ab43dd4b25927b802d4528c7 *man/RutgersMapB36.Rd
7390c26f0ef433e7d654a176b32355b9 *man/SNPgenmap.Rd
9c8935d02b3295f628fe56e7328fdb12 *man/RutgersMapB36.Rd
bb043bb68cf677890f42da44e1c54917 *man/SNPgenmap.Rd
4789438d1e62867b99a57b562d4e6d9f *man/countIBS.Rd
c19f88ffa790c88b3295d8af31399fcf *man/filter.control.Rd
c992fd8d496636234b9f3a1fdae59822 *man/new.IBD.Rd
e7599dc866e1a087bcfd4bb49d32332f *man/plot.IBD.Rd
bfac2693c606256f19dda0fab87e7240 *man/sim.control.Rd
175df0713b31c118aa9bc4daee521f1e *man/sim.control.Rd
079411548301c4221142b6f234130acb *src/IBDest.sim.c
49d5b5b0238d4cf21dc8a58857c29ff4 *src/IBDest.study.c
e4fdd2a3e75e08a61eb714e9c6a8c3cf *src/IBDestp.c
714573746c49f96028fd59ee5f4e494f *src/IBDestp.h
39a289061f81ca5107c75432f4dfc9b5 *src/countIBS.c
baa6acd62946cf31338b348bc713eba5 *vignettes/CrypticIBDcheck.Rnw
8263108717ce545678a08096c16325d6 *src/countIBS.c
0d5bc11a2ab048216f59c6cbe01078c0 *src/init.c
28c888e13e4f8bce5e261251437c11b5 *vignettes/CrypticIBDcheck.Rnw
ac6a847d6b4918ee9d88fdec8b0c7a5c *vignettes/IBDcheck-hapmap.Rnw
4a6038abb1810b39143cd14f24c058f8 *vignettes/IBDcheck-hapmap.bib
1f5aeb0993bbc807aa59c56181a9efa5 *vignettes/fig005_MZ.pdf
Expand Down
10 changes: 10 additions & 0 deletions NAMESPACE
@@ -1,2 +1,12 @@
export(countIBS,IBDcheck,new.IBD,IBD,SNPgenmap,filter.control,sim.control)
importFrom("grDevices", "devAskNewPage")
importFrom("graphics", "lines", "plot", "title")
importFrom("methods", "is", "new")
importFrom("stats", "approxfun", "cor", "pnorm", "qchisq", "quantile",
"rbinom", "sd", "var")
importFrom("utils", "flush.console")
importFrom("rJPSGCS","GeneDrops","read.pedfile","write.pedfile","write.parfile","FitGMLD")
importFrom("car","showLabels")
importFrom("ellipse","ellipse")
S3method(plot,IBD)
useDynLib("CrypticIBDcheck", .registration = TRUE)
4 changes: 2 additions & 2 deletions R/SNPgenmap.R
@@ -1,8 +1,8 @@
SNPgenmap <- function(physmap, chromosomes) {
genmap <- rep(NA, length(chromosomes))
for (chr in 1:22) {
physpos <- RutgersMapB36[[paste("chr", chr, sep="")]]$Build36_map_physical_position
genmappos<-RutgersMapB36[[paste("chr", chr, sep="")]]$Sex.averaged_map_position
physpos <- CrypticIBDcheck::RutgersMapB36[[paste0("chr", chr)]]$Build36_map_physical_position
genmappos<-CrypticIBDcheck::RutgersMapB36[[paste0("chr", chr)]]$Sex.averaged_map_position
chrmap <- approxfun(physpos,genmappos)
ind <- which(chromosomes == chr)
genmap[ind] <- chrmap(physmap[ind])
Expand Down
4 changes: 2 additions & 2 deletions R/countIBS.R
Expand Up @@ -5,8 +5,8 @@ countIBS <- function(x) {
mni0=matrix(0,n,n) #matrix of count of snps with IBS=0 for pairs of individuals
mni1=matrix(0,n,n)
mni2=matrix(0,n,n)
out <- .C("countIBS", t(x@.Data), as.integer(n), as.integer(ncol(x)),
as.integer(mni0), as.integer(mni1), as.integer(mni2), PACKAGE="CrypticIBDcheck")
out <- .C(count_IBS, t(x@.Data), as.integer(n), as.integer(ncol(x)),
as.integer(mni0), as.integer(mni1), as.integer(mni2))
out[[4]] <- matrix(out[[4]], nrow=n, byrow=TRUE)
out[[5]] <- matrix(out[[5]], nrow=n, byrow=TRUE)
out[[6]] <- matrix(out[[6]], nrow=n, byrow=TRUE)
Expand Down
8 changes: 4 additions & 4 deletions R/estIBD.R
Expand Up @@ -5,11 +5,11 @@ IBDest.study <- function(snpobjtr, cdlibs) {
excl<-is.na(cdlibs[,1])
snpobjtr<-snpobjtr[,!excl]
cdlibs<-cdlibs[!excl,]
out <- .Call("IBDest_study", t(snpobjtr@.Data),
out <- .Call(IBDest_study, t(snpobjtr@.Data),
nrow(snpobjtr),
ncol(snpobjtr),
t(cdlibs),
new.env(), PACKAGE="CrypticIBDcheck")
new.env())
pz0 <- matrix(out[[1]], nrow(snpobjtr), nrow(snpobjtr), byrow=TRUE)
pz1 <- matrix(out[[2]], nrow(snpobjtr), nrow(snpobjtr), byrow=TRUE)
pz2 <- matrix(out[[3]], nrow(snpobjtr), nrow(snpobjtr), byrow=TRUE)
Expand All @@ -28,11 +28,11 @@ IBDest.sim <- function(snpmat, cdlibs) {
excl<-is.na(cdlibs[,1])
snpmat<-snpmat[,!excl]
cdlibs<-cdlibs[!excl,]
out <- .Call("IBDest_sim", t(snpmat@.Data),
out <- .Call(IBDest_sim, t(snpmat@.Data),
nrow(snpmat)/2,
ncol(snpmat),
t(cdlibs),
new.env(), PACKAGE="CrypticIBDcheck")
new.env())
names(out) <- c("pz0", "pz1", "pz2")
data.frame(out)
}
104 changes: 52 additions & 52 deletions R/filters.R
@@ -1,52 +1,52 @@
## filter.control is a function to set parameters that control quality control
## filters: snpcallrate, MAF, samplecallrate and HWEp

filter.control<-function(filter=TRUE,snpcallrate=0.9,MAF=0.01,
samplecallrate=0.9, HWEp=0.001) {
list(filter=filter,snpcallrate=snpcallrate,MAF=MAF,
samplecallrate=samplecallrate, HWEp=HWEp)
}

################################################################
snpfilter <- function(snpmatlist1,filter){

SNP.support=snpmatlist1$snp.support
SNP.support=remove.cdlIBS(SNP.support) #remove cdlIBS columns, if present
snpobjt=snpmatlist1$snp.data

sumsnp<-chopsticks::summary(snpobjt)
nbs=ncol(snpobjt)

#snps call rate test
callr=(sumsnp$Call.rate>=filter$snpcallrate)
snpobjt1<-snpobjt[,(callr)]
SNP.support1<-SNP.support[callr,]

#MAF test
sumsnp1<-chopsticks::summary(snpobjt1)
maft=(sumsnp1$MAF>=filter$MAF)
snpobjt1<-snpobjt1[,(maft)]
SNP.support1<-SNP.support1[maft,]

#samples call rate test
callrvt=(row.summary(snpobjt1)$Call.rate>=filter$samplecallrate)
snpobjt1<-snpobjt1[(callrvt),]
snpmatlist1$subject.support<-snpmatlist1$subject.support[(callrvt),]

#Remove SNPs not found by SNPgenmap (NA genetic location)
ind<-is.na(SNP.support1$Gen_loc)
SNP.support1<-SNP.support1[!ind,]
snpobjt1<-snpobjt1[,(!ind)]

#Do test of HWE and keep SNPs that pass
vecpval=as.numeric(as.vector(SNP.support1$pvalue_HWE))
hwvec<-( vecpval>filter$HWEp & !is.na(SNP.support1$pvalue_HWE) )

snpmatlist1$snp.data<-snpobjt1[,(hwvec)]
snpmatlist1$snp.support<-SNP.support1[hwvec,]


return(snpmatlist1)

}

## filter.control is a function to set parameters that control quality control
## filters: snpcallrate, MAF, samplecallrate and HWEp

filter.control<-function(filter=TRUE,snpcallrate=0.9,MAF=0.01,
samplecallrate=0.9, HWEp=0.001) {
list(filter=filter,snpcallrate=snpcallrate,MAF=MAF,
samplecallrate=samplecallrate, HWEp=HWEp)
}

################################################################
snpfilter <- function(snpmatlist1,filter){

SNP.support=snpmatlist1$snp.support
SNP.support=remove.cdlIBS(SNP.support) #remove cdlIBS columns, if present
snpobjt=snpmatlist1$snp.data

sumsnp<-chopsticks::summary(snpobjt)
nbs=ncol(snpobjt)

#snps call rate test
callr=(sumsnp$Call.rate>=filter$snpcallrate)
snpobjt1<-snpobjt[,(callr)]
SNP.support1<-SNP.support[callr,]

#MAF test
sumsnp1<-chopsticks::summary(snpobjt1)
maft=(sumsnp1$MAF>=filter$MAF)
snpobjt1<-snpobjt1[,(maft)]
SNP.support1<-SNP.support1[maft,]

#samples call rate test
callrvt=(chopsticks::row.summary(snpobjt1)$Call.rate>=filter$samplecallrate)
snpobjt1<-snpobjt1[(callrvt),]
snpmatlist1$subject.support<-snpmatlist1$subject.support[(callrvt),]

#Remove SNPs not found by SNPgenmap (NA genetic location)
ind<-is.na(SNP.support1$Gen_loc)
SNP.support1<-SNP.support1[!ind,]
snpobjt1<-snpobjt1[,(!ind)]

#Do test of HWE and keep SNPs that pass
vecpval=as.numeric(as.vector(SNP.support1$pvalue_HWE))
hwvec<-( vecpval>filter$HWEp & !is.na(SNP.support1$pvalue_HWE) )

snpmatlist1$snp.data<-snpobjt1[,(hwvec)]
snpmatlist1$snp.support<-SNP.support1[hwvec,]


return(snpmatlist1)

}

0 comments on commit 6e5f23a

Please sign in to comment.