← Back to branch summary

~ubuntu-branches/ubuntu/vivid/r-cran-genabel/vivid

« back to all changes in this revision

Viewing changes to inst/unitTests/runit.impute2xxx.R

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-05-01 14:58:43 UTC
  • mfrom: (1.1.4)
  • Revision ID: package-import@ubuntu.com-20130501145843-zfhxlxrouu8cx3tg
Tags: 1.7-4-1
* New upstream version 
* Updated qvalue package name (moved from CRAN to Bioconductor).
* Drop references to old name r-other-genabel.
* Drop build-dependance on package only suggested.
* Normalised VCS URLs following Lintian's standard.
* Acquire R:Depends directly from r-base-dev.
* Normalised control file with cme.

Show diffs side-by-side

added added

removed removed

Lines of Context:
inst/unitTests/runit.impute2xxx.R
4
4
        ## Not really needed, but can be handy when writing tests
5
5
        library("RUnit")
6
6
        library("GenABEL")
 
7
        library("DatABEL")
7
8
}
8
9
 
9
10
### do not run
115
116
        
116
117
}
117
118
 
 
119
# fixing CRAN NOTE
 
120
#
 
121
test.SNPquoted <- function() {  
 
122
        #library("RUnit")
 
123
        #library("GenABEL")
 
124
        require(DatABEL)
 
125
# generate some random data in "prob" format
 
126
        Nids <- 10
 
127
        Nsnps <- 3
 
128
        q <- runif(Nsnps,min=0.2,max=0.8)
 
129
        PROB0 <- apply(matrix(q,ncol=1),MARGIN=1,FUN=function(x){
 
130
                                cBB <- rnorm(Nids,mean=x^2,sd=0.01)
 
131
                                cAB <- rnorm(Nids,mean=2*x*(1-x),sd=0.01)
 
132
                                cAA <- 1-cBB-cAB
 
133
                                cAA <- matrix(cAA,ncol=1)
 
134
                                return(c(cAA,cAB,cBB))
 
135
                        })
 
136
        PROB <- matrix(NA,ncol=3*Nsnps,nrow=Nids)
 
137
        for (i in 1:Nsnps) {
 
138
                for (j in 1:3) {
 
139
                        PROB[,(i-1)*3+j] <- PROB0[c(((j-1)*Nids+1):(j*Nids)),i]
 
140
                }
 
141
        }
 
142
        daProb <- matrix2databel(t(PROB),filename="temp_daProb")
 
143
        
 
144
# conversion functions
 
145
        makedose <- function(prob) {
 
146
                dose <- 2*prob[c(F,F,T)]+prob[c(F,T,F)]
 
147
                bp <- prob[c(T,F,F)]
 
148
                miss <- which(abs(bp)<1e-16 & abs(dose)<1e-16)
 
149
                if (length(miss) > 0 ) dose[miss] <- NA
 
150
                return(dose)
 
151
        }
 
152
        pfun <- function(a) return(a)
 
153
 
 
154
        dosefile <- apply2dfo(dfodata=daProb, anFUN = "makedose", 
 
155
                        MAR = 2, procFUN = "pfun",prob=get("SNP"),
 
156
                        outclass="databel",
 
157
                        outfile="temp_myTestDose",
 
158
                        type="DOUBLE",transpose=FALSE)
 
159
        
 
160
# check equality
 
161
        DOSE <- matrix(NA,ncol=Nids,nrow=Nsnps)
 
162
        for (i in 1:Nids) for (j in 1:Nsnps) {
 
163
                        DOSE[j,i] <- 2*PROB[i,j*3]+PROB[i,j*3-1]
 
164
                }
 
165
        
 
166
        checkEqualsNumeric(DOSE,as(dosefile,"matrix"))
 
167
        
 
168
        rm(dosefile); gc()
 
169
        unlink("temp_myTestDose.fv?")
 
170
        
 
171
        rm(daProb); gc()
 
172
        unlink("temp_daProb.fv?")
 
173
}