Last updated on 2020-04-09 09:48:26 CEST.
Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
---|---|---|---|---|---|---|
r-devel-linux-x86_64-debian-clang | 2.3.1 | 16.48 | 247.80 | 264.28 | ERROR | |
r-devel-linux-x86_64-debian-gcc | 2.3.1 | 12.17 | 170.27 | 182.44 | ERROR | |
r-devel-linux-x86_64-fedora-clang | 2.3.1 | 290.23 | ERROR | |||
r-devel-linux-x86_64-fedora-gcc | 2.3.1 | 300.15 | ERROR | |||
r-devel-windows-ix86+x86_64 | 2.3.1 | 22.00 | 328.00 | 350.00 | ERROR | |
r-devel-windows-ix86+x86_64-gcc8 | 2.3.1 | 24.00 | 230.00 | 254.00 | ERROR | |
r-patched-linux-x86_64 | 2.3.1 | 14.72 | 226.65 | 241.37 | ERROR | |
r-patched-osx-x86_64 | 2.3.1 | ERROR | ||||
r-patched-solaris-x86 | 2.3.1 | 424.90 | ERROR | |||
r-release-linux-x86_64 | 2.3.1 | 10.90 | 217.26 | 228.16 | OK | |
r-release-windows-ix86+x86_64 | 2.3.1 | 25.00 | 361.00 | 386.00 | OK | |
r-release-osx-x86_64 | 2.3.1 | OK | ||||
r-oldrel-windows-ix86+x86_64 | 2.3.1 | 26.00 | 311.00 | 337.00 | OK | |
r-oldrel-osx-x86_64 | 2.3.1 | OK |
Version: 2.3.1
Check: tests
Result: ERROR
Running 'initTestSession.R' [16s/18s]
Running 'runAllTest.R' [0s/0s]
Running 'testExpressionAnalysis.R' [16s/18s]
Running 'testGraphics.R' [24s/27s]
Running 'testIdentificationAnalysis.R' [17s/20s]
Running 'testParser.R' [19s/21s]
Running 'testSafeQuantAnalysis.R' [24s/27s]
Running 'testTMT.R' [16s/19s]
Running 'testUserOptions.R' [16s/18s]
Running the tests in 'tests/testExpressionAnalysis.R' failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testCreateExpressionDataset <- function(){
+
+ cat("--- testCreateExpressionDataset: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+ cat("--- testCreateExpressionDataset: PASS ALL TEST --- \n")
+
+ }
>
>
> testGetAllEBayes <- function(){
+
+
+ cat("--- testGetAllEBayes: --- \n")
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ pAdj <- getAllEBayes(eset, adjust=T)
+
+ stopifnot( mean(pAdj[,"A"]) > mean(p[,"A"]) )
+
+ ### paired desgn
+ esetNonPaired <- esetPaired
+ pData(esetNonPaired) <- pData(esetPaired)[,1:2]
+
+ pValPaired <- getAllEBayes(esetPaired,adjust=F,method=c("all"))
+ pValPairedPairwise <- getAllEBayes(esetPaired,adjust=F,method=c("pairwise"))
+
+ pValNonPaired <- getAllEBayes(esetNonPaired,adjust=F,method=c("all"))
+ pValNonPairedPairwise <- getAllEBayes(esetNonPaired,adjust=F,method=c("pairwise"))
+ stopifnot(all(apply(pValPaired,2,sum) < apply(pValNonPaired,2,sum)))
+ stopifnot(all(apply(pValPairedPairwise,2,sum) < apply(pValNonPairedPairwise,2,sum)))
+
+ # adjustment filter
+
+ adjustfilter <- data.frame(rep(T,nrow(eset)),rep(T,nrow(eset)) )
+ adjustfilter[1,1] <- F
+ adjustfilter[2,2] <- F
+
+ pTmp <- getAllEBayes(eset,adjust=T, adjustFilter=adjustfilter)
+ stopifnot(p[1,1] == pTmp[1,1])
+ stopifnot(p[2,2] == pTmp[2,2])
+ stopifnot(is.na(pTmp[3,2]))
+ cat("--- testGetAllEBayes: PASS ALL TEST --- \n")
+
+ # Question: limma multiple groups comparison produces different pvalue comparing with two group comparsion
+ # https://support.bioconductor.org/p/44216/
+ # https://support.bioconductor.org/p/60556/
+ }
>
> testGetRatios <- function(){
+
+ cat("--- testGetRatios: --- \n")
+
+ r <- getRatios(eset)
+
+ exprs(eset)[1,c(5:6,1:2)]
+ # C_rep_1 C_rep_2 A_rep_1 A_rep_2
+ # 9.963852 9.966003 9.965568 9.967214
+
+ ## NOTE: C is control
+ stopifnot(all.equal(r[1,1],median(log2(exprs(eset))[1,1:2]) - median(log2(exprs(eset))[1,5:6]) ) )
+
+ stopifnot(mean(r[,"A"]) < mean(r[,"B"]))
+ stopifnot(all.equal(r,getRatios(eset,method="mean")))
+ r <- getRatios(eset)
+ stopifnot(all.equal(mean(r[,"B"]),mean(r[,"B"])))
+
+ stopifnot(all(round(apply(getRatios(esetPaired, log2=F),2,mean),1) == c(1.5,1.2)))
+ stopifnot(ncol(r) == 2)
+
+ rPaired <- getRatios(esetPaired, method="paired")
+ stopifnot(ncol(rPaired) == 4)
+ stopifnot(all( log2(exprs(esetPaired)[,1]) - log2(exprs(esetPaired)[,5]) == rPaired[,1] ))
+ stopifnot(all( log2(exprs(esetPaired)[,4]) - log2(exprs(esetPaired)[,6]) == rPaired[,4] ))
+ stopifnot(all( exprs(esetPaired)[,4] / exprs(esetPaired)[,6] == getRatios(esetPaired, method="paired", log2=F)[,4] ))
+ # should fail
+ stopifnot((inherits(try( getRatios(eset, method="paired"), silent = TRUE), "try-error")))
+
+
+ stopifnot(all(round(getRatios(esetPaired)[,1],2) == round(apply(rPaired[,1:2],1,median),2)))
+
+
+ cat("--- testGetRatios: PASS ALL TEST --- \n")
+
+ }
>
> testGetAllCV <- function(){
+
+ cat("--- testGetAllCV: --- \n")
+
+ cv <- getAllCV(eset)
+
+ stopifnot(all.equal(cv[1,"A"] , (sd(exprs(eset)[1,unlist(pData(eset)$condition == "A")]) / mean(exprs(eset)[1,unlist(pData(eset)$condition == "A")]))))
+ stopifnot(all.equal(cv[200,"C"] , sd(exprs(eset)[200,unlist(pData(eset)$condition == "C")]) / mean(exprs(eset)[200,unlist(pData(eset)$condition == "C")])))
+
+ cvPaired <- getAllCV(esetPaired)
+ stopifnot(all(is.na(cvPaired[,1])))
+ stopifnot(all(!is.na(cvPaired[,2])))
+ stopifnot(cvPaired[3,"A"] == (sd(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6]) / mean(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6])))
+
+ cat("--- testGetAllCV: PASS ALL TEST --- \n")
+ }
>
> testGlobalNormalize <- function(){
+
+ cat("--- testGlobalNormalize: --- \n")
+
+ globalNormFactors <- getGlobalNormFactors(eset,method="sum")
+ ### add normalization factors to ExpressionSet
+ pData(eset) <- cbind(pData(eset),globalNormFactors)
+ esetNorm <- globalNormalize(eset,globalNormFactors)
+
+ stopifnot(all.equal(as.vector(unlist(apply(exprs(esetNorm),2,sum))),as.vector(rev(unlist(apply(exprs(esetNorm),2,sum))))))
+
+ stopifnot(pData(esetNorm)$normFactor[1] == 1)
+ stopifnot(pData(esetNorm)$normFactor[2] != 1)
+
+ cat("--- testGlobalNormalize: PASS ALL TEST --- \n")
+
+ # Should generate error and stop
+ # fData(eset)$isNormAnchor <- rep(F,nrow(eset))
+ # esetNorm <- normalizeIntensities(eset)
+
+ }
>
> testGetSignalPerCondition <- function(){
+
+ cat("--- testGetSignalPerCondition: --- \n")
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"A"] <= getSignalPerCondition(eset,method="max")[,"A"]) == nrow(eset))
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"C"] <= getSignalPerCondition(eset,method="median")[,"C"]) == nrow(eset))
+ stopifnot(getSignalPerCondition(eset,method="sd")[1,2] == sd(exprs(eset)[1,3:4]))
+ cat("--- testGetSignalPerCondition: PASS ALL TEST --- \n")
+ }
>
> testBaselineIntensity <- function(){
+
+ cat("--- testBaselineIntensity: --- \n")
+
+ allInt <- as.vector(unlist(exprs(eset)))
+ bl <- round(getBaselineIntensity(allInt,promille=5),2)
+ #hist(allInt)
+ #abline(v=bl,lwd=2)
+ stopifnot(all.equal(bl[[1]] , 997.82) )
+
+
+ set.seed(1234)
+ suppressWarnings(allInt2 <- log10(rnorm(1000,1,1)))
+ bl2 <- round(getBaselineIntensity(allInt2,promille=5),2)
+ stopifnot(all.equal(-1.95,bl2[[1]]))
+ #hist(allInt2)
+ #abline(v=bl2,lwd=2)
+
+ cat("--- testBaselineIntensity: PASS ALL TEST --- \n")
+
+ }
>
> testRollUp <- function(){
+
+ cat(" --- testRollUp --- \n")
+
+ rollUpEset1 <- rollUp(eset,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$proteinName ) ) == nrow(rollUpEset1))
+
+ rollUpEset2 <- rollUp(eset ,featureDataColumnName= c("ptm"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset2))
+
+ rollUpEset3 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("ptm"), method=c("mean"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset3))
+
+ #print(exprs(rollUpEset2))
+
+ stopifnot(all.equal(sum(exprs(rollUpEset2)),sum(exprs(rollUpEset1)))) ### test sum
+ stopifnot(sum(exprs(rollUpEset1)) != sum(exprs(rollUpEset3))) ### test mean
+
+ rollUpEset4 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))
+ stopifnot(sum(exprs(rollUpEset3)) != sum(exprs(rollUpEset4)) ) ### test top 3
+
+ cat(" --- testRollUp: PASS ALL TEST --- \n")
+
+ # progenesisFeatureCsvFile3 <- "/Users/ahrnee-adm/dev/R/workspace/SafeQuant/inst/testData/2014/peptides2.csv"
+ # d <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile3,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile3))
+ # system.time(e <- rollUp(d, method="sum", isProgressBar=T, featureDataColumnName= c("peptide")))
+ # system.time(e <- rollUpDT(d, method="sum", featureDataColumnName= c("peptide")))
+ #
+ esetTmp <- parseProgenesisPeptideMeasurementCsv(progenesisPeptideMeasurementCsvFile1,expDesign= getExpDesignProgenesisCsv(progenesisPeptideMeasurementCsvFile1))
+
+ fData(esetTmp)
+
+ rollUpEsetProteinAllAccessions <- rollUp(esetTmp,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot(fData(rollUpEsetProteinAllAccessions)$allAccessionsTMP[68] == "sp|E9PAV3|NACAM_HUMAN;sp|Q9BZK3|NACP1_HUMAN")
+
+ }
>
> testTopX <- function(){
+
+ cat(" --- testTopX --- \n")
+
+ entryData1 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,5),ncol=4)))
+ rownames(entryData1) <- paste("peptide",1:nrow(entryData1),sep="_")
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 5
+ stopifnot(all.equal(rep(10/3,3) , as.vector(unlist(getTopX(entryData1))) ))
+
+ entryData2 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,NA),ncol=4)))
+ rownames(entryData2) <- paste("peptide",1:nrow(entryData2),sep="_")
+
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 NA
+ stopifnot(all.equal(c(4,4,3) , as.vector(unlist(getTopX(entryData2,topX=2)))))
+
+ # 1 row
+ stopifnot(all.equal(rep(1,3),as.vector(unlist(getTopX(entryData1[1,])))))
+
+ # 1 col
+ stopifnot(all.equal(getTopX(entryData1)[[1]],getTopX(entryData1[,1])))
+
+ top1 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top1"))),1,sum)
+ top3 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))),1,sum)
+ meanInt <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("mean"))),1,sum)
+
+ stopifnot(sum(top1 >= top3 ) == length(top3))
+ stopifnot(sum(top1) > sum(top3))
+ stopifnot(sum(top1) > sum(meanInt))
+ stopifnot(all.equal(sum(top3),sum(meanInt)))
+
+ cat(" --- testTopX: PASS ALL TEST --- \n")
+
+ }
>
> testGetIBAQEset <- function(){
+
+ cat(" --- testGetIBAQEset --- \n")
+
+ # read protein fasta
+ proteinDB <- read.fasta(fastaFile,seqtype = "AA",as.string = TRUE, set.attributes = FALSE)
+
+ iBaqEset <- getIBAQEset(eset,proteinDB=proteinDB)
+ stopifnot(round(exprs(iBaqEset))[1,1] == 125)
+ stopifnot(round(exprs(iBaqEset))[2,2] == 38)
+
+ cat(" --- testGetIBAQEset: PASS ALL TEST --- \n")
+ }
>
>
> testGetLoocvFoldError <- function(){
+
+ cat(" --- testGetLoocvFoldError --- \n")
+ #plotCalibrationCurve(fit)
+ stopifnot( round(sum(getLoocvFoldError(absEstSimData))) == -8)
+ cat(" --- testGetLoocvFoldError: PASS ALL TEST --- \n")
+ }
>
> testSqNormalize <- function(){
+
+ cat(" --- testSqNormalize --- \n")
+
+ stopifnot(nrow(sqNormalize(eset, method = "global")) == 900)
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ stopifnot(nrow(sqNormalize(esetTmp, method = "rt")) == 496)
+
+ cat(" --- testSqNormalize: PASS ALL TEST --- \n")
+ }
>
>
> testRtNormalize <- function(){
+
+
+ cat(" --- testRTNormalize --- \n")
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ rtNormFactors <- getRTNormFactors(esetTmp, minFeaturesPerBin=100)
+ stopifnot(nrow(rtNormalize(esetTmp,rtNormFactors)) == 97)
+
+ # Stop if rtNormFactors doesn't cover all retention times.
+ #rtNormalize(esetTmp,rtNormFactors[1:2,])
+
+ cat(" --- testRTNormalize: PASS ALL TEST --- \n")
+ }
>
> testRemoveOutliers <- function(){
+
+ cat(" --- testRemoveOutliers --- \n")
+ set.seed(1234)
+ stopifnot(sum(is.na(removeOutliers(c(-10, rnorm(100), 10)))) == 2)
+ cat(" --- testRemoveOutliers: PASS ALL TEST --- \n")
+ }
>
> testPerFeatureNormalization <- function(){
+
+ cat(" --- testPerFeatureNormalization: --- \n")
+
+ normFactors <- exprs(eset)[1:10,1:3]
+ colnames(normFactors) <- c("A","B","C")
+ rownames(normFactors) <- fData(eset)[1:10,]$proteinName
+ normFactors[is.finite(normFactors)] <- 1
+ eNorm <- perFeatureNormalization(eset,normFactors)
+
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,2] , (exprs(eset)[1,2]-1)))
+ stopifnot(all.equal(exprs(eNorm)[13,2] , (exprs(eset)[13,2])))
+
+ normFactors[,2] <- 200
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,3] , (exprs(eset)[1,3]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,4] , (exprs(eset)[1,4]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,5] , (exprs(eset)[1,5]-1)))
+
+ normFactors[,3] <- 0
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,5] , exprs(eset)[1,5]))
+ stopifnot(all.equal(exprs(eNorm)[2,6] , exprs(eset)[2,6]))
+
+ normFactors[3,] <- 1000
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ # re-order normFactors columns
+ eNorm <- perFeatureNormalization(eset,normFactors[,rev(colnames(normFactors))])
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ cat(" --- testPerFeatureNormalization: PASS ALL TEST --- \n")
+
+ #coveredPeptideSel <- fData(eset)$proteinName %in% rownames(normFactors)
+ #exprs(eset)[coveredPeptideSel,] <- exprs(eset)[coveredPeptideSel, ] - normFactors[as.character(fData(eset)[coveredPeptideSel,]$proteinName),pData(eset)$condition]
+
+ }
>
>
> testStandardise <- function(){
+
+ cat(" --- testStandardise: --- \n")
+
+ d <- data.frame(rnorm(10000,5,20), rnorm(10000,10,10))
+ dStd <- standardise(d[,1])
+
+ stopifnot(round(mean(dStd)) == 0 )
+ stopifnot(round(sd(dStd)) == 1 )
+
+ dStd <- standardise(d)
+ stopifnot(round(apply(dStd,2,mean)[1]) == 0)
+ stopifnot(round(apply(dStd,2,sd)[1]) == 1)
+
+ cat(" --- testStandardise: PASS ALL TEST --- \n")
+
+ }
>
> testGetMaxIndex <-function(){
+
+ cat(" --- testGetMaxIndex: --- \n")
+ d <- data.frame(s=c(NA,NA,NA,NA,1,1:4),lab=sort(rep(c("A","B","C"),3)))
+ DT <- data.table(d)
+ setkey(DT,lab)
+
+
+ stopifnot(all.equal(c(1,5,9) , DT[, .I[getMaxIndex(s)], by=lab ]$V1 ))
+ cat(" --- testGetMaxIndex: PASS ALL TEST --- \n")
+
+ }
>
> testCreatePairedExpDesign <- function(){
+
+ cat(" --- testCreatePairedExpDesign: --- \n")
+ stopifnot(all( pData(createPairedExpDesign(eset))$subject == as.factor(rep(1:2,3))))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:3]), silent = TRUE), "try-error")))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:4]), silent = TRUE), "ExpressionSet")))
+ cat(" --- testCreatePairedExpDesign: PASS ALL TEST --- \n")
+
+ }
>
> ### TEST FUNCTIONS END
>
> #### TESTS
> #testGetRatios()
> #testGetAllEBayes()
> #testGetSignalPerCondition()
> #testGetRatios()
>
> if(T){
+ testCreateExpressionDataset()
+ testGetAllEBayes()
+ testGetRatios()
+ testGetAllCV()
+ testGlobalNormalize()
+ #testNormalise()
+ testRtNormalize()
+
+ testBaselineIntensity()
+ testRollUp()
+ testTopX()
+
+ testGetLoocvFoldError()
+
+ testRemoveOutliers()
+ testPerFeatureNormalization()
+ testStandardise()
+ testGetMaxIndex()
+
+ testGetIBAQEset()
+
+ testCreatePairedExpDesign()
+
+ }
--- testCreateExpressionDataset: ---
Error in testCreateExpressionDataset() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testCreateExpressionDataset -> stopifnot
Execution halted
Running the tests in 'tests/testUserOptions.R' failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
>
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testExpDesignTagToExpDesign <- function(){
+
+ cat("--- testExpDesignTagToExpDesign: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+
+ expDesignString1 <- "1,2,3:4,5,6"
+
+ # 6-plex default: 1,2,3:4,5,6
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 1 TRUE
+ #3 Condition 1 TRUE
+ #4 Condition 2 FALSE
+ #5 Condition 2 FALSE
+ #6 Condition 2 FALSE
+
+
+ expDesign <- data.frame(condition=paste("Condition",sort(rep(c(1,2),3))),isControl=sort(rep(c(T,F),3),decreasing=T) )
+
+ expDesign1 <- expDesignTagToExpDesign(expDesignString1, expDesign)
+
+ stopifnot(nrow(expDesign1) == 6 )
+ stopifnot(length(unique(expDesign1$condition)) == 2 )
+ stopifnot(sum(expDesign1$isControl) == 3 )
+
+ expDesignString2 <- "1,4,7,10:2,5,8:3,6,9"
+
+ # 10-plex default is "1,4,7,10:2,5,8:3,6,9"
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 2 FALSE
+ #3 Condition 3 FALSE
+ #4 Condition 1 TRUE
+ #5 Condition 2 FALSE
+ #6 Condition 3 FALSE
+ #7 Condition 1 TRUE
+ #8 Condition 2 FALSE
+ #9 Condition 3 FALSE
+ #10 Condition 1 TRUE
+
+ expDesign <- data.frame(condition=paste("Condition",c(1,2,3,1,2,3,1,2,3,1)),isControl=c(T,F,F,T,F,F,T,F,F,T) )
+ expDesign2 <- expDesignTagToExpDesign(expDesignString2, expDesign)
+ stopifnot(nrow(expDesign2) == 10 )
+ stopifnot(length(unique(expDesign2$condition)) == 3 )
+ stopifnot(sum(expDesign2$isControl) == 4 )
+
+ ### condition name assignment when mixing runs from different conditions
+ expDesign <- data.frame(condition=paste("foo",c(1,1,1,2,2,3,3)),isControl=c(F,F,F,T,T,F,F) )
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5:6",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1:4,6:5",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1,2,4",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("2",expDesign)$condition)))
+ stopifnot( length(unique(expDesignTagToExpDesign("1:2:3:4:5:6",expDesign)$condition)) == 6)
+
+ cat("--- testExpDesignTagToExpDesign: PASS ALL TEST --- \n")
+
+ }
>
>
> ### TEST FUNCTIONS END
>
> ### TESTS
> testExpDesignTagToExpDesign()
--- testExpDesignTagToExpDesign: ---
Error in testExpDesignTagToExpDesign() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testExpDesignTagToExpDesign -> stopifnot
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 2.3.1
Check: tests
Result: ERROR
Running ‘initTestSession.R’ [10s/14s]
Running ‘runAllTest.R’ [0s/1s]
Running ‘testExpressionAnalysis.R’ [10s/15s]
Running ‘testGraphics.R’ [16s/26s]
Running ‘testIdentificationAnalysis.R’ [11s/17s]
Running ‘testParser.R’ [12s/18s]
Running ‘testSafeQuantAnalysis.R’ [15s/24s]
Running ‘testTMT.R’ [10s/16s]
Running ‘testUserOptions.R’ [10s/15s]
Running the tests in ‘tests/testExpressionAnalysis.R’ failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testCreateExpressionDataset <- function(){
+
+ cat("--- testCreateExpressionDataset: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+ cat("--- testCreateExpressionDataset: PASS ALL TEST --- \n")
+
+ }
>
>
> testGetAllEBayes <- function(){
+
+
+ cat("--- testGetAllEBayes: --- \n")
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ pAdj <- getAllEBayes(eset, adjust=T)
+
+ stopifnot( mean(pAdj[,"A"]) > mean(p[,"A"]) )
+
+ ### paired desgn
+ esetNonPaired <- esetPaired
+ pData(esetNonPaired) <- pData(esetPaired)[,1:2]
+
+ pValPaired <- getAllEBayes(esetPaired,adjust=F,method=c("all"))
+ pValPairedPairwise <- getAllEBayes(esetPaired,adjust=F,method=c("pairwise"))
+
+ pValNonPaired <- getAllEBayes(esetNonPaired,adjust=F,method=c("all"))
+ pValNonPairedPairwise <- getAllEBayes(esetNonPaired,adjust=F,method=c("pairwise"))
+ stopifnot(all(apply(pValPaired,2,sum) < apply(pValNonPaired,2,sum)))
+ stopifnot(all(apply(pValPairedPairwise,2,sum) < apply(pValNonPairedPairwise,2,sum)))
+
+ # adjustment filter
+
+ adjustfilter <- data.frame(rep(T,nrow(eset)),rep(T,nrow(eset)) )
+ adjustfilter[1,1] <- F
+ adjustfilter[2,2] <- F
+
+ pTmp <- getAllEBayes(eset,adjust=T, adjustFilter=adjustfilter)
+ stopifnot(p[1,1] == pTmp[1,1])
+ stopifnot(p[2,2] == pTmp[2,2])
+ stopifnot(is.na(pTmp[3,2]))
+ cat("--- testGetAllEBayes: PASS ALL TEST --- \n")
+
+ # Question: limma multiple groups comparison produces different pvalue comparing with two group comparsion
+ # https://support.bioconductor.org/p/44216/
+ # https://support.bioconductor.org/p/60556/
+ }
>
> testGetRatios <- function(){
+
+ cat("--- testGetRatios: --- \n")
+
+ r <- getRatios(eset)
+
+ exprs(eset)[1,c(5:6,1:2)]
+ # C_rep_1 C_rep_2 A_rep_1 A_rep_2
+ # 9.963852 9.966003 9.965568 9.967214
+
+ ## NOTE: C is control
+ stopifnot(all.equal(r[1,1],median(log2(exprs(eset))[1,1:2]) - median(log2(exprs(eset))[1,5:6]) ) )
+
+ stopifnot(mean(r[,"A"]) < mean(r[,"B"]))
+ stopifnot(all.equal(r,getRatios(eset,method="mean")))
+ r <- getRatios(eset)
+ stopifnot(all.equal(mean(r[,"B"]),mean(r[,"B"])))
+
+ stopifnot(all(round(apply(getRatios(esetPaired, log2=F),2,mean),1) == c(1.5,1.2)))
+ stopifnot(ncol(r) == 2)
+
+ rPaired <- getRatios(esetPaired, method="paired")
+ stopifnot(ncol(rPaired) == 4)
+ stopifnot(all( log2(exprs(esetPaired)[,1]) - log2(exprs(esetPaired)[,5]) == rPaired[,1] ))
+ stopifnot(all( log2(exprs(esetPaired)[,4]) - log2(exprs(esetPaired)[,6]) == rPaired[,4] ))
+ stopifnot(all( exprs(esetPaired)[,4] / exprs(esetPaired)[,6] == getRatios(esetPaired, method="paired", log2=F)[,4] ))
+ # should fail
+ stopifnot((inherits(try( getRatios(eset, method="paired"), silent = TRUE), "try-error")))
+
+
+ stopifnot(all(round(getRatios(esetPaired)[,1],2) == round(apply(rPaired[,1:2],1,median),2)))
+
+
+ cat("--- testGetRatios: PASS ALL TEST --- \n")
+
+ }
>
> testGetAllCV <- function(){
+
+ cat("--- testGetAllCV: --- \n")
+
+ cv <- getAllCV(eset)
+
+ stopifnot(all.equal(cv[1,"A"] , (sd(exprs(eset)[1,unlist(pData(eset)$condition == "A")]) / mean(exprs(eset)[1,unlist(pData(eset)$condition == "A")]))))
+ stopifnot(all.equal(cv[200,"C"] , sd(exprs(eset)[200,unlist(pData(eset)$condition == "C")]) / mean(exprs(eset)[200,unlist(pData(eset)$condition == "C")])))
+
+ cvPaired <- getAllCV(esetPaired)
+ stopifnot(all(is.na(cvPaired[,1])))
+ stopifnot(all(!is.na(cvPaired[,2])))
+ stopifnot(cvPaired[3,"A"] == (sd(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6]) / mean(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6])))
+
+ cat("--- testGetAllCV: PASS ALL TEST --- \n")
+ }
>
> testGlobalNormalize <- function(){
+
+ cat("--- testGlobalNormalize: --- \n")
+
+ globalNormFactors <- getGlobalNormFactors(eset,method="sum")
+ ### add normalization factors to ExpressionSet
+ pData(eset) <- cbind(pData(eset),globalNormFactors)
+ esetNorm <- globalNormalize(eset,globalNormFactors)
+
+ stopifnot(all.equal(as.vector(unlist(apply(exprs(esetNorm),2,sum))),as.vector(rev(unlist(apply(exprs(esetNorm),2,sum))))))
+
+ stopifnot(pData(esetNorm)$normFactor[1] == 1)
+ stopifnot(pData(esetNorm)$normFactor[2] != 1)
+
+ cat("--- testGlobalNormalize: PASS ALL TEST --- \n")
+
+ # Should generate error and stop
+ # fData(eset)$isNormAnchor <- rep(F,nrow(eset))
+ # esetNorm <- normalizeIntensities(eset)
+
+ }
>
> testGetSignalPerCondition <- function(){
+
+ cat("--- testGetSignalPerCondition: --- \n")
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"A"] <= getSignalPerCondition(eset,method="max")[,"A"]) == nrow(eset))
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"C"] <= getSignalPerCondition(eset,method="median")[,"C"]) == nrow(eset))
+ stopifnot(getSignalPerCondition(eset,method="sd")[1,2] == sd(exprs(eset)[1,3:4]))
+ cat("--- testGetSignalPerCondition: PASS ALL TEST --- \n")
+ }
>
> testBaselineIntensity <- function(){
+
+ cat("--- testBaselineIntensity: --- \n")
+
+ allInt <- as.vector(unlist(exprs(eset)))
+ bl <- round(getBaselineIntensity(allInt,promille=5),2)
+ #hist(allInt)
+ #abline(v=bl,lwd=2)
+ stopifnot(all.equal(bl[[1]] , 997.82) )
+
+
+ set.seed(1234)
+ suppressWarnings(allInt2 <- log10(rnorm(1000,1,1)))
+ bl2 <- round(getBaselineIntensity(allInt2,promille=5),2)
+ stopifnot(all.equal(-1.95,bl2[[1]]))
+ #hist(allInt2)
+ #abline(v=bl2,lwd=2)
+
+ cat("--- testBaselineIntensity: PASS ALL TEST --- \n")
+
+ }
>
> testRollUp <- function(){
+
+ cat(" --- testRollUp --- \n")
+
+ rollUpEset1 <- rollUp(eset,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$proteinName ) ) == nrow(rollUpEset1))
+
+ rollUpEset2 <- rollUp(eset ,featureDataColumnName= c("ptm"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset2))
+
+ rollUpEset3 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("ptm"), method=c("mean"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset3))
+
+ #print(exprs(rollUpEset2))
+
+ stopifnot(all.equal(sum(exprs(rollUpEset2)),sum(exprs(rollUpEset1)))) ### test sum
+ stopifnot(sum(exprs(rollUpEset1)) != sum(exprs(rollUpEset3))) ### test mean
+
+ rollUpEset4 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))
+ stopifnot(sum(exprs(rollUpEset3)) != sum(exprs(rollUpEset4)) ) ### test top 3
+
+ cat(" --- testRollUp: PASS ALL TEST --- \n")
+
+ # progenesisFeatureCsvFile3 <- "/Users/ahrnee-adm/dev/R/workspace/SafeQuant/inst/testData/2014/peptides2.csv"
+ # d <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile3,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile3))
+ # system.time(e <- rollUp(d, method="sum", isProgressBar=T, featureDataColumnName= c("peptide")))
+ # system.time(e <- rollUpDT(d, method="sum", featureDataColumnName= c("peptide")))
+ #
+ esetTmp <- parseProgenesisPeptideMeasurementCsv(progenesisPeptideMeasurementCsvFile1,expDesign= getExpDesignProgenesisCsv(progenesisPeptideMeasurementCsvFile1))
+
+ fData(esetTmp)
+
+ rollUpEsetProteinAllAccessions <- rollUp(esetTmp,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot(fData(rollUpEsetProteinAllAccessions)$allAccessionsTMP[68] == "sp|E9PAV3|NACAM_HUMAN;sp|Q9BZK3|NACP1_HUMAN")
+
+ }
>
> testTopX <- function(){
+
+ cat(" --- testTopX --- \n")
+
+ entryData1 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,5),ncol=4)))
+ rownames(entryData1) <- paste("peptide",1:nrow(entryData1),sep="_")
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 5
+ stopifnot(all.equal(rep(10/3,3) , as.vector(unlist(getTopX(entryData1))) ))
+
+ entryData2 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,NA),ncol=4)))
+ rownames(entryData2) <- paste("peptide",1:nrow(entryData2),sep="_")
+
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 NA
+ stopifnot(all.equal(c(4,4,3) , as.vector(unlist(getTopX(entryData2,topX=2)))))
+
+ # 1 row
+ stopifnot(all.equal(rep(1,3),as.vector(unlist(getTopX(entryData1[1,])))))
+
+ # 1 col
+ stopifnot(all.equal(getTopX(entryData1)[[1]],getTopX(entryData1[,1])))
+
+ top1 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top1"))),1,sum)
+ top3 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))),1,sum)
+ meanInt <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("mean"))),1,sum)
+
+ stopifnot(sum(top1 >= top3 ) == length(top3))
+ stopifnot(sum(top1) > sum(top3))
+ stopifnot(sum(top1) > sum(meanInt))
+ stopifnot(all.equal(sum(top3),sum(meanInt)))
+
+ cat(" --- testTopX: PASS ALL TEST --- \n")
+
+ }
>
> testGetIBAQEset <- function(){
+
+ cat(" --- testGetIBAQEset --- \n")
+
+ # read protein fasta
+ proteinDB <- read.fasta(fastaFile,seqtype = "AA",as.string = TRUE, set.attributes = FALSE)
+
+ iBaqEset <- getIBAQEset(eset,proteinDB=proteinDB)
+ stopifnot(round(exprs(iBaqEset))[1,1] == 125)
+ stopifnot(round(exprs(iBaqEset))[2,2] == 38)
+
+ cat(" --- testGetIBAQEset: PASS ALL TEST --- \n")
+ }
>
>
> testGetLoocvFoldError <- function(){
+
+ cat(" --- testGetLoocvFoldError --- \n")
+ #plotCalibrationCurve(fit)
+ stopifnot( round(sum(getLoocvFoldError(absEstSimData))) == -8)
+ cat(" --- testGetLoocvFoldError: PASS ALL TEST --- \n")
+ }
>
> testSqNormalize <- function(){
+
+ cat(" --- testSqNormalize --- \n")
+
+ stopifnot(nrow(sqNormalize(eset, method = "global")) == 900)
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ stopifnot(nrow(sqNormalize(esetTmp, method = "rt")) == 496)
+
+ cat(" --- testSqNormalize: PASS ALL TEST --- \n")
+ }
>
>
> testRtNormalize <- function(){
+
+
+ cat(" --- testRTNormalize --- \n")
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ rtNormFactors <- getRTNormFactors(esetTmp, minFeaturesPerBin=100)
+ stopifnot(nrow(rtNormalize(esetTmp,rtNormFactors)) == 97)
+
+ # Stop if rtNormFactors doesn't cover all retention times.
+ #rtNormalize(esetTmp,rtNormFactors[1:2,])
+
+ cat(" --- testRTNormalize: PASS ALL TEST --- \n")
+ }
>
> testRemoveOutliers <- function(){
+
+ cat(" --- testRemoveOutliers --- \n")
+ set.seed(1234)
+ stopifnot(sum(is.na(removeOutliers(c(-10, rnorm(100), 10)))) == 2)
+ cat(" --- testRemoveOutliers: PASS ALL TEST --- \n")
+ }
>
> testPerFeatureNormalization <- function(){
+
+ cat(" --- testPerFeatureNormalization: --- \n")
+
+ normFactors <- exprs(eset)[1:10,1:3]
+ colnames(normFactors) <- c("A","B","C")
+ rownames(normFactors) <- fData(eset)[1:10,]$proteinName
+ normFactors[is.finite(normFactors)] <- 1
+ eNorm <- perFeatureNormalization(eset,normFactors)
+
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,2] , (exprs(eset)[1,2]-1)))
+ stopifnot(all.equal(exprs(eNorm)[13,2] , (exprs(eset)[13,2])))
+
+ normFactors[,2] <- 200
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,3] , (exprs(eset)[1,3]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,4] , (exprs(eset)[1,4]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,5] , (exprs(eset)[1,5]-1)))
+
+ normFactors[,3] <- 0
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,5] , exprs(eset)[1,5]))
+ stopifnot(all.equal(exprs(eNorm)[2,6] , exprs(eset)[2,6]))
+
+ normFactors[3,] <- 1000
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ # re-order normFactors columns
+ eNorm <- perFeatureNormalization(eset,normFactors[,rev(colnames(normFactors))])
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ cat(" --- testPerFeatureNormalization: PASS ALL TEST --- \n")
+
+ #coveredPeptideSel <- fData(eset)$proteinName %in% rownames(normFactors)
+ #exprs(eset)[coveredPeptideSel,] <- exprs(eset)[coveredPeptideSel, ] - normFactors[as.character(fData(eset)[coveredPeptideSel,]$proteinName),pData(eset)$condition]
+
+ }
>
>
> testStandardise <- function(){
+
+ cat(" --- testStandardise: --- \n")
+
+ d <- data.frame(rnorm(10000,5,20), rnorm(10000,10,10))
+ dStd <- standardise(d[,1])
+
+ stopifnot(round(mean(dStd)) == 0 )
+ stopifnot(round(sd(dStd)) == 1 )
+
+ dStd <- standardise(d)
+ stopifnot(round(apply(dStd,2,mean)[1]) == 0)
+ stopifnot(round(apply(dStd,2,sd)[1]) == 1)
+
+ cat(" --- testStandardise: PASS ALL TEST --- \n")
+
+ }
>
> testGetMaxIndex <-function(){
+
+ cat(" --- testGetMaxIndex: --- \n")
+ d <- data.frame(s=c(NA,NA,NA,NA,1,1:4),lab=sort(rep(c("A","B","C"),3)))
+ DT <- data.table(d)
+ setkey(DT,lab)
+
+
+ stopifnot(all.equal(c(1,5,9) , DT[, .I[getMaxIndex(s)], by=lab ]$V1 ))
+ cat(" --- testGetMaxIndex: PASS ALL TEST --- \n")
+
+ }
>
> testCreatePairedExpDesign <- function(){
+
+ cat(" --- testCreatePairedExpDesign: --- \n")
+ stopifnot(all( pData(createPairedExpDesign(eset))$subject == as.factor(rep(1:2,3))))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:3]), silent = TRUE), "try-error")))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:4]), silent = TRUE), "ExpressionSet")))
+ cat(" --- testCreatePairedExpDesign: PASS ALL TEST --- \n")
+
+ }
>
> ### TEST FUNCTIONS END
>
> #### TESTS
> #testGetRatios()
> #testGetAllEBayes()
> #testGetSignalPerCondition()
> #testGetRatios()
>
> if(T){
+ testCreateExpressionDataset()
+ testGetAllEBayes()
+ testGetRatios()
+ testGetAllCV()
+ testGlobalNormalize()
+ #testNormalise()
+ testRtNormalize()
+
+ testBaselineIntensity()
+ testRollUp()
+ testTopX()
+
+ testGetLoocvFoldError()
+
+ testRemoveOutliers()
+ testPerFeatureNormalization()
+ testStandardise()
+ testGetMaxIndex()
+
+ testGetIBAQEset()
+
+ testCreatePairedExpDesign()
+
+ }
--- testCreateExpressionDataset: ---
Error in testCreateExpressionDataset() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testCreateExpressionDataset -> stopifnot
Execution halted
Running the tests in ‘tests/testUserOptions.R’ failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
>
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testExpDesignTagToExpDesign <- function(){
+
+ cat("--- testExpDesignTagToExpDesign: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+
+ expDesignString1 <- "1,2,3:4,5,6"
+
+ # 6-plex default: 1,2,3:4,5,6
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 1 TRUE
+ #3 Condition 1 TRUE
+ #4 Condition 2 FALSE
+ #5 Condition 2 FALSE
+ #6 Condition 2 FALSE
+
+
+ expDesign <- data.frame(condition=paste("Condition",sort(rep(c(1,2),3))),isControl=sort(rep(c(T,F),3),decreasing=T) )
+
+ expDesign1 <- expDesignTagToExpDesign(expDesignString1, expDesign)
+
+ stopifnot(nrow(expDesign1) == 6 )
+ stopifnot(length(unique(expDesign1$condition)) == 2 )
+ stopifnot(sum(expDesign1$isControl) == 3 )
+
+ expDesignString2 <- "1,4,7,10:2,5,8:3,6,9"
+
+ # 10-plex default is "1,4,7,10:2,5,8:3,6,9"
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 2 FALSE
+ #3 Condition 3 FALSE
+ #4 Condition 1 TRUE
+ #5 Condition 2 FALSE
+ #6 Condition 3 FALSE
+ #7 Condition 1 TRUE
+ #8 Condition 2 FALSE
+ #9 Condition 3 FALSE
+ #10 Condition 1 TRUE
+
+ expDesign <- data.frame(condition=paste("Condition",c(1,2,3,1,2,3,1,2,3,1)),isControl=c(T,F,F,T,F,F,T,F,F,T) )
+ expDesign2 <- expDesignTagToExpDesign(expDesignString2, expDesign)
+ stopifnot(nrow(expDesign2) == 10 )
+ stopifnot(length(unique(expDesign2$condition)) == 3 )
+ stopifnot(sum(expDesign2$isControl) == 4 )
+
+ ### condition name assignment when mixing runs from different conditions
+ expDesign <- data.frame(condition=paste("foo",c(1,1,1,2,2,3,3)),isControl=c(F,F,F,T,T,F,F) )
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5:6",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1:4,6:5",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1,2,4",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("2",expDesign)$condition)))
+ stopifnot( length(unique(expDesignTagToExpDesign("1:2:3:4:5:6",expDesign)$condition)) == 6)
+
+ cat("--- testExpDesignTagToExpDesign: PASS ALL TEST --- \n")
+
+ }
>
>
> ### TEST FUNCTIONS END
>
> ### TESTS
> testExpDesignTagToExpDesign()
--- testExpDesignTagToExpDesign: ---
Error in testExpDesignTagToExpDesign() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testExpDesignTagToExpDesign -> stopifnot
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 2.3.1
Check: tests
Result: ERROR
Running ‘initTestSession.R’ [17s/21s]
Running ‘runAllTest.R’
Running ‘testExpressionAnalysis.R’ [17s/21s]
Running ‘testGraphics.R’ [27s/34s]
Running ‘testIdentificationAnalysis.R’ [18s/21s]
Running ‘testParser.R’ [19s/23s]
Running ‘testSafeQuantAnalysis.R’ [25s/31s]
Running ‘testTMT.R’ [17s/20s]
Running ‘testUserOptions.R’ [17s/22s]
Running the tests in ‘tests/testExpressionAnalysis.R’ failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testCreateExpressionDataset <- function(){
+
+ cat("--- testCreateExpressionDataset: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+ cat("--- testCreateExpressionDataset: PASS ALL TEST --- \n")
+
+ }
>
>
> testGetAllEBayes <- function(){
+
+
+ cat("--- testGetAllEBayes: --- \n")
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ pAdj <- getAllEBayes(eset, adjust=T)
+
+ stopifnot( mean(pAdj[,"A"]) > mean(p[,"A"]) )
+
+ ### paired desgn
+ esetNonPaired <- esetPaired
+ pData(esetNonPaired) <- pData(esetPaired)[,1:2]
+
+ pValPaired <- getAllEBayes(esetPaired,adjust=F,method=c("all"))
+ pValPairedPairwise <- getAllEBayes(esetPaired,adjust=F,method=c("pairwise"))
+
+ pValNonPaired <- getAllEBayes(esetNonPaired,adjust=F,method=c("all"))
+ pValNonPairedPairwise <- getAllEBayes(esetNonPaired,adjust=F,method=c("pairwise"))
+ stopifnot(all(apply(pValPaired,2,sum) < apply(pValNonPaired,2,sum)))
+ stopifnot(all(apply(pValPairedPairwise,2,sum) < apply(pValNonPairedPairwise,2,sum)))
+
+ # adjustment filter
+
+ adjustfilter <- data.frame(rep(T,nrow(eset)),rep(T,nrow(eset)) )
+ adjustfilter[1,1] <- F
+ adjustfilter[2,2] <- F
+
+ pTmp <- getAllEBayes(eset,adjust=T, adjustFilter=adjustfilter)
+ stopifnot(p[1,1] == pTmp[1,1])
+ stopifnot(p[2,2] == pTmp[2,2])
+ stopifnot(is.na(pTmp[3,2]))
+ cat("--- testGetAllEBayes: PASS ALL TEST --- \n")
+
+ # Question: limma multiple groups comparison produces different pvalue comparing with two group comparsion
+ # https://support.bioconductor.org/p/44216/
+ # https://support.bioconductor.org/p/60556/
+ }
>
> testGetRatios <- function(){
+
+ cat("--- testGetRatios: --- \n")
+
+ r <- getRatios(eset)
+
+ exprs(eset)[1,c(5:6,1:2)]
+ # C_rep_1 C_rep_2 A_rep_1 A_rep_2
+ # 9.963852 9.966003 9.965568 9.967214
+
+ ## NOTE: C is control
+ stopifnot(all.equal(r[1,1],median(log2(exprs(eset))[1,1:2]) - median(log2(exprs(eset))[1,5:6]) ) )
+
+ stopifnot(mean(r[,"A"]) < mean(r[,"B"]))
+ stopifnot(all.equal(r,getRatios(eset,method="mean")))
+ r <- getRatios(eset)
+ stopifnot(all.equal(mean(r[,"B"]),mean(r[,"B"])))
+
+ stopifnot(all(round(apply(getRatios(esetPaired, log2=F),2,mean),1) == c(1.5,1.2)))
+ stopifnot(ncol(r) == 2)
+
+ rPaired <- getRatios(esetPaired, method="paired")
+ stopifnot(ncol(rPaired) == 4)
+ stopifnot(all( log2(exprs(esetPaired)[,1]) - log2(exprs(esetPaired)[,5]) == rPaired[,1] ))
+ stopifnot(all( log2(exprs(esetPaired)[,4]) - log2(exprs(esetPaired)[,6]) == rPaired[,4] ))
+ stopifnot(all( exprs(esetPaired)[,4] / exprs(esetPaired)[,6] == getRatios(esetPaired, method="paired", log2=F)[,4] ))
+ # should fail
+ stopifnot((inherits(try( getRatios(eset, method="paired"), silent = TRUE), "try-error")))
+
+
+ stopifnot(all(round(getRatios(esetPaired)[,1],2) == round(apply(rPaired[,1:2],1,median),2)))
+
+
+ cat("--- testGetRatios: PASS ALL TEST --- \n")
+
+ }
>
> testGetAllCV <- function(){
+
+ cat("--- testGetAllCV: --- \n")
+
+ cv <- getAllCV(eset)
+
+ stopifnot(all.equal(cv[1,"A"] , (sd(exprs(eset)[1,unlist(pData(eset)$condition == "A")]) / mean(exprs(eset)[1,unlist(pData(eset)$condition == "A")]))))
+ stopifnot(all.equal(cv[200,"C"] , sd(exprs(eset)[200,unlist(pData(eset)$condition == "C")]) / mean(exprs(eset)[200,unlist(pData(eset)$condition == "C")])))
+
+ cvPaired <- getAllCV(esetPaired)
+ stopifnot(all(is.na(cvPaired[,1])))
+ stopifnot(all(!is.na(cvPaired[,2])))
+ stopifnot(cvPaired[3,"A"] == (sd(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6]) / mean(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6])))
+
+ cat("--- testGetAllCV: PASS ALL TEST --- \n")
+ }
>
> testGlobalNormalize <- function(){
+
+ cat("--- testGlobalNormalize: --- \n")
+
+ globalNormFactors <- getGlobalNormFactors(eset,method="sum")
+ ### add normalization factors to ExpressionSet
+ pData(eset) <- cbind(pData(eset),globalNormFactors)
+ esetNorm <- globalNormalize(eset,globalNormFactors)
+
+ stopifnot(all.equal(as.vector(unlist(apply(exprs(esetNorm),2,sum))),as.vector(rev(unlist(apply(exprs(esetNorm),2,sum))))))
+
+ stopifnot(pData(esetNorm)$normFactor[1] == 1)
+ stopifnot(pData(esetNorm)$normFactor[2] != 1)
+
+ cat("--- testGlobalNormalize: PASS ALL TEST --- \n")
+
+ # Should generate error and stop
+ # fData(eset)$isNormAnchor <- rep(F,nrow(eset))
+ # esetNorm <- normalizeIntensities(eset)
+
+ }
>
> testGetSignalPerCondition <- function(){
+
+ cat("--- testGetSignalPerCondition: --- \n")
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"A"] <= getSignalPerCondition(eset,method="max")[,"A"]) == nrow(eset))
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"C"] <= getSignalPerCondition(eset,method="median")[,"C"]) == nrow(eset))
+ stopifnot(getSignalPerCondition(eset,method="sd")[1,2] == sd(exprs(eset)[1,3:4]))
+ cat("--- testGetSignalPerCondition: PASS ALL TEST --- \n")
+ }
>
> testBaselineIntensity <- function(){
+
+ cat("--- testBaselineIntensity: --- \n")
+
+ allInt <- as.vector(unlist(exprs(eset)))
+ bl <- round(getBaselineIntensity(allInt,promille=5),2)
+ #hist(allInt)
+ #abline(v=bl,lwd=2)
+ stopifnot(all.equal(bl[[1]] , 997.82) )
+
+
+ set.seed(1234)
+ suppressWarnings(allInt2 <- log10(rnorm(1000,1,1)))
+ bl2 <- round(getBaselineIntensity(allInt2,promille=5),2)
+ stopifnot(all.equal(-1.95,bl2[[1]]))
+ #hist(allInt2)
+ #abline(v=bl2,lwd=2)
+
+ cat("--- testBaselineIntensity: PASS ALL TEST --- \n")
+
+ }
>
> testRollUp <- function(){
+
+ cat(" --- testRollUp --- \n")
+
+ rollUpEset1 <- rollUp(eset,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$proteinName ) ) == nrow(rollUpEset1))
+
+ rollUpEset2 <- rollUp(eset ,featureDataColumnName= c("ptm"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset2))
+
+ rollUpEset3 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("ptm"), method=c("mean"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset3))
+
+ #print(exprs(rollUpEset2))
+
+ stopifnot(all.equal(sum(exprs(rollUpEset2)),sum(exprs(rollUpEset1)))) ### test sum
+ stopifnot(sum(exprs(rollUpEset1)) != sum(exprs(rollUpEset3))) ### test mean
+
+ rollUpEset4 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))
+ stopifnot(sum(exprs(rollUpEset3)) != sum(exprs(rollUpEset4)) ) ### test top 3
+
+ cat(" --- testRollUp: PASS ALL TEST --- \n")
+
+ # progenesisFeatureCsvFile3 <- "/Users/ahrnee-adm/dev/R/workspace/SafeQuant/inst/testData/2014/peptides2.csv"
+ # d <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile3,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile3))
+ # system.time(e <- rollUp(d, method="sum", isProgressBar=T, featureDataColumnName= c("peptide")))
+ # system.time(e <- rollUpDT(d, method="sum", featureDataColumnName= c("peptide")))
+ #
+ esetTmp <- parseProgenesisPeptideMeasurementCsv(progenesisPeptideMeasurementCsvFile1,expDesign= getExpDesignProgenesisCsv(progenesisPeptideMeasurementCsvFile1))
+
+ fData(esetTmp)
+
+ rollUpEsetProteinAllAccessions <- rollUp(esetTmp,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot(fData(rollUpEsetProteinAllAccessions)$allAccessionsTMP[68] == "sp|E9PAV3|NACAM_HUMAN;sp|Q9BZK3|NACP1_HUMAN")
+
+ }
>
> testTopX <- function(){
+
+ cat(" --- testTopX --- \n")
+
+ entryData1 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,5),ncol=4)))
+ rownames(entryData1) <- paste("peptide",1:nrow(entryData1),sep="_")
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 5
+ stopifnot(all.equal(rep(10/3,3) , as.vector(unlist(getTopX(entryData1))) ))
+
+ entryData2 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,NA),ncol=4)))
+ rownames(entryData2) <- paste("peptide",1:nrow(entryData2),sep="_")
+
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 NA
+ stopifnot(all.equal(c(4,4,3) , as.vector(unlist(getTopX(entryData2,topX=2)))))
+
+ # 1 row
+ stopifnot(all.equal(rep(1,3),as.vector(unlist(getTopX(entryData1[1,])))))
+
+ # 1 col
+ stopifnot(all.equal(getTopX(entryData1)[[1]],getTopX(entryData1[,1])))
+
+ top1 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top1"))),1,sum)
+ top3 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))),1,sum)
+ meanInt <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("mean"))),1,sum)
+
+ stopifnot(sum(top1 >= top3 ) == length(top3))
+ stopifnot(sum(top1) > sum(top3))
+ stopifnot(sum(top1) > sum(meanInt))
+ stopifnot(all.equal(sum(top3),sum(meanInt)))
+
+ cat(" --- testTopX: PASS ALL TEST --- \n")
+
+ }
>
> testGetIBAQEset <- function(){
+
+ cat(" --- testGetIBAQEset --- \n")
+
+ # read protein fasta
+ proteinDB <- read.fasta(fastaFile,seqtype = "AA",as.string = TRUE, set.attributes = FALSE)
+
+ iBaqEset <- getIBAQEset(eset,proteinDB=proteinDB)
+ stopifnot(round(exprs(iBaqEset))[1,1] == 125)
+ stopifnot(round(exprs(iBaqEset))[2,2] == 38)
+
+ cat(" --- testGetIBAQEset: PASS ALL TEST --- \n")
+ }
>
>
> testGetLoocvFoldError <- function(){
+
+ cat(" --- testGetLoocvFoldError --- \n")
+ #plotCalibrationCurve(fit)
+ stopifnot( round(sum(getLoocvFoldError(absEstSimData))) == -8)
+ cat(" --- testGetLoocvFoldError: PASS ALL TEST --- \n")
+ }
>
> testSqNormalize <- function(){
+
+ cat(" --- testSqNormalize --- \n")
+
+ stopifnot(nrow(sqNormalize(eset, method = "global")) == 900)
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ stopifnot(nrow(sqNormalize(esetTmp, method = "rt")) == 496)
+
+ cat(" --- testSqNormalize: PASS ALL TEST --- \n")
+ }
>
>
> testRtNormalize <- function(){
+
+
+ cat(" --- testRTNormalize --- \n")
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ rtNormFactors <- getRTNormFactors(esetTmp, minFeaturesPerBin=100)
+ stopifnot(nrow(rtNormalize(esetTmp,rtNormFactors)) == 97)
+
+ # Stop if rtNormFactors doesn't cover all retention times.
+ #rtNormalize(esetTmp,rtNormFactors[1:2,])
+
+ cat(" --- testRTNormalize: PASS ALL TEST --- \n")
+ }
>
> testRemoveOutliers <- function(){
+
+ cat(" --- testRemoveOutliers --- \n")
+ set.seed(1234)
+ stopifnot(sum(is.na(removeOutliers(c(-10, rnorm(100), 10)))) == 2)
+ cat(" --- testRemoveOutliers: PASS ALL TEST --- \n")
+ }
>
> testPerFeatureNormalization <- function(){
+
+ cat(" --- testPerFeatureNormalization: --- \n")
+
+ normFactors <- exprs(eset)[1:10,1:3]
+ colnames(normFactors) <- c("A","B","C")
+ rownames(normFactors) <- fData(eset)[1:10,]$proteinName
+ normFactors[is.finite(normFactors)] <- 1
+ eNorm <- perFeatureNormalization(eset,normFactors)
+
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,2] , (exprs(eset)[1,2]-1)))
+ stopifnot(all.equal(exprs(eNorm)[13,2] , (exprs(eset)[13,2])))
+
+ normFactors[,2] <- 200
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,3] , (exprs(eset)[1,3]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,4] , (exprs(eset)[1,4]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,5] , (exprs(eset)[1,5]-1)))
+
+ normFactors[,3] <- 0
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,5] , exprs(eset)[1,5]))
+ stopifnot(all.equal(exprs(eNorm)[2,6] , exprs(eset)[2,6]))
+
+ normFactors[3,] <- 1000
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ # re-order normFactors columns
+ eNorm <- perFeatureNormalization(eset,normFactors[,rev(colnames(normFactors))])
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ cat(" --- testPerFeatureNormalization: PASS ALL TEST --- \n")
+
+ #coveredPeptideSel <- fData(eset)$proteinName %in% rownames(normFactors)
+ #exprs(eset)[coveredPeptideSel,] <- exprs(eset)[coveredPeptideSel, ] - normFactors[as.character(fData(eset)[coveredPeptideSel,]$proteinName),pData(eset)$condition]
+
+ }
>
>
> testStandardise <- function(){
+
+ cat(" --- testStandardise: --- \n")
+
+ d <- data.frame(rnorm(10000,5,20), rnorm(10000,10,10))
+ dStd <- standardise(d[,1])
+
+ stopifnot(round(mean(dStd)) == 0 )
+ stopifnot(round(sd(dStd)) == 1 )
+
+ dStd <- standardise(d)
+ stopifnot(round(apply(dStd,2,mean)[1]) == 0)
+ stopifnot(round(apply(dStd,2,sd)[1]) == 1)
+
+ cat(" --- testStandardise: PASS ALL TEST --- \n")
+
+ }
>
> testGetMaxIndex <-function(){
+
+ cat(" --- testGetMaxIndex: --- \n")
+ d <- data.frame(s=c(NA,NA,NA,NA,1,1:4),lab=sort(rep(c("A","B","C"),3)))
+ DT <- data.table(d)
+ setkey(DT,lab)
+
+
+ stopifnot(all.equal(c(1,5,9) , DT[, .I[getMaxIndex(s)], by=lab ]$V1 ))
+ cat(" --- testGetMaxIndex: PASS ALL TEST --- \n")
+
+ }
>
> testCreatePairedExpDesign <- function(){
+
+ cat(" --- testCreatePairedExpDesign: --- \n")
+ stopifnot(all( pData(createPairedExpDesign(eset))$subject == as.factor(rep(1:2,3))))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:3]), silent = TRUE), "try-error")))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:4]), silent = TRUE), "ExpressionSet")))
+ cat(" --- testCreatePairedExpDesign: PASS ALL TEST --- \n")
+
+ }
>
> ### TEST FUNCTIONS END
>
> #### TESTS
> #testGetRatios()
> #testGetAllEBayes()
> #testGetSignalPerCondition()
> #testGetRatios()
>
> if(T){
+ testCreateExpressionDataset()
+ testGetAllEBayes()
+ testGetRatios()
+ testGetAllCV()
+ testGlobalNormalize()
+ #testNormalise()
+ testRtNormalize()
+
+ testBaselineIntensity()
+ testRollUp()
+ testTopX()
+
+ testGetLoocvFoldError()
+
+ testRemoveOutliers()
+ testPerFeatureNormalization()
+ testStandardise()
+ testGetMaxIndex()
+
+ testGetIBAQEset()
+
+ testCreatePairedExpDesign()
+
+ }
--- testCreateExpressionDataset: ---
Error in testCreateExpressionDataset() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testCreateExpressionDataset -> stopifnot
Execution halted
Running the tests in ‘tests/testUserOptions.R’ failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
>
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testExpDesignTagToExpDesign <- function(){
+
+ cat("--- testExpDesignTagToExpDesign: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+
+ expDesignString1 <- "1,2,3:4,5,6"
+
+ # 6-plex default: 1,2,3:4,5,6
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 1 TRUE
+ #3 Condition 1 TRUE
+ #4 Condition 2 FALSE
+ #5 Condition 2 FALSE
+ #6 Condition 2 FALSE
+
+
+ expDesign <- data.frame(condition=paste("Condition",sort(rep(c(1,2),3))),isControl=sort(rep(c(T,F),3),decreasing=T) )
+
+ expDesign1 <- expDesignTagToExpDesign(expDesignString1, expDesign)
+
+ stopifnot(nrow(expDesign1) == 6 )
+ stopifnot(length(unique(expDesign1$condition)) == 2 )
+ stopifnot(sum(expDesign1$isControl) == 3 )
+
+ expDesignString2 <- "1,4,7,10:2,5,8:3,6,9"
+
+ # 10-plex default is "1,4,7,10:2,5,8:3,6,9"
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 2 FALSE
+ #3 Condition 3 FALSE
+ #4 Condition 1 TRUE
+ #5 Condition 2 FALSE
+ #6 Condition 3 FALSE
+ #7 Condition 1 TRUE
+ #8 Condition 2 FALSE
+ #9 Condition 3 FALSE
+ #10 Condition 1 TRUE
+
+ expDesign <- data.frame(condition=paste("Condition",c(1,2,3,1,2,3,1,2,3,1)),isControl=c(T,F,F,T,F,F,T,F,F,T) )
+ expDesign2 <- expDesignTagToExpDesign(expDesignString2, expDesign)
+ stopifnot(nrow(expDesign2) == 10 )
+ stopifnot(length(unique(expDesign2$condition)) == 3 )
+ stopifnot(sum(expDesign2$isControl) == 4 )
+
+ ### condition name assignment when mixing runs from different conditions
+ expDesign <- data.frame(condition=paste("foo",c(1,1,1,2,2,3,3)),isControl=c(F,F,F,T,T,F,F) )
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5:6",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1:4,6:5",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1,2,4",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("2",expDesign)$condition)))
+ stopifnot( length(unique(expDesignTagToExpDesign("1:2:3:4:5:6",expDesign)$condition)) == 6)
+
+ cat("--- testExpDesignTagToExpDesign: PASS ALL TEST --- \n")
+
+ }
>
>
> ### TEST FUNCTIONS END
>
> ### TESTS
> testExpDesignTagToExpDesign()
--- testExpDesignTagToExpDesign: ---
Error in testExpDesignTagToExpDesign() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testExpDesignTagToExpDesign -> stopifnot
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 2.3.1
Check: tests
Result: ERROR
Running ‘initTestSession.R’ [17s/22s]
Running ‘runAllTest.R’
Running ‘testExpressionAnalysis.R’ [18s/23s]
Running ‘testGraphics.R’ [28s/34s]
Running ‘testIdentificationAnalysis.R’ [20s/27s]
Running ‘testParser.R’ [20s/24s]
Running ‘testSafeQuantAnalysis.R’ [25s/30s]
Running ‘testTMT.R’ [17s/21s]
Running ‘testUserOptions.R’ [18s/24s]
Running the tests in ‘tests/testExpressionAnalysis.R’ failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testCreateExpressionDataset <- function(){
+
+ cat("--- testCreateExpressionDataset: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+ cat("--- testCreateExpressionDataset: PASS ALL TEST --- \n")
+
+ }
>
>
> testGetAllEBayes <- function(){
+
+
+ cat("--- testGetAllEBayes: --- \n")
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ pAdj <- getAllEBayes(eset, adjust=T)
+
+ stopifnot( mean(pAdj[,"A"]) > mean(p[,"A"]) )
+
+ ### paired desgn
+ esetNonPaired <- esetPaired
+ pData(esetNonPaired) <- pData(esetPaired)[,1:2]
+
+ pValPaired <- getAllEBayes(esetPaired,adjust=F,method=c("all"))
+ pValPairedPairwise <- getAllEBayes(esetPaired,adjust=F,method=c("pairwise"))
+
+ pValNonPaired <- getAllEBayes(esetNonPaired,adjust=F,method=c("all"))
+ pValNonPairedPairwise <- getAllEBayes(esetNonPaired,adjust=F,method=c("pairwise"))
+ stopifnot(all(apply(pValPaired,2,sum) < apply(pValNonPaired,2,sum)))
+ stopifnot(all(apply(pValPairedPairwise,2,sum) < apply(pValNonPairedPairwise,2,sum)))
+
+ # adjustment filter
+
+ adjustfilter <- data.frame(rep(T,nrow(eset)),rep(T,nrow(eset)) )
+ adjustfilter[1,1] <- F
+ adjustfilter[2,2] <- F
+
+ pTmp <- getAllEBayes(eset,adjust=T, adjustFilter=adjustfilter)
+ stopifnot(p[1,1] == pTmp[1,1])
+ stopifnot(p[2,2] == pTmp[2,2])
+ stopifnot(is.na(pTmp[3,2]))
+ cat("--- testGetAllEBayes: PASS ALL TEST --- \n")
+
+ # Question: limma multiple groups comparison produces different pvalue comparing with two group comparsion
+ # https://support.bioconductor.org/p/44216/
+ # https://support.bioconductor.org/p/60556/
+ }
>
> testGetRatios <- function(){
+
+ cat("--- testGetRatios: --- \n")
+
+ r <- getRatios(eset)
+
+ exprs(eset)[1,c(5:6,1:2)]
+ # C_rep_1 C_rep_2 A_rep_1 A_rep_2
+ # 9.963852 9.966003 9.965568 9.967214
+
+ ## NOTE: C is control
+ stopifnot(all.equal(r[1,1],median(log2(exprs(eset))[1,1:2]) - median(log2(exprs(eset))[1,5:6]) ) )
+
+ stopifnot(mean(r[,"A"]) < mean(r[,"B"]))
+ stopifnot(all.equal(r,getRatios(eset,method="mean")))
+ r <- getRatios(eset)
+ stopifnot(all.equal(mean(r[,"B"]),mean(r[,"B"])))
+
+ stopifnot(all(round(apply(getRatios(esetPaired, log2=F),2,mean),1) == c(1.5,1.2)))
+ stopifnot(ncol(r) == 2)
+
+ rPaired <- getRatios(esetPaired, method="paired")
+ stopifnot(ncol(rPaired) == 4)
+ stopifnot(all( log2(exprs(esetPaired)[,1]) - log2(exprs(esetPaired)[,5]) == rPaired[,1] ))
+ stopifnot(all( log2(exprs(esetPaired)[,4]) - log2(exprs(esetPaired)[,6]) == rPaired[,4] ))
+ stopifnot(all( exprs(esetPaired)[,4] / exprs(esetPaired)[,6] == getRatios(esetPaired, method="paired", log2=F)[,4] ))
+ # should fail
+ stopifnot((inherits(try( getRatios(eset, method="paired"), silent = TRUE), "try-error")))
+
+
+ stopifnot(all(round(getRatios(esetPaired)[,1],2) == round(apply(rPaired[,1:2],1,median),2)))
+
+
+ cat("--- testGetRatios: PASS ALL TEST --- \n")
+
+ }
>
> testGetAllCV <- function(){
+
+ cat("--- testGetAllCV: --- \n")
+
+ cv <- getAllCV(eset)
+
+ stopifnot(all.equal(cv[1,"A"] , (sd(exprs(eset)[1,unlist(pData(eset)$condition == "A")]) / mean(exprs(eset)[1,unlist(pData(eset)$condition == "A")]))))
+ stopifnot(all.equal(cv[200,"C"] , sd(exprs(eset)[200,unlist(pData(eset)$condition == "C")]) / mean(exprs(eset)[200,unlist(pData(eset)$condition == "C")])))
+
+ cvPaired <- getAllCV(esetPaired)
+ stopifnot(all(is.na(cvPaired[,1])))
+ stopifnot(all(!is.na(cvPaired[,2])))
+ stopifnot(cvPaired[3,"A"] == (sd(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6]) / mean(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6])))
+
+ cat("--- testGetAllCV: PASS ALL TEST --- \n")
+ }
>
> testGlobalNormalize <- function(){
+
+ cat("--- testGlobalNormalize: --- \n")
+
+ globalNormFactors <- getGlobalNormFactors(eset,method="sum")
+ ### add normalization factors to ExpressionSet
+ pData(eset) <- cbind(pData(eset),globalNormFactors)
+ esetNorm <- globalNormalize(eset,globalNormFactors)
+
+ stopifnot(all.equal(as.vector(unlist(apply(exprs(esetNorm),2,sum))),as.vector(rev(unlist(apply(exprs(esetNorm),2,sum))))))
+
+ stopifnot(pData(esetNorm)$normFactor[1] == 1)
+ stopifnot(pData(esetNorm)$normFactor[2] != 1)
+
+ cat("--- testGlobalNormalize: PASS ALL TEST --- \n")
+
+ # Should generate error and stop
+ # fData(eset)$isNormAnchor <- rep(F,nrow(eset))
+ # esetNorm <- normalizeIntensities(eset)
+
+ }
>
> testGetSignalPerCondition <- function(){
+
+ cat("--- testGetSignalPerCondition: --- \n")
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"A"] <= getSignalPerCondition(eset,method="max")[,"A"]) == nrow(eset))
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"C"] <= getSignalPerCondition(eset,method="median")[,"C"]) == nrow(eset))
+ stopifnot(getSignalPerCondition(eset,method="sd")[1,2] == sd(exprs(eset)[1,3:4]))
+ cat("--- testGetSignalPerCondition: PASS ALL TEST --- \n")
+ }
>
> testBaselineIntensity <- function(){
+
+ cat("--- testBaselineIntensity: --- \n")
+
+ allInt <- as.vector(unlist(exprs(eset)))
+ bl <- round(getBaselineIntensity(allInt,promille=5),2)
+ #hist(allInt)
+ #abline(v=bl,lwd=2)
+ stopifnot(all.equal(bl[[1]] , 997.82) )
+
+
+ set.seed(1234)
+ suppressWarnings(allInt2 <- log10(rnorm(1000,1,1)))
+ bl2 <- round(getBaselineIntensity(allInt2,promille=5),2)
+ stopifnot(all.equal(-1.95,bl2[[1]]))
+ #hist(allInt2)
+ #abline(v=bl2,lwd=2)
+
+ cat("--- testBaselineIntensity: PASS ALL TEST --- \n")
+
+ }
>
> testRollUp <- function(){
+
+ cat(" --- testRollUp --- \n")
+
+ rollUpEset1 <- rollUp(eset,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$proteinName ) ) == nrow(rollUpEset1))
+
+ rollUpEset2 <- rollUp(eset ,featureDataColumnName= c("ptm"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset2))
+
+ rollUpEset3 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("ptm"), method=c("mean"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset3))
+
+ #print(exprs(rollUpEset2))
+
+ stopifnot(all.equal(sum(exprs(rollUpEset2)),sum(exprs(rollUpEset1)))) ### test sum
+ stopifnot(sum(exprs(rollUpEset1)) != sum(exprs(rollUpEset3))) ### test mean
+
+ rollUpEset4 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))
+ stopifnot(sum(exprs(rollUpEset3)) != sum(exprs(rollUpEset4)) ) ### test top 3
+
+ cat(" --- testRollUp: PASS ALL TEST --- \n")
+
+ # progenesisFeatureCsvFile3 <- "/Users/ahrnee-adm/dev/R/workspace/SafeQuant/inst/testData/2014/peptides2.csv"
+ # d <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile3,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile3))
+ # system.time(e <- rollUp(d, method="sum", isProgressBar=T, featureDataColumnName= c("peptide")))
+ # system.time(e <- rollUpDT(d, method="sum", featureDataColumnName= c("peptide")))
+ #
+ esetTmp <- parseProgenesisPeptideMeasurementCsv(progenesisPeptideMeasurementCsvFile1,expDesign= getExpDesignProgenesisCsv(progenesisPeptideMeasurementCsvFile1))
+
+ fData(esetTmp)
+
+ rollUpEsetProteinAllAccessions <- rollUp(esetTmp,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot(fData(rollUpEsetProteinAllAccessions)$allAccessionsTMP[68] == "sp|E9PAV3|NACAM_HUMAN;sp|Q9BZK3|NACP1_HUMAN")
+
+ }
>
> testTopX <- function(){
+
+ cat(" --- testTopX --- \n")
+
+ entryData1 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,5),ncol=4)))
+ rownames(entryData1) <- paste("peptide",1:nrow(entryData1),sep="_")
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 5
+ stopifnot(all.equal(rep(10/3,3) , as.vector(unlist(getTopX(entryData1))) ))
+
+ entryData2 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,NA),ncol=4)))
+ rownames(entryData2) <- paste("peptide",1:nrow(entryData2),sep="_")
+
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 NA
+ stopifnot(all.equal(c(4,4,3) , as.vector(unlist(getTopX(entryData2,topX=2)))))
+
+ # 1 row
+ stopifnot(all.equal(rep(1,3),as.vector(unlist(getTopX(entryData1[1,])))))
+
+ # 1 col
+ stopifnot(all.equal(getTopX(entryData1)[[1]],getTopX(entryData1[,1])))
+
+ top1 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top1"))),1,sum)
+ top3 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))),1,sum)
+ meanInt <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("mean"))),1,sum)
+
+ stopifnot(sum(top1 >= top3 ) == length(top3))
+ stopifnot(sum(top1) > sum(top3))
+ stopifnot(sum(top1) > sum(meanInt))
+ stopifnot(all.equal(sum(top3),sum(meanInt)))
+
+ cat(" --- testTopX: PASS ALL TEST --- \n")
+
+ }
>
> testGetIBAQEset <- function(){
+
+ cat(" --- testGetIBAQEset --- \n")
+
+ # read protein fasta
+ proteinDB <- read.fasta(fastaFile,seqtype = "AA",as.string = TRUE, set.attributes = FALSE)
+
+ iBaqEset <- getIBAQEset(eset,proteinDB=proteinDB)
+ stopifnot(round(exprs(iBaqEset))[1,1] == 125)
+ stopifnot(round(exprs(iBaqEset))[2,2] == 38)
+
+ cat(" --- testGetIBAQEset: PASS ALL TEST --- \n")
+ }
>
>
> testGetLoocvFoldError <- function(){
+
+ cat(" --- testGetLoocvFoldError --- \n")
+ #plotCalibrationCurve(fit)
+ stopifnot( round(sum(getLoocvFoldError(absEstSimData))) == -8)
+ cat(" --- testGetLoocvFoldError: PASS ALL TEST --- \n")
+ }
>
> testSqNormalize <- function(){
+
+ cat(" --- testSqNormalize --- \n")
+
+ stopifnot(nrow(sqNormalize(eset, method = "global")) == 900)
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ stopifnot(nrow(sqNormalize(esetTmp, method = "rt")) == 496)
+
+ cat(" --- testSqNormalize: PASS ALL TEST --- \n")
+ }
>
>
> testRtNormalize <- function(){
+
+
+ cat(" --- testRTNormalize --- \n")
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ rtNormFactors <- getRTNormFactors(esetTmp, minFeaturesPerBin=100)
+ stopifnot(nrow(rtNormalize(esetTmp,rtNormFactors)) == 97)
+
+ # Stop if rtNormFactors doesn't cover all retention times.
+ #rtNormalize(esetTmp,rtNormFactors[1:2,])
+
+ cat(" --- testRTNormalize: PASS ALL TEST --- \n")
+ }
>
> testRemoveOutliers <- function(){
+
+ cat(" --- testRemoveOutliers --- \n")
+ set.seed(1234)
+ stopifnot(sum(is.na(removeOutliers(c(-10, rnorm(100), 10)))) == 2)
+ cat(" --- testRemoveOutliers: PASS ALL TEST --- \n")
+ }
>
> testPerFeatureNormalization <- function(){
+
+ cat(" --- testPerFeatureNormalization: --- \n")
+
+ normFactors <- exprs(eset)[1:10,1:3]
+ colnames(normFactors) <- c("A","B","C")
+ rownames(normFactors) <- fData(eset)[1:10,]$proteinName
+ normFactors[is.finite(normFactors)] <- 1
+ eNorm <- perFeatureNormalization(eset,normFactors)
+
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,2] , (exprs(eset)[1,2]-1)))
+ stopifnot(all.equal(exprs(eNorm)[13,2] , (exprs(eset)[13,2])))
+
+ normFactors[,2] <- 200
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,3] , (exprs(eset)[1,3]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,4] , (exprs(eset)[1,4]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,5] , (exprs(eset)[1,5]-1)))
+
+ normFactors[,3] <- 0
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,5] , exprs(eset)[1,5]))
+ stopifnot(all.equal(exprs(eNorm)[2,6] , exprs(eset)[2,6]))
+
+ normFactors[3,] <- 1000
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ # re-order normFactors columns
+ eNorm <- perFeatureNormalization(eset,normFactors[,rev(colnames(normFactors))])
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ cat(" --- testPerFeatureNormalization: PASS ALL TEST --- \n")
+
+ #coveredPeptideSel <- fData(eset)$proteinName %in% rownames(normFactors)
+ #exprs(eset)[coveredPeptideSel,] <- exprs(eset)[coveredPeptideSel, ] - normFactors[as.character(fData(eset)[coveredPeptideSel,]$proteinName),pData(eset)$condition]
+
+ }
>
>
> testStandardise <- function(){
+
+ cat(" --- testStandardise: --- \n")
+
+ d <- data.frame(rnorm(10000,5,20), rnorm(10000,10,10))
+ dStd <- standardise(d[,1])
+
+ stopifnot(round(mean(dStd)) == 0 )
+ stopifnot(round(sd(dStd)) == 1 )
+
+ dStd <- standardise(d)
+ stopifnot(round(apply(dStd,2,mean)[1]) == 0)
+ stopifnot(round(apply(dStd,2,sd)[1]) == 1)
+
+ cat(" --- testStandardise: PASS ALL TEST --- \n")
+
+ }
>
> testGetMaxIndex <-function(){
+
+ cat(" --- testGetMaxIndex: --- \n")
+ d <- data.frame(s=c(NA,NA,NA,NA,1,1:4),lab=sort(rep(c("A","B","C"),3)))
+ DT <- data.table(d)
+ setkey(DT,lab)
+
+
+ stopifnot(all.equal(c(1,5,9) , DT[, .I[getMaxIndex(s)], by=lab ]$V1 ))
+ cat(" --- testGetMaxIndex: PASS ALL TEST --- \n")
+
+ }
>
> testCreatePairedExpDesign <- function(){
+
+ cat(" --- testCreatePairedExpDesign: --- \n")
+ stopifnot(all( pData(createPairedExpDesign(eset))$subject == as.factor(rep(1:2,3))))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:3]), silent = TRUE), "try-error")))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:4]), silent = TRUE), "ExpressionSet")))
+ cat(" --- testCreatePairedExpDesign: PASS ALL TEST --- \n")
+
+ }
>
> ### TEST FUNCTIONS END
>
> #### TESTS
> #testGetRatios()
> #testGetAllEBayes()
> #testGetSignalPerCondition()
> #testGetRatios()
>
> if(T){
+ testCreateExpressionDataset()
+ testGetAllEBayes()
+ testGetRatios()
+ testGetAllCV()
+ testGlobalNormalize()
+ #testNormalise()
+ testRtNormalize()
+
+ testBaselineIntensity()
+ testRollUp()
+ testTopX()
+
+ testGetLoocvFoldError()
+
+ testRemoveOutliers()
+ testPerFeatureNormalization()
+ testStandardise()
+ testGetMaxIndex()
+
+ testGetIBAQEset()
+
+ testCreatePairedExpDesign()
+
+ }
--- testCreateExpressionDataset: ---
Error in testCreateExpressionDataset() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testCreateExpressionDataset -> stopifnot
Execution halted
Running the tests in ‘tests/testUserOptions.R’ failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
>
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testExpDesignTagToExpDesign <- function(){
+
+ cat("--- testExpDesignTagToExpDesign: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+
+ expDesignString1 <- "1,2,3:4,5,6"
+
+ # 6-plex default: 1,2,3:4,5,6
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 1 TRUE
+ #3 Condition 1 TRUE
+ #4 Condition 2 FALSE
+ #5 Condition 2 FALSE
+ #6 Condition 2 FALSE
+
+
+ expDesign <- data.frame(condition=paste("Condition",sort(rep(c(1,2),3))),isControl=sort(rep(c(T,F),3),decreasing=T) )
+
+ expDesign1 <- expDesignTagToExpDesign(expDesignString1, expDesign)
+
+ stopifnot(nrow(expDesign1) == 6 )
+ stopifnot(length(unique(expDesign1$condition)) == 2 )
+ stopifnot(sum(expDesign1$isControl) == 3 )
+
+ expDesignString2 <- "1,4,7,10:2,5,8:3,6,9"
+
+ # 10-plex default is "1,4,7,10:2,5,8:3,6,9"
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 2 FALSE
+ #3 Condition 3 FALSE
+ #4 Condition 1 TRUE
+ #5 Condition 2 FALSE
+ #6 Condition 3 FALSE
+ #7 Condition 1 TRUE
+ #8 Condition 2 FALSE
+ #9 Condition 3 FALSE
+ #10 Condition 1 TRUE
+
+ expDesign <- data.frame(condition=paste("Condition",c(1,2,3,1,2,3,1,2,3,1)),isControl=c(T,F,F,T,F,F,T,F,F,T) )
+ expDesign2 <- expDesignTagToExpDesign(expDesignString2, expDesign)
+ stopifnot(nrow(expDesign2) == 10 )
+ stopifnot(length(unique(expDesign2$condition)) == 3 )
+ stopifnot(sum(expDesign2$isControl) == 4 )
+
+ ### condition name assignment when mixing runs from different conditions
+ expDesign <- data.frame(condition=paste("foo",c(1,1,1,2,2,3,3)),isControl=c(F,F,F,T,T,F,F) )
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5:6",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1:4,6:5",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1,2,4",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("2",expDesign)$condition)))
+ stopifnot( length(unique(expDesignTagToExpDesign("1:2:3:4:5:6",expDesign)$condition)) == 6)
+
+ cat("--- testExpDesignTagToExpDesign: PASS ALL TEST --- \n")
+
+ }
>
>
> ### TEST FUNCTIONS END
>
> ### TESTS
> testExpDesignTagToExpDesign()
--- testExpDesignTagToExpDesign: ---
Error in testExpDesignTagToExpDesign() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testExpDesignTagToExpDesign -> stopifnot
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc
Version: 2.3.1
Check: tests
Result: ERROR
Running 'initTestSession.R' [18s]
Running 'runAllTest.R' [1s]
Running 'testExpressionAnalysis.R' [19s]
Running 'testGraphics.R' [28s]
Running 'testIdentificationAnalysis.R' [20s]
Running 'testParser.R' [21s]
Running 'testSafeQuantAnalysis.R' [27s]
Running 'testTMT.R' [19s]
Running 'testUserOptions.R' [19s]
Running the tests in 'tests/testExpressionAnalysis.R' failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testCreateExpressionDataset <- function(){
+
+ cat("--- testCreateExpressionDataset: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+ cat("--- testCreateExpressionDataset: PASS ALL TEST --- \n")
+
+ }
>
>
> testGetAllEBayes <- function(){
+
+
+ cat("--- testGetAllEBayes: --- \n")
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ pAdj <- getAllEBayes(eset, adjust=T)
+
+ stopifnot( mean(pAdj[,"A"]) > mean(p[,"A"]) )
+
+ ### paired desgn
+ esetNonPaired <- esetPaired
+ pData(esetNonPaired) <- pData(esetPaired)[,1:2]
+
+ pValPaired <- getAllEBayes(esetPaired,adjust=F,method=c("all"))
+ pValPairedPairwise <- getAllEBayes(esetPaired,adjust=F,method=c("pairwise"))
+
+ pValNonPaired <- getAllEBayes(esetNonPaired,adjust=F,method=c("all"))
+ pValNonPairedPairwise <- getAllEBayes(esetNonPaired,adjust=F,method=c("pairwise"))
+ stopifnot(all(apply(pValPaired,2,sum) < apply(pValNonPaired,2,sum)))
+ stopifnot(all(apply(pValPairedPairwise,2,sum) < apply(pValNonPairedPairwise,2,sum)))
+
+ # adjustment filter
+
+ adjustfilter <- data.frame(rep(T,nrow(eset)),rep(T,nrow(eset)) )
+ adjustfilter[1,1] <- F
+ adjustfilter[2,2] <- F
+
+ pTmp <- getAllEBayes(eset,adjust=T, adjustFilter=adjustfilter)
+ stopifnot(p[1,1] == pTmp[1,1])
+ stopifnot(p[2,2] == pTmp[2,2])
+ stopifnot(is.na(pTmp[3,2]))
+ cat("--- testGetAllEBayes: PASS ALL TEST --- \n")
+
+ # Question: limma multiple groups comparison produces different pvalue comparing with two group comparsion
+ # https://support.bioconductor.org/p/44216/
+ # https://support.bioconductor.org/p/60556/
+ }
>
> testGetRatios <- function(){
+
+ cat("--- testGetRatios: --- \n")
+
+ r <- getRatios(eset)
+
+ exprs(eset)[1,c(5:6,1:2)]
+ # C_rep_1 C_rep_2 A_rep_1 A_rep_2
+ # 9.963852 9.966003 9.965568 9.967214
+
+ ## NOTE: C is control
+ stopifnot(all.equal(r[1,1],median(log2(exprs(eset))[1,1:2]) - median(log2(exprs(eset))[1,5:6]) ) )
+
+ stopifnot(mean(r[,"A"]) < mean(r[,"B"]))
+ stopifnot(all.equal(r,getRatios(eset,method="mean")))
+ r <- getRatios(eset)
+ stopifnot(all.equal(mean(r[,"B"]),mean(r[,"B"])))
+
+ stopifnot(all(round(apply(getRatios(esetPaired, log2=F),2,mean),1) == c(1.5,1.2)))
+ stopifnot(ncol(r) == 2)
+
+ rPaired <- getRatios(esetPaired, method="paired")
+ stopifnot(ncol(rPaired) == 4)
+ stopifnot(all( log2(exprs(esetPaired)[,1]) - log2(exprs(esetPaired)[,5]) == rPaired[,1] ))
+ stopifnot(all( log2(exprs(esetPaired)[,4]) - log2(exprs(esetPaired)[,6]) == rPaired[,4] ))
+ stopifnot(all( exprs(esetPaired)[,4] / exprs(esetPaired)[,6] == getRatios(esetPaired, method="paired", log2=F)[,4] ))
+ # should fail
+ stopifnot((inherits(try( getRatios(eset, method="paired"), silent = TRUE), "try-error")))
+
+
+ stopifnot(all(round(getRatios(esetPaired)[,1],2) == round(apply(rPaired[,1:2],1,median),2)))
+
+
+ cat("--- testGetRatios: PASS ALL TEST --- \n")
+
+ }
>
> testGetAllCV <- function(){
+
+ cat("--- testGetAllCV: --- \n")
+
+ cv <- getAllCV(eset)
+
+ stopifnot(all.equal(cv[1,"A"] , (sd(exprs(eset)[1,unlist(pData(eset)$condition == "A")]) / mean(exprs(eset)[1,unlist(pData(eset)$condition == "A")]))))
+ stopifnot(all.equal(cv[200,"C"] , sd(exprs(eset)[200,unlist(pData(eset)$condition == "C")]) / mean(exprs(eset)[200,unlist(pData(eset)$condition == "C")])))
+
+ cvPaired <- getAllCV(esetPaired)
+ stopifnot(all(is.na(cvPaired[,1])))
+ stopifnot(all(!is.na(cvPaired[,2])))
+ stopifnot(cvPaired[3,"A"] == (sd(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6]) / mean(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6])))
+
+ cat("--- testGetAllCV: PASS ALL TEST --- \n")
+ }
>
> testGlobalNormalize <- function(){
+
+ cat("--- testGlobalNormalize: --- \n")
+
+ globalNormFactors <- getGlobalNormFactors(eset,method="sum")
+ ### add normalization factors to ExpressionSet
+ pData(eset) <- cbind(pData(eset),globalNormFactors)
+ esetNorm <- globalNormalize(eset,globalNormFactors)
+
+ stopifnot(all.equal(as.vector(unlist(apply(exprs(esetNorm),2,sum))),as.vector(rev(unlist(apply(exprs(esetNorm),2,sum))))))
+
+ stopifnot(pData(esetNorm)$normFactor[1] == 1)
+ stopifnot(pData(esetNorm)$normFactor[2] != 1)
+
+ cat("--- testGlobalNormalize: PASS ALL TEST --- \n")
+
+ # Should generate error and stop
+ # fData(eset)$isNormAnchor <- rep(F,nrow(eset))
+ # esetNorm <- normalizeIntensities(eset)
+
+ }
>
> testGetSignalPerCondition <- function(){
+
+ cat("--- testGetSignalPerCondition: --- \n")
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"A"] <= getSignalPerCondition(eset,method="max")[,"A"]) == nrow(eset))
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"C"] <= getSignalPerCondition(eset,method="median")[,"C"]) == nrow(eset))
+ stopifnot(getSignalPerCondition(eset,method="sd")[1,2] == sd(exprs(eset)[1,3:4]))
+ cat("--- testGetSignalPerCondition: PASS ALL TEST --- \n")
+ }
>
> testBaselineIntensity <- function(){
+
+ cat("--- testBaselineIntensity: --- \n")
+
+ allInt <- as.vector(unlist(exprs(eset)))
+ bl <- round(getBaselineIntensity(allInt,promille=5),2)
+ #hist(allInt)
+ #abline(v=bl,lwd=2)
+ stopifnot(all.equal(bl[[1]] , 997.82) )
+
+
+ set.seed(1234)
+ suppressWarnings(allInt2 <- log10(rnorm(1000,1,1)))
+ bl2 <- round(getBaselineIntensity(allInt2,promille=5),2)
+ stopifnot(all.equal(-1.95,bl2[[1]]))
+ #hist(allInt2)
+ #abline(v=bl2,lwd=2)
+
+ cat("--- testBaselineIntensity: PASS ALL TEST --- \n")
+
+ }
>
> testRollUp <- function(){
+
+ cat(" --- testRollUp --- \n")
+
+ rollUpEset1 <- rollUp(eset,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$proteinName ) ) == nrow(rollUpEset1))
+
+ rollUpEset2 <- rollUp(eset ,featureDataColumnName= c("ptm"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset2))
+
+ rollUpEset3 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("ptm"), method=c("mean"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset3))
+
+ #print(exprs(rollUpEset2))
+
+ stopifnot(all.equal(sum(exprs(rollUpEset2)),sum(exprs(rollUpEset1)))) ### test sum
+ stopifnot(sum(exprs(rollUpEset1)) != sum(exprs(rollUpEset3))) ### test mean
+
+ rollUpEset4 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))
+ stopifnot(sum(exprs(rollUpEset3)) != sum(exprs(rollUpEset4)) ) ### test top 3
+
+ cat(" --- testRollUp: PASS ALL TEST --- \n")
+
+ # progenesisFeatureCsvFile3 <- "/Users/ahrnee-adm/dev/R/workspace/SafeQuant/inst/testData/2014/peptides2.csv"
+ # d <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile3,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile3))
+ # system.time(e <- rollUp(d, method="sum", isProgressBar=T, featureDataColumnName= c("peptide")))
+ # system.time(e <- rollUpDT(d, method="sum", featureDataColumnName= c("peptide")))
+ #
+ esetTmp <- parseProgenesisPeptideMeasurementCsv(progenesisPeptideMeasurementCsvFile1,expDesign= getExpDesignProgenesisCsv(progenesisPeptideMeasurementCsvFile1))
+
+ fData(esetTmp)
+
+ rollUpEsetProteinAllAccessions <- rollUp(esetTmp,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot(fData(rollUpEsetProteinAllAccessions)$allAccessionsTMP[68] == "sp|E9PAV3|NACAM_HUMAN;sp|Q9BZK3|NACP1_HUMAN")
+
+ }
>
> testTopX <- function(){
+
+ cat(" --- testTopX --- \n")
+
+ entryData1 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,5),ncol=4)))
+ rownames(entryData1) <- paste("peptide",1:nrow(entryData1),sep="_")
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 5
+ stopifnot(all.equal(rep(10/3,3) , as.vector(unlist(getTopX(entryData1))) ))
+
+ entryData2 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,NA),ncol=4)))
+ rownames(entryData2) <- paste("peptide",1:nrow(entryData2),sep="_")
+
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 NA
+ stopifnot(all.equal(c(4,4,3) , as.vector(unlist(getTopX(entryData2,topX=2)))))
+
+ # 1 row
+ stopifnot(all.equal(rep(1,3),as.vector(unlist(getTopX(entryData1[1,])))))
+
+ # 1 col
+ stopifnot(all.equal(getTopX(entryData1)[[1]],getTopX(entryData1[,1])))
+
+ top1 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top1"))),1,sum)
+ top3 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))),1,sum)
+ meanInt <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("mean"))),1,sum)
+
+ stopifnot(sum(top1 >= top3 ) == length(top3))
+ stopifnot(sum(top1) > sum(top3))
+ stopifnot(sum(top1) > sum(meanInt))
+ stopifnot(all.equal(sum(top3),sum(meanInt)))
+
+ cat(" --- testTopX: PASS ALL TEST --- \n")
+
+ }
>
> testGetIBAQEset <- function(){
+
+ cat(" --- testGetIBAQEset --- \n")
+
+ # read protein fasta
+ proteinDB <- read.fasta(fastaFile,seqtype = "AA",as.string = TRUE, set.attributes = FALSE)
+
+ iBaqEset <- getIBAQEset(eset,proteinDB=proteinDB)
+ stopifnot(round(exprs(iBaqEset))[1,1] == 125)
+ stopifnot(round(exprs(iBaqEset))[2,2] == 38)
+
+ cat(" --- testGetIBAQEset: PASS ALL TEST --- \n")
+ }
>
>
> testGetLoocvFoldError <- function(){
+
+ cat(" --- testGetLoocvFoldError --- \n")
+ #plotCalibrationCurve(fit)
+ stopifnot( round(sum(getLoocvFoldError(absEstSimData))) == -8)
+ cat(" --- testGetLoocvFoldError: PASS ALL TEST --- \n")
+ }
>
> testSqNormalize <- function(){
+
+ cat(" --- testSqNormalize --- \n")
+
+ stopifnot(nrow(sqNormalize(eset, method = "global")) == 900)
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ stopifnot(nrow(sqNormalize(esetTmp, method = "rt")) == 496)
+
+ cat(" --- testSqNormalize: PASS ALL TEST --- \n")
+ }
>
>
> testRtNormalize <- function(){
+
+
+ cat(" --- testRTNormalize --- \n")
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ rtNormFactors <- getRTNormFactors(esetTmp, minFeaturesPerBin=100)
+ stopifnot(nrow(rtNormalize(esetTmp,rtNormFactors)) == 97)
+
+ # Stop if rtNormFactors doesn't cover all retention times.
+ #rtNormalize(esetTmp,rtNormFactors[1:2,])
+
+ cat(" --- testRTNormalize: PASS ALL TEST --- \n")
+ }
>
> testRemoveOutliers <- function(){
+
+ cat(" --- testRemoveOutliers --- \n")
+ set.seed(1234)
+ stopifnot(sum(is.na(removeOutliers(c(-10, rnorm(100), 10)))) == 2)
+ cat(" --- testRemoveOutliers: PASS ALL TEST --- \n")
+ }
>
> testPerFeatureNormalization <- function(){
+
+ cat(" --- testPerFeatureNormalization: --- \n")
+
+ normFactors <- exprs(eset)[1:10,1:3]
+ colnames(normFactors) <- c("A","B","C")
+ rownames(normFactors) <- fData(eset)[1:10,]$proteinName
+ normFactors[is.finite(normFactors)] <- 1
+ eNorm <- perFeatureNormalization(eset,normFactors)
+
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,2] , (exprs(eset)[1,2]-1)))
+ stopifnot(all.equal(exprs(eNorm)[13,2] , (exprs(eset)[13,2])))
+
+ normFactors[,2] <- 200
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,3] , (exprs(eset)[1,3]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,4] , (exprs(eset)[1,4]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,5] , (exprs(eset)[1,5]-1)))
+
+ normFactors[,3] <- 0
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,5] , exprs(eset)[1,5]))
+ stopifnot(all.equal(exprs(eNorm)[2,6] , exprs(eset)[2,6]))
+
+ normFactors[3,] <- 1000
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ # re-order normFactors columns
+ eNorm <- perFeatureNormalization(eset,normFactors[,rev(colnames(normFactors))])
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ cat(" --- testPerFeatureNormalization: PASS ALL TEST --- \n")
+
+ #coveredPeptideSel <- fData(eset)$proteinName %in% rownames(normFactors)
+ #exprs(eset)[coveredPeptideSel,] <- exprs(eset)[coveredPeptideSel, ] - normFactors[as.character(fData(eset)[coveredPeptideSel,]$proteinName),pData(eset)$condition]
+
+ }
>
>
> testStandardise <- function(){
+
+ cat(" --- testStandardise: --- \n")
+
+ d <- data.frame(rnorm(10000,5,20), rnorm(10000,10,10))
+ dStd <- standardise(d[,1])
+
+ stopifnot(round(mean(dStd)) == 0 )
+ stopifnot(round(sd(dStd)) == 1 )
+
+ dStd <- standardise(d)
+ stopifnot(round(apply(dStd,2,mean)[1]) == 0)
+ stopifnot(round(apply(dStd,2,sd)[1]) == 1)
+
+ cat(" --- testStandardise: PASS ALL TEST --- \n")
+
+ }
>
> testGetMaxIndex <-function(){
+
+ cat(" --- testGetMaxIndex: --- \n")
+ d <- data.frame(s=c(NA,NA,NA,NA,1,1:4),lab=sort(rep(c("A","B","C"),3)))
+ DT <- data.table(d)
+ setkey(DT,lab)
+
+
+ stopifnot(all.equal(c(1,5,9) , DT[, .I[getMaxIndex(s)], by=lab ]$V1 ))
+ cat(" --- testGetMaxIndex: PASS ALL TEST --- \n")
+
+ }
>
> testCreatePairedExpDesign <- function(){
+
+ cat(" --- testCreatePairedExpDesign: --- \n")
+ stopifnot(all( pData(createPairedExpDesign(eset))$subject == as.factor(rep(1:2,3))))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:3]), silent = TRUE), "try-error")))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:4]), silent = TRUE), "ExpressionSet")))
+ cat(" --- testCreatePairedExpDesign: PASS ALL TEST --- \n")
+
+ }
>
> ### TEST FUNCTIONS END
>
> #### TESTS
> #testGetRatios()
> #testGetAllEBayes()
> #testGetSignalPerCondition()
> #testGetRatios()
>
> if(T){
+ testCreateExpressionDataset()
+ testGetAllEBayes()
+ testGetRatios()
+ testGetAllCV()
+ testGlobalNormalize()
+ #testNormalise()
+ testRtNormalize()
+
+ testBaselineIntensity()
+ testRollUp()
+ testTopX()
+
+ testGetLoocvFoldError()
+
+ testRemoveOutliers()
+ testPerFeatureNormalization()
+ testStandardise()
+ testGetMaxIndex()
+
+ testGetIBAQEset()
+
+ testCreatePairedExpDesign()
+
+ }
--- testCreateExpressionDataset: ---
Error in testCreateExpressionDataset() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testCreateExpressionDataset -> stopifnot
Execution halted
Running the tests in 'tests/testUserOptions.R' failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
>
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testExpDesignTagToExpDesign <- function(){
+
+ cat("--- testExpDesignTagToExpDesign: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+
+ expDesignString1 <- "1,2,3:4,5,6"
+
+ # 6-plex default: 1,2,3:4,5,6
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 1 TRUE
+ #3 Condition 1 TRUE
+ #4 Condition 2 FALSE
+ #5 Condition 2 FALSE
+ #6 Condition 2 FALSE
+
+
+ expDesign <- data.frame(condition=paste("Condition",sort(rep(c(1,2),3))),isControl=sort(rep(c(T,F),3),decreasing=T) )
+
+ expDesign1 <- expDesignTagToExpDesign(expDesignString1, expDesign)
+
+ stopifnot(nrow(expDesign1) == 6 )
+ stopifnot(length(unique(expDesign1$condition)) == 2 )
+ stopifnot(sum(expDesign1$isControl) == 3 )
+
+ expDesignString2 <- "1,4,7,10:2,5,8:3,6,9"
+
+ # 10-plex default is "1,4,7,10:2,5,8:3,6,9"
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 2 FALSE
+ #3 Condition 3 FALSE
+ #4 Condition 1 TRUE
+ #5 Condition 2 FALSE
+ #6 Condition 3 FALSE
+ #7 Condition 1 TRUE
+ #8 Condition 2 FALSE
+ #9 Condition 3 FALSE
+ #10 Condition 1 TRUE
+
+ expDesign <- data.frame(condition=paste("Condition",c(1,2,3,1,2,3,1,2,3,1)),isControl=c(T,F,F,T,F,F,T,F,F,T) )
+ expDesign2 <- expDesignTagToExpDesign(expDesignString2, expDesign)
+ stopifnot(nrow(expDesign2) == 10 )
+ stopifnot(length(unique(expDesign2$condition)) == 3 )
+ stopifnot(sum(expDesign2$isControl) == 4 )
+
+ ### condition name assignment when mixing runs from different conditions
+ expDesign <- data.frame(condition=paste("foo",c(1,1,1,2,2,3,3)),isControl=c(F,F,F,T,T,F,F) )
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5:6",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1:4,6:5",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1,2,4",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("2",expDesign)$condition)))
+ stopifnot( length(unique(expDesignTagToExpDesign("1:2:3:4:5:6",expDesign)$condition)) == 6)
+
+ cat("--- testExpDesignTagToExpDesign: PASS ALL TEST --- \n")
+
+ }
>
>
> ### TEST FUNCTIONS END
>
> ### TESTS
> testExpDesignTagToExpDesign()
--- testExpDesignTagToExpDesign: ---
Error in testExpDesignTagToExpDesign() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testExpDesignTagToExpDesign -> stopifnot
Execution halted
Flavor: r-devel-windows-ix86+x86_64
Version: 2.3.1
Check: tests
Result: ERROR
Running 'initTestSession.R' [13s]
Running 'runAllTest.R' [0s]
Running 'testExpressionAnalysis.R' [12s]
Running 'testGraphics.R' [21s]
Running 'testIdentificationAnalysis.R' [13s]
Running 'testParser.R' [18s]
Running 'testSafeQuantAnalysis.R' [20s]
Running 'testTMT.R' [12s]
Running 'testUserOptions.R' [13s]
Running the tests in 'tests/testExpressionAnalysis.R' failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testCreateExpressionDataset <- function(){
+
+ cat("--- testCreateExpressionDataset: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+ cat("--- testCreateExpressionDataset: PASS ALL TEST --- \n")
+
+ }
>
>
> testGetAllEBayes <- function(){
+
+
+ cat("--- testGetAllEBayes: --- \n")
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ pAdj <- getAllEBayes(eset, adjust=T)
+
+ stopifnot( mean(pAdj[,"A"]) > mean(p[,"A"]) )
+
+ ### paired desgn
+ esetNonPaired <- esetPaired
+ pData(esetNonPaired) <- pData(esetPaired)[,1:2]
+
+ pValPaired <- getAllEBayes(esetPaired,adjust=F,method=c("all"))
+ pValPairedPairwise <- getAllEBayes(esetPaired,adjust=F,method=c("pairwise"))
+
+ pValNonPaired <- getAllEBayes(esetNonPaired,adjust=F,method=c("all"))
+ pValNonPairedPairwise <- getAllEBayes(esetNonPaired,adjust=F,method=c("pairwise"))
+ stopifnot(all(apply(pValPaired,2,sum) < apply(pValNonPaired,2,sum)))
+ stopifnot(all(apply(pValPairedPairwise,2,sum) < apply(pValNonPairedPairwise,2,sum)))
+
+ # adjustment filter
+
+ adjustfilter <- data.frame(rep(T,nrow(eset)),rep(T,nrow(eset)) )
+ adjustfilter[1,1] <- F
+ adjustfilter[2,2] <- F
+
+ pTmp <- getAllEBayes(eset,adjust=T, adjustFilter=adjustfilter)
+ stopifnot(p[1,1] == pTmp[1,1])
+ stopifnot(p[2,2] == pTmp[2,2])
+ stopifnot(is.na(pTmp[3,2]))
+ cat("--- testGetAllEBayes: PASS ALL TEST --- \n")
+
+ # Question: limma multiple groups comparison produces different pvalue comparing with two group comparsion
+ # https://support.bioconductor.org/p/44216/
+ # https://support.bioconductor.org/p/60556/
+ }
>
> testGetRatios <- function(){
+
+ cat("--- testGetRatios: --- \n")
+
+ r <- getRatios(eset)
+
+ exprs(eset)[1,c(5:6,1:2)]
+ # C_rep_1 C_rep_2 A_rep_1 A_rep_2
+ # 9.963852 9.966003 9.965568 9.967214
+
+ ## NOTE: C is control
+ stopifnot(all.equal(r[1,1],median(log2(exprs(eset))[1,1:2]) - median(log2(exprs(eset))[1,5:6]) ) )
+
+ stopifnot(mean(r[,"A"]) < mean(r[,"B"]))
+ stopifnot(all.equal(r,getRatios(eset,method="mean")))
+ r <- getRatios(eset)
+ stopifnot(all.equal(mean(r[,"B"]),mean(r[,"B"])))
+
+ stopifnot(all(round(apply(getRatios(esetPaired, log2=F),2,mean),1) == c(1.5,1.2)))
+ stopifnot(ncol(r) == 2)
+
+ rPaired <- getRatios(esetPaired, method="paired")
+ stopifnot(ncol(rPaired) == 4)
+ stopifnot(all( log2(exprs(esetPaired)[,1]) - log2(exprs(esetPaired)[,5]) == rPaired[,1] ))
+ stopifnot(all( log2(exprs(esetPaired)[,4]) - log2(exprs(esetPaired)[,6]) == rPaired[,4] ))
+ stopifnot(all( exprs(esetPaired)[,4] / exprs(esetPaired)[,6] == getRatios(esetPaired, method="paired", log2=F)[,4] ))
+ # should fail
+ stopifnot((inherits(try( getRatios(eset, method="paired"), silent = TRUE), "try-error")))
+
+
+ stopifnot(all(round(getRatios(esetPaired)[,1],2) == round(apply(rPaired[,1:2],1,median),2)))
+
+
+ cat("--- testGetRatios: PASS ALL TEST --- \n")
+
+ }
>
> testGetAllCV <- function(){
+
+ cat("--- testGetAllCV: --- \n")
+
+ cv <- getAllCV(eset)
+
+ stopifnot(all.equal(cv[1,"A"] , (sd(exprs(eset)[1,unlist(pData(eset)$condition == "A")]) / mean(exprs(eset)[1,unlist(pData(eset)$condition == "A")]))))
+ stopifnot(all.equal(cv[200,"C"] , sd(exprs(eset)[200,unlist(pData(eset)$condition == "C")]) / mean(exprs(eset)[200,unlist(pData(eset)$condition == "C")])))
+
+ cvPaired <- getAllCV(esetPaired)
+ stopifnot(all(is.na(cvPaired[,1])))
+ stopifnot(all(!is.na(cvPaired[,2])))
+ stopifnot(cvPaired[3,"A"] == (sd(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6]) / mean(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6])))
+
+ cat("--- testGetAllCV: PASS ALL TEST --- \n")
+ }
>
> testGlobalNormalize <- function(){
+
+ cat("--- testGlobalNormalize: --- \n")
+
+ globalNormFactors <- getGlobalNormFactors(eset,method="sum")
+ ### add normalization factors to ExpressionSet
+ pData(eset) <- cbind(pData(eset),globalNormFactors)
+ esetNorm <- globalNormalize(eset,globalNormFactors)
+
+ stopifnot(all.equal(as.vector(unlist(apply(exprs(esetNorm),2,sum))),as.vector(rev(unlist(apply(exprs(esetNorm),2,sum))))))
+
+ stopifnot(pData(esetNorm)$normFactor[1] == 1)
+ stopifnot(pData(esetNorm)$normFactor[2] != 1)
+
+ cat("--- testGlobalNormalize: PASS ALL TEST --- \n")
+
+ # Should generate error and stop
+ # fData(eset)$isNormAnchor <- rep(F,nrow(eset))
+ # esetNorm <- normalizeIntensities(eset)
+
+ }
>
> testGetSignalPerCondition <- function(){
+
+ cat("--- testGetSignalPerCondition: --- \n")
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"A"] <= getSignalPerCondition(eset,method="max")[,"A"]) == nrow(eset))
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"C"] <= getSignalPerCondition(eset,method="median")[,"C"]) == nrow(eset))
+ stopifnot(getSignalPerCondition(eset,method="sd")[1,2] == sd(exprs(eset)[1,3:4]))
+ cat("--- testGetSignalPerCondition: PASS ALL TEST --- \n")
+ }
>
> testBaselineIntensity <- function(){
+
+ cat("--- testBaselineIntensity: --- \n")
+
+ allInt <- as.vector(unlist(exprs(eset)))
+ bl <- round(getBaselineIntensity(allInt,promille=5),2)
+ #hist(allInt)
+ #abline(v=bl,lwd=2)
+ stopifnot(all.equal(bl[[1]] , 997.82) )
+
+
+ set.seed(1234)
+ suppressWarnings(allInt2 <- log10(rnorm(1000,1,1)))
+ bl2 <- round(getBaselineIntensity(allInt2,promille=5),2)
+ stopifnot(all.equal(-1.95,bl2[[1]]))
+ #hist(allInt2)
+ #abline(v=bl2,lwd=2)
+
+ cat("--- testBaselineIntensity: PASS ALL TEST --- \n")
+
+ }
>
> testRollUp <- function(){
+
+ cat(" --- testRollUp --- \n")
+
+ rollUpEset1 <- rollUp(eset,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$proteinName ) ) == nrow(rollUpEset1))
+
+ rollUpEset2 <- rollUp(eset ,featureDataColumnName= c("ptm"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset2))
+
+ rollUpEset3 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("ptm"), method=c("mean"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset3))
+
+ #print(exprs(rollUpEset2))
+
+ stopifnot(all.equal(sum(exprs(rollUpEset2)),sum(exprs(rollUpEset1)))) ### test sum
+ stopifnot(sum(exprs(rollUpEset1)) != sum(exprs(rollUpEset3))) ### test mean
+
+ rollUpEset4 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))
+ stopifnot(sum(exprs(rollUpEset3)) != sum(exprs(rollUpEset4)) ) ### test top 3
+
+ cat(" --- testRollUp: PASS ALL TEST --- \n")
+
+ # progenesisFeatureCsvFile3 <- "/Users/ahrnee-adm/dev/R/workspace/SafeQuant/inst/testData/2014/peptides2.csv"
+ # d <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile3,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile3))
+ # system.time(e <- rollUp(d, method="sum", isProgressBar=T, featureDataColumnName= c("peptide")))
+ # system.time(e <- rollUpDT(d, method="sum", featureDataColumnName= c("peptide")))
+ #
+ esetTmp <- parseProgenesisPeptideMeasurementCsv(progenesisPeptideMeasurementCsvFile1,expDesign= getExpDesignProgenesisCsv(progenesisPeptideMeasurementCsvFile1))
+
+ fData(esetTmp)
+
+ rollUpEsetProteinAllAccessions <- rollUp(esetTmp,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot(fData(rollUpEsetProteinAllAccessions)$allAccessionsTMP[68] == "sp|E9PAV3|NACAM_HUMAN;sp|Q9BZK3|NACP1_HUMAN")
+
+ }
>
> testTopX <- function(){
+
+ cat(" --- testTopX --- \n")
+
+ entryData1 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,5),ncol=4)))
+ rownames(entryData1) <- paste("peptide",1:nrow(entryData1),sep="_")
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 5
+ stopifnot(all.equal(rep(10/3,3) , as.vector(unlist(getTopX(entryData1))) ))
+
+ entryData2 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,NA),ncol=4)))
+ rownames(entryData2) <- paste("peptide",1:nrow(entryData2),sep="_")
+
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 NA
+ stopifnot(all.equal(c(4,4,3) , as.vector(unlist(getTopX(entryData2,topX=2)))))
+
+ # 1 row
+ stopifnot(all.equal(rep(1,3),as.vector(unlist(getTopX(entryData1[1,])))))
+
+ # 1 col
+ stopifnot(all.equal(getTopX(entryData1)[[1]],getTopX(entryData1[,1])))
+
+ top1 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top1"))),1,sum)
+ top3 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))),1,sum)
+ meanInt <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("mean"))),1,sum)
+
+ stopifnot(sum(top1 >= top3 ) == length(top3))
+ stopifnot(sum(top1) > sum(top3))
+ stopifnot(sum(top1) > sum(meanInt))
+ stopifnot(all.equal(sum(top3),sum(meanInt)))
+
+ cat(" --- testTopX: PASS ALL TEST --- \n")
+
+ }
>
> testGetIBAQEset <- function(){
+
+ cat(" --- testGetIBAQEset --- \n")
+
+ # read protein fasta
+ proteinDB <- read.fasta(fastaFile,seqtype = "AA",as.string = TRUE, set.attributes = FALSE)
+
+ iBaqEset <- getIBAQEset(eset,proteinDB=proteinDB)
+ stopifnot(round(exprs(iBaqEset))[1,1] == 125)
+ stopifnot(round(exprs(iBaqEset))[2,2] == 38)
+
+ cat(" --- testGetIBAQEset: PASS ALL TEST --- \n")
+ }
>
>
> testGetLoocvFoldError <- function(){
+
+ cat(" --- testGetLoocvFoldError --- \n")
+ #plotCalibrationCurve(fit)
+ stopifnot( round(sum(getLoocvFoldError(absEstSimData))) == -8)
+ cat(" --- testGetLoocvFoldError: PASS ALL TEST --- \n")
+ }
>
> testSqNormalize <- function(){
+
+ cat(" --- testSqNormalize --- \n")
+
+ stopifnot(nrow(sqNormalize(eset, method = "global")) == 900)
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ stopifnot(nrow(sqNormalize(esetTmp, method = "rt")) == 496)
+
+ cat(" --- testSqNormalize: PASS ALL TEST --- \n")
+ }
>
>
> testRtNormalize <- function(){
+
+
+ cat(" --- testRTNormalize --- \n")
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ rtNormFactors <- getRTNormFactors(esetTmp, minFeaturesPerBin=100)
+ stopifnot(nrow(rtNormalize(esetTmp,rtNormFactors)) == 97)
+
+ # Stop if rtNormFactors doesn't cover all retention times.
+ #rtNormalize(esetTmp,rtNormFactors[1:2,])
+
+ cat(" --- testRTNormalize: PASS ALL TEST --- \n")
+ }
>
> testRemoveOutliers <- function(){
+
+ cat(" --- testRemoveOutliers --- \n")
+ set.seed(1234)
+ stopifnot(sum(is.na(removeOutliers(c(-10, rnorm(100), 10)))) == 2)
+ cat(" --- testRemoveOutliers: PASS ALL TEST --- \n")
+ }
>
> testPerFeatureNormalization <- function(){
+
+ cat(" --- testPerFeatureNormalization: --- \n")
+
+ normFactors <- exprs(eset)[1:10,1:3]
+ colnames(normFactors) <- c("A","B","C")
+ rownames(normFactors) <- fData(eset)[1:10,]$proteinName
+ normFactors[is.finite(normFactors)] <- 1
+ eNorm <- perFeatureNormalization(eset,normFactors)
+
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,2] , (exprs(eset)[1,2]-1)))
+ stopifnot(all.equal(exprs(eNorm)[13,2] , (exprs(eset)[13,2])))
+
+ normFactors[,2] <- 200
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,3] , (exprs(eset)[1,3]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,4] , (exprs(eset)[1,4]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,5] , (exprs(eset)[1,5]-1)))
+
+ normFactors[,3] <- 0
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,5] , exprs(eset)[1,5]))
+ stopifnot(all.equal(exprs(eNorm)[2,6] , exprs(eset)[2,6]))
+
+ normFactors[3,] <- 1000
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ # re-order normFactors columns
+ eNorm <- perFeatureNormalization(eset,normFactors[,rev(colnames(normFactors))])
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ cat(" --- testPerFeatureNormalization: PASS ALL TEST --- \n")
+
+ #coveredPeptideSel <- fData(eset)$proteinName %in% rownames(normFactors)
+ #exprs(eset)[coveredPeptideSel,] <- exprs(eset)[coveredPeptideSel, ] - normFactors[as.character(fData(eset)[coveredPeptideSel,]$proteinName),pData(eset)$condition]
+
+ }
>
>
> testStandardise <- function(){
+
+ cat(" --- testStandardise: --- \n")
+
+ d <- data.frame(rnorm(10000,5,20), rnorm(10000,10,10))
+ dStd <- standardise(d[,1])
+
+ stopifnot(round(mean(dStd)) == 0 )
+ stopifnot(round(sd(dStd)) == 1 )
+
+ dStd <- standardise(d)
+ stopifnot(round(apply(dStd,2,mean)[1]) == 0)
+ stopifnot(round(apply(dStd,2,sd)[1]) == 1)
+
+ cat(" --- testStandardise: PASS ALL TEST --- \n")
+
+ }
>
> testGetMaxIndex <-function(){
+
+ cat(" --- testGetMaxIndex: --- \n")
+ d <- data.frame(s=c(NA,NA,NA,NA,1,1:4),lab=sort(rep(c("A","B","C"),3)))
+ DT <- data.table(d)
+ setkey(DT,lab)
+
+
+ stopifnot(all.equal(c(1,5,9) , DT[, .I[getMaxIndex(s)], by=lab ]$V1 ))
+ cat(" --- testGetMaxIndex: PASS ALL TEST --- \n")
+
+ }
>
> testCreatePairedExpDesign <- function(){
+
+ cat(" --- testCreatePairedExpDesign: --- \n")
+ stopifnot(all( pData(createPairedExpDesign(eset))$subject == as.factor(rep(1:2,3))))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:3]), silent = TRUE), "try-error")))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:4]), silent = TRUE), "ExpressionSet")))
+ cat(" --- testCreatePairedExpDesign: PASS ALL TEST --- \n")
+
+ }
>
> ### TEST FUNCTIONS END
>
> #### TESTS
> #testGetRatios()
> #testGetAllEBayes()
> #testGetSignalPerCondition()
> #testGetRatios()
>
> if(T){
+ testCreateExpressionDataset()
+ testGetAllEBayes()
+ testGetRatios()
+ testGetAllCV()
+ testGlobalNormalize()
+ #testNormalise()
+ testRtNormalize()
+
+ testBaselineIntensity()
+ testRollUp()
+ testTopX()
+
+ testGetLoocvFoldError()
+
+ testRemoveOutliers()
+ testPerFeatureNormalization()
+ testStandardise()
+ testGetMaxIndex()
+
+ testGetIBAQEset()
+
+ testCreatePairedExpDesign()
+
+ }
--- testCreateExpressionDataset: ---
Error in testCreateExpressionDataset() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testCreateExpressionDataset -> stopifnot
Execution halted
Running the tests in 'tests/testUserOptions.R' failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
>
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testExpDesignTagToExpDesign <- function(){
+
+ cat("--- testExpDesignTagToExpDesign: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+
+ expDesignString1 <- "1,2,3:4,5,6"
+
+ # 6-plex default: 1,2,3:4,5,6
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 1 TRUE
+ #3 Condition 1 TRUE
+ #4 Condition 2 FALSE
+ #5 Condition 2 FALSE
+ #6 Condition 2 FALSE
+
+
+ expDesign <- data.frame(condition=paste("Condition",sort(rep(c(1,2),3))),isControl=sort(rep(c(T,F),3),decreasing=T) )
+
+ expDesign1 <- expDesignTagToExpDesign(expDesignString1, expDesign)
+
+ stopifnot(nrow(expDesign1) == 6 )
+ stopifnot(length(unique(expDesign1$condition)) == 2 )
+ stopifnot(sum(expDesign1$isControl) == 3 )
+
+ expDesignString2 <- "1,4,7,10:2,5,8:3,6,9"
+
+ # 10-plex default is "1,4,7,10:2,5,8:3,6,9"
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 2 FALSE
+ #3 Condition 3 FALSE
+ #4 Condition 1 TRUE
+ #5 Condition 2 FALSE
+ #6 Condition 3 FALSE
+ #7 Condition 1 TRUE
+ #8 Condition 2 FALSE
+ #9 Condition 3 FALSE
+ #10 Condition 1 TRUE
+
+ expDesign <- data.frame(condition=paste("Condition",c(1,2,3,1,2,3,1,2,3,1)),isControl=c(T,F,F,T,F,F,T,F,F,T) )
+ expDesign2 <- expDesignTagToExpDesign(expDesignString2, expDesign)
+ stopifnot(nrow(expDesign2) == 10 )
+ stopifnot(length(unique(expDesign2$condition)) == 3 )
+ stopifnot(sum(expDesign2$isControl) == 4 )
+
+ ### condition name assignment when mixing runs from different conditions
+ expDesign <- data.frame(condition=paste("foo",c(1,1,1,2,2,3,3)),isControl=c(F,F,F,T,T,F,F) )
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5:6",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1:4,6:5",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1,2,4",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("2",expDesign)$condition)))
+ stopifnot( length(unique(expDesignTagToExpDesign("1:2:3:4:5:6",expDesign)$condition)) == 6)
+
+ cat("--- testExpDesignTagToExpDesign: PASS ALL TEST --- \n")
+
+ }
>
>
> ### TEST FUNCTIONS END
>
> ### TESTS
> testExpDesignTagToExpDesign()
--- testExpDesignTagToExpDesign: ---
Error in testExpDesignTagToExpDesign() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testExpDesignTagToExpDesign -> stopifnot
Execution halted
Flavor: r-devel-windows-ix86+x86_64-gcc8
Version: 2.3.1
Check: tests
Result: ERROR
Running ‘initTestSession.R’ [14s/15s]
Running ‘runAllTest.R’ [0s/1s]
Running ‘testExpressionAnalysis.R’ [14s/15s]
Running ‘testGraphics.R’ [22s/27s]
Running ‘testIdentificationAnalysis.R’ [15s/18s]
Running ‘testParser.R’ [17s/19s]
Running ‘testSafeQuantAnalysis.R’ [21s/24s]
Running ‘testTMT.R’ [14s/16s]
Running ‘testUserOptions.R’ [14s/15s]
Running the tests in ‘tests/testExpressionAnalysis.R’ failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testCreateExpressionDataset <- function(){
+
+ cat("--- testCreateExpressionDataset: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+ cat("--- testCreateExpressionDataset: PASS ALL TEST --- \n")
+
+ }
>
>
> testGetAllEBayes <- function(){
+
+
+ cat("--- testGetAllEBayes: --- \n")
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ pAdj <- getAllEBayes(eset, adjust=T)
+
+ stopifnot( mean(pAdj[,"A"]) > mean(p[,"A"]) )
+
+ ### paired desgn
+ esetNonPaired <- esetPaired
+ pData(esetNonPaired) <- pData(esetPaired)[,1:2]
+
+ pValPaired <- getAllEBayes(esetPaired,adjust=F,method=c("all"))
+ pValPairedPairwise <- getAllEBayes(esetPaired,adjust=F,method=c("pairwise"))
+
+ pValNonPaired <- getAllEBayes(esetNonPaired,adjust=F,method=c("all"))
+ pValNonPairedPairwise <- getAllEBayes(esetNonPaired,adjust=F,method=c("pairwise"))
+ stopifnot(all(apply(pValPaired,2,sum) < apply(pValNonPaired,2,sum)))
+ stopifnot(all(apply(pValPairedPairwise,2,sum) < apply(pValNonPairedPairwise,2,sum)))
+
+ # adjustment filter
+
+ adjustfilter <- data.frame(rep(T,nrow(eset)),rep(T,nrow(eset)) )
+ adjustfilter[1,1] <- F
+ adjustfilter[2,2] <- F
+
+ pTmp <- getAllEBayes(eset,adjust=T, adjustFilter=adjustfilter)
+ stopifnot(p[1,1] == pTmp[1,1])
+ stopifnot(p[2,2] == pTmp[2,2])
+ stopifnot(is.na(pTmp[3,2]))
+ cat("--- testGetAllEBayes: PASS ALL TEST --- \n")
+
+ # Question: limma multiple groups comparison produces different pvalue comparing with two group comparsion
+ # https://support.bioconductor.org/p/44216/
+ # https://support.bioconductor.org/p/60556/
+ }
>
> testGetRatios <- function(){
+
+ cat("--- testGetRatios: --- \n")
+
+ r <- getRatios(eset)
+
+ exprs(eset)[1,c(5:6,1:2)]
+ # C_rep_1 C_rep_2 A_rep_1 A_rep_2
+ # 9.963852 9.966003 9.965568 9.967214
+
+ ## NOTE: C is control
+ stopifnot(all.equal(r[1,1],median(log2(exprs(eset))[1,1:2]) - median(log2(exprs(eset))[1,5:6]) ) )
+
+ stopifnot(mean(r[,"A"]) < mean(r[,"B"]))
+ stopifnot(all.equal(r,getRatios(eset,method="mean")))
+ r <- getRatios(eset)
+ stopifnot(all.equal(mean(r[,"B"]),mean(r[,"B"])))
+
+ stopifnot(all(round(apply(getRatios(esetPaired, log2=F),2,mean),1) == c(1.5,1.2)))
+ stopifnot(ncol(r) == 2)
+
+ rPaired <- getRatios(esetPaired, method="paired")
+ stopifnot(ncol(rPaired) == 4)
+ stopifnot(all( log2(exprs(esetPaired)[,1]) - log2(exprs(esetPaired)[,5]) == rPaired[,1] ))
+ stopifnot(all( log2(exprs(esetPaired)[,4]) - log2(exprs(esetPaired)[,6]) == rPaired[,4] ))
+ stopifnot(all( exprs(esetPaired)[,4] / exprs(esetPaired)[,6] == getRatios(esetPaired, method="paired", log2=F)[,4] ))
+ # should fail
+ stopifnot((inherits(try( getRatios(eset, method="paired"), silent = TRUE), "try-error")))
+
+
+ stopifnot(all(round(getRatios(esetPaired)[,1],2) == round(apply(rPaired[,1:2],1,median),2)))
+
+
+ cat("--- testGetRatios: PASS ALL TEST --- \n")
+
+ }
>
> testGetAllCV <- function(){
+
+ cat("--- testGetAllCV: --- \n")
+
+ cv <- getAllCV(eset)
+
+ stopifnot(all.equal(cv[1,"A"] , (sd(exprs(eset)[1,unlist(pData(eset)$condition == "A")]) / mean(exprs(eset)[1,unlist(pData(eset)$condition == "A")]))))
+ stopifnot(all.equal(cv[200,"C"] , sd(exprs(eset)[200,unlist(pData(eset)$condition == "C")]) / mean(exprs(eset)[200,unlist(pData(eset)$condition == "C")])))
+
+ cvPaired <- getAllCV(esetPaired)
+ stopifnot(all(is.na(cvPaired[,1])))
+ stopifnot(all(!is.na(cvPaired[,2])))
+ stopifnot(cvPaired[3,"A"] == (sd(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6]) / mean(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6])))
+
+ cat("--- testGetAllCV: PASS ALL TEST --- \n")
+ }
>
> testGlobalNormalize <- function(){
+
+ cat("--- testGlobalNormalize: --- \n")
+
+ globalNormFactors <- getGlobalNormFactors(eset,method="sum")
+ ### add normalization factors to ExpressionSet
+ pData(eset) <- cbind(pData(eset),globalNormFactors)
+ esetNorm <- globalNormalize(eset,globalNormFactors)
+
+ stopifnot(all.equal(as.vector(unlist(apply(exprs(esetNorm),2,sum))),as.vector(rev(unlist(apply(exprs(esetNorm),2,sum))))))
+
+ stopifnot(pData(esetNorm)$normFactor[1] == 1)
+ stopifnot(pData(esetNorm)$normFactor[2] != 1)
+
+ cat("--- testGlobalNormalize: PASS ALL TEST --- \n")
+
+ # Should generate error and stop
+ # fData(eset)$isNormAnchor <- rep(F,nrow(eset))
+ # esetNorm <- normalizeIntensities(eset)
+
+ }
>
> testGetSignalPerCondition <- function(){
+
+ cat("--- testGetSignalPerCondition: --- \n")
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"A"] <= getSignalPerCondition(eset,method="max")[,"A"]) == nrow(eset))
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"C"] <= getSignalPerCondition(eset,method="median")[,"C"]) == nrow(eset))
+ stopifnot(getSignalPerCondition(eset,method="sd")[1,2] == sd(exprs(eset)[1,3:4]))
+ cat("--- testGetSignalPerCondition: PASS ALL TEST --- \n")
+ }
>
> testBaselineIntensity <- function(){
+
+ cat("--- testBaselineIntensity: --- \n")
+
+ allInt <- as.vector(unlist(exprs(eset)))
+ bl <- round(getBaselineIntensity(allInt,promille=5),2)
+ #hist(allInt)
+ #abline(v=bl,lwd=2)
+ stopifnot(all.equal(bl[[1]] , 997.82) )
+
+
+ set.seed(1234)
+ suppressWarnings(allInt2 <- log10(rnorm(1000,1,1)))
+ bl2 <- round(getBaselineIntensity(allInt2,promille=5),2)
+ stopifnot(all.equal(-1.95,bl2[[1]]))
+ #hist(allInt2)
+ #abline(v=bl2,lwd=2)
+
+ cat("--- testBaselineIntensity: PASS ALL TEST --- \n")
+
+ }
>
> testRollUp <- function(){
+
+ cat(" --- testRollUp --- \n")
+
+ rollUpEset1 <- rollUp(eset,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$proteinName ) ) == nrow(rollUpEset1))
+
+ rollUpEset2 <- rollUp(eset ,featureDataColumnName= c("ptm"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset2))
+
+ rollUpEset3 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("ptm"), method=c("mean"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset3))
+
+ #print(exprs(rollUpEset2))
+
+ stopifnot(all.equal(sum(exprs(rollUpEset2)),sum(exprs(rollUpEset1)))) ### test sum
+ stopifnot(sum(exprs(rollUpEset1)) != sum(exprs(rollUpEset3))) ### test mean
+
+ rollUpEset4 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))
+ stopifnot(sum(exprs(rollUpEset3)) != sum(exprs(rollUpEset4)) ) ### test top 3
+
+ cat(" --- testRollUp: PASS ALL TEST --- \n")
+
+ # progenesisFeatureCsvFile3 <- "/Users/ahrnee-adm/dev/R/workspace/SafeQuant/inst/testData/2014/peptides2.csv"
+ # d <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile3,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile3))
+ # system.time(e <- rollUp(d, method="sum", isProgressBar=T, featureDataColumnName= c("peptide")))
+ # system.time(e <- rollUpDT(d, method="sum", featureDataColumnName= c("peptide")))
+ #
+ esetTmp <- parseProgenesisPeptideMeasurementCsv(progenesisPeptideMeasurementCsvFile1,expDesign= getExpDesignProgenesisCsv(progenesisPeptideMeasurementCsvFile1))
+
+ fData(esetTmp)
+
+ rollUpEsetProteinAllAccessions <- rollUp(esetTmp,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot(fData(rollUpEsetProteinAllAccessions)$allAccessionsTMP[68] == "sp|E9PAV3|NACAM_HUMAN;sp|Q9BZK3|NACP1_HUMAN")
+
+ }
>
> testTopX <- function(){
+
+ cat(" --- testTopX --- \n")
+
+ entryData1 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,5),ncol=4)))
+ rownames(entryData1) <- paste("peptide",1:nrow(entryData1),sep="_")
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 5
+ stopifnot(all.equal(rep(10/3,3) , as.vector(unlist(getTopX(entryData1))) ))
+
+ entryData2 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,NA),ncol=4)))
+ rownames(entryData2) <- paste("peptide",1:nrow(entryData2),sep="_")
+
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 NA
+ stopifnot(all.equal(c(4,4,3) , as.vector(unlist(getTopX(entryData2,topX=2)))))
+
+ # 1 row
+ stopifnot(all.equal(rep(1,3),as.vector(unlist(getTopX(entryData1[1,])))))
+
+ # 1 col
+ stopifnot(all.equal(getTopX(entryData1)[[1]],getTopX(entryData1[,1])))
+
+ top1 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top1"))),1,sum)
+ top3 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))),1,sum)
+ meanInt <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("mean"))),1,sum)
+
+ stopifnot(sum(top1 >= top3 ) == length(top3))
+ stopifnot(sum(top1) > sum(top3))
+ stopifnot(sum(top1) > sum(meanInt))
+ stopifnot(all.equal(sum(top3),sum(meanInt)))
+
+ cat(" --- testTopX: PASS ALL TEST --- \n")
+
+ }
>
> testGetIBAQEset <- function(){
+
+ cat(" --- testGetIBAQEset --- \n")
+
+ # read protein fasta
+ proteinDB <- read.fasta(fastaFile,seqtype = "AA",as.string = TRUE, set.attributes = FALSE)
+
+ iBaqEset <- getIBAQEset(eset,proteinDB=proteinDB)
+ stopifnot(round(exprs(iBaqEset))[1,1] == 125)
+ stopifnot(round(exprs(iBaqEset))[2,2] == 38)
+
+ cat(" --- testGetIBAQEset: PASS ALL TEST --- \n")
+ }
>
>
> testGetLoocvFoldError <- function(){
+
+ cat(" --- testGetLoocvFoldError --- \n")
+ #plotCalibrationCurve(fit)
+ stopifnot( round(sum(getLoocvFoldError(absEstSimData))) == -8)
+ cat(" --- testGetLoocvFoldError: PASS ALL TEST --- \n")
+ }
>
> testSqNormalize <- function(){
+
+ cat(" --- testSqNormalize --- \n")
+
+ stopifnot(nrow(sqNormalize(eset, method = "global")) == 900)
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ stopifnot(nrow(sqNormalize(esetTmp, method = "rt")) == 496)
+
+ cat(" --- testSqNormalize: PASS ALL TEST --- \n")
+ }
>
>
> testRtNormalize <- function(){
+
+
+ cat(" --- testRTNormalize --- \n")
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ rtNormFactors <- getRTNormFactors(esetTmp, minFeaturesPerBin=100)
+ stopifnot(nrow(rtNormalize(esetTmp,rtNormFactors)) == 97)
+
+ # Stop if rtNormFactors doesn't cover all retention times.
+ #rtNormalize(esetTmp,rtNormFactors[1:2,])
+
+ cat(" --- testRTNormalize: PASS ALL TEST --- \n")
+ }
>
> testRemoveOutliers <- function(){
+
+ cat(" --- testRemoveOutliers --- \n")
+ set.seed(1234)
+ stopifnot(sum(is.na(removeOutliers(c(-10, rnorm(100), 10)))) == 2)
+ cat(" --- testRemoveOutliers: PASS ALL TEST --- \n")
+ }
>
> testPerFeatureNormalization <- function(){
+
+ cat(" --- testPerFeatureNormalization: --- \n")
+
+ normFactors <- exprs(eset)[1:10,1:3]
+ colnames(normFactors) <- c("A","B","C")
+ rownames(normFactors) <- fData(eset)[1:10,]$proteinName
+ normFactors[is.finite(normFactors)] <- 1
+ eNorm <- perFeatureNormalization(eset,normFactors)
+
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,2] , (exprs(eset)[1,2]-1)))
+ stopifnot(all.equal(exprs(eNorm)[13,2] , (exprs(eset)[13,2])))
+
+ normFactors[,2] <- 200
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,3] , (exprs(eset)[1,3]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,4] , (exprs(eset)[1,4]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,5] , (exprs(eset)[1,5]-1)))
+
+ normFactors[,3] <- 0
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,5] , exprs(eset)[1,5]))
+ stopifnot(all.equal(exprs(eNorm)[2,6] , exprs(eset)[2,6]))
+
+ normFactors[3,] <- 1000
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ # re-order normFactors columns
+ eNorm <- perFeatureNormalization(eset,normFactors[,rev(colnames(normFactors))])
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ cat(" --- testPerFeatureNormalization: PASS ALL TEST --- \n")
+
+ #coveredPeptideSel <- fData(eset)$proteinName %in% rownames(normFactors)
+ #exprs(eset)[coveredPeptideSel,] <- exprs(eset)[coveredPeptideSel, ] - normFactors[as.character(fData(eset)[coveredPeptideSel,]$proteinName),pData(eset)$condition]
+
+ }
>
>
> testStandardise <- function(){
+
+ cat(" --- testStandardise: --- \n")
+
+ d <- data.frame(rnorm(10000,5,20), rnorm(10000,10,10))
+ dStd <- standardise(d[,1])
+
+ stopifnot(round(mean(dStd)) == 0 )
+ stopifnot(round(sd(dStd)) == 1 )
+
+ dStd <- standardise(d)
+ stopifnot(round(apply(dStd,2,mean)[1]) == 0)
+ stopifnot(round(apply(dStd,2,sd)[1]) == 1)
+
+ cat(" --- testStandardise: PASS ALL TEST --- \n")
+
+ }
>
> testGetMaxIndex <-function(){
+
+ cat(" --- testGetMaxIndex: --- \n")
+ d <- data.frame(s=c(NA,NA,NA,NA,1,1:4),lab=sort(rep(c("A","B","C"),3)))
+ DT <- data.table(d)
+ setkey(DT,lab)
+
+
+ stopifnot(all.equal(c(1,5,9) , DT[, .I[getMaxIndex(s)], by=lab ]$V1 ))
+ cat(" --- testGetMaxIndex: PASS ALL TEST --- \n")
+
+ }
>
> testCreatePairedExpDesign <- function(){
+
+ cat(" --- testCreatePairedExpDesign: --- \n")
+ stopifnot(all( pData(createPairedExpDesign(eset))$subject == as.factor(rep(1:2,3))))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:3]), silent = TRUE), "try-error")))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:4]), silent = TRUE), "ExpressionSet")))
+ cat(" --- testCreatePairedExpDesign: PASS ALL TEST --- \n")
+
+ }
>
> ### TEST FUNCTIONS END
>
> #### TESTS
> #testGetRatios()
> #testGetAllEBayes()
> #testGetSignalPerCondition()
> #testGetRatios()
>
> if(T){
+ testCreateExpressionDataset()
+ testGetAllEBayes()
+ testGetRatios()
+ testGetAllCV()
+ testGlobalNormalize()
+ #testNormalise()
+ testRtNormalize()
+
+ testBaselineIntensity()
+ testRollUp()
+ testTopX()
+
+ testGetLoocvFoldError()
+
+ testRemoveOutliers()
+ testPerFeatureNormalization()
+ testStandardise()
+ testGetMaxIndex()
+
+ testGetIBAQEset()
+
+ testCreatePairedExpDesign()
+
+ }
--- testCreateExpressionDataset: ---
Error in testCreateExpressionDataset() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testCreateExpressionDataset -> stopifnot
Execution halted
Running the tests in ‘tests/testUserOptions.R’ failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
>
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testExpDesignTagToExpDesign <- function(){
+
+ cat("--- testExpDesignTagToExpDesign: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+
+ expDesignString1 <- "1,2,3:4,5,6"
+
+ # 6-plex default: 1,2,3:4,5,6
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 1 TRUE
+ #3 Condition 1 TRUE
+ #4 Condition 2 FALSE
+ #5 Condition 2 FALSE
+ #6 Condition 2 FALSE
+
+
+ expDesign <- data.frame(condition=paste("Condition",sort(rep(c(1,2),3))),isControl=sort(rep(c(T,F),3),decreasing=T) )
+
+ expDesign1 <- expDesignTagToExpDesign(expDesignString1, expDesign)
+
+ stopifnot(nrow(expDesign1) == 6 )
+ stopifnot(length(unique(expDesign1$condition)) == 2 )
+ stopifnot(sum(expDesign1$isControl) == 3 )
+
+ expDesignString2 <- "1,4,7,10:2,5,8:3,6,9"
+
+ # 10-plex default is "1,4,7,10:2,5,8:3,6,9"
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 2 FALSE
+ #3 Condition 3 FALSE
+ #4 Condition 1 TRUE
+ #5 Condition 2 FALSE
+ #6 Condition 3 FALSE
+ #7 Condition 1 TRUE
+ #8 Condition 2 FALSE
+ #9 Condition 3 FALSE
+ #10 Condition 1 TRUE
+
+ expDesign <- data.frame(condition=paste("Condition",c(1,2,3,1,2,3,1,2,3,1)),isControl=c(T,F,F,T,F,F,T,F,F,T) )
+ expDesign2 <- expDesignTagToExpDesign(expDesignString2, expDesign)
+ stopifnot(nrow(expDesign2) == 10 )
+ stopifnot(length(unique(expDesign2$condition)) == 3 )
+ stopifnot(sum(expDesign2$isControl) == 4 )
+
+ ### condition name assignment when mixing runs from different conditions
+ expDesign <- data.frame(condition=paste("foo",c(1,1,1,2,2,3,3)),isControl=c(F,F,F,T,T,F,F) )
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5:6",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1:4,6:5",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1,2,4",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("2",expDesign)$condition)))
+ stopifnot( length(unique(expDesignTagToExpDesign("1:2:3:4:5:6",expDesign)$condition)) == 6)
+
+ cat("--- testExpDesignTagToExpDesign: PASS ALL TEST --- \n")
+
+ }
>
>
> ### TEST FUNCTIONS END
>
> ### TESTS
> testExpDesignTagToExpDesign()
--- testExpDesignTagToExpDesign: ---
Error in testExpDesignTagToExpDesign() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testExpDesignTagToExpDesign -> stopifnot
Execution halted
Flavor: r-patched-linux-x86_64
Version: 2.3.1
Check: tests
Result: ERROR
Running ‘initTestSession.R’ [7s/11s]
Running ‘runAllTest.R’ [0s/0s]
Running ‘testExpressionAnalysis.R’ [7s/10s]
Running the tests in ‘tests/testExpressionAnalysis.R’ failed.
Last 13 lines of output:
+ testPerFeatureNormalization()
+ testStandardise()
+ testGetMaxIndex()
+
+ testGetIBAQEset()
+
+ testCreatePairedExpDesign()
+
+ }
--- testCreateExpressionDataset: ---
Error in testCreateExpressionDataset() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testCreateExpressionDataset -> stopifnot
Execution halted
Flavor: r-patched-osx-x86_64
Version: 2.3.1
Check: tests
Result: ERROR
Running ‘initTestSession.R’ [24s/32s]
Running ‘runAllTest.R’
Running ‘testExpressionAnalysis.R’ [24s/34s]
Running ‘testGraphics.R’ [39s/47s]
Running ‘testIdentificationAnalysis.R’ [26s/39s]
Running ‘testParser.R’ [28s/34s]
Running ‘testSafeQuantAnalysis.R’ [35s/44s]
Running ‘testTMT.R’ [25s/31s]
Running ‘testUserOptions.R’ [25s/34s]
Running the tests in ‘tests/testExpressionAnalysis.R’ failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testCreateExpressionDataset <- function(){
+
+ cat("--- testCreateExpressionDataset: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+ cat("--- testCreateExpressionDataset: PASS ALL TEST --- \n")
+
+ }
>
>
> testGetAllEBayes <- function(){
+
+
+ cat("--- testGetAllEBayes: --- \n")
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ p <- getAllEBayes(eset)
+ stopifnot( mean(p[,"A"]) > mean(p[,"B"]) )
+ pAdj <- getAllEBayes(eset, adjust=T)
+
+ stopifnot( mean(pAdj[,"A"]) > mean(p[,"A"]) )
+
+ ### paired desgn
+ esetNonPaired <- esetPaired
+ pData(esetNonPaired) <- pData(esetPaired)[,1:2]
+
+ pValPaired <- getAllEBayes(esetPaired,adjust=F,method=c("all"))
+ pValPairedPairwise <- getAllEBayes(esetPaired,adjust=F,method=c("pairwise"))
+
+ pValNonPaired <- getAllEBayes(esetNonPaired,adjust=F,method=c("all"))
+ pValNonPairedPairwise <- getAllEBayes(esetNonPaired,adjust=F,method=c("pairwise"))
+ stopifnot(all(apply(pValPaired,2,sum) < apply(pValNonPaired,2,sum)))
+ stopifnot(all(apply(pValPairedPairwise,2,sum) < apply(pValNonPairedPairwise,2,sum)))
+
+ # adjustment filter
+
+ adjustfilter <- data.frame(rep(T,nrow(eset)),rep(T,nrow(eset)) )
+ adjustfilter[1,1] <- F
+ adjustfilter[2,2] <- F
+
+ pTmp <- getAllEBayes(eset,adjust=T, adjustFilter=adjustfilter)
+ stopifnot(p[1,1] == pTmp[1,1])
+ stopifnot(p[2,2] == pTmp[2,2])
+ stopifnot(is.na(pTmp[3,2]))
+ cat("--- testGetAllEBayes: PASS ALL TEST --- \n")
+
+ # Question: limma multiple groups comparison produces different pvalue comparing with two group comparsion
+ # https://support.bioconductor.org/p/44216/
+ # https://support.bioconductor.org/p/60556/
+ }
>
> testGetRatios <- function(){
+
+ cat("--- testGetRatios: --- \n")
+
+ r <- getRatios(eset)
+
+ exprs(eset)[1,c(5:6,1:2)]
+ # C_rep_1 C_rep_2 A_rep_1 A_rep_2
+ # 9.963852 9.966003 9.965568 9.967214
+
+ ## NOTE: C is control
+ stopifnot(all.equal(r[1,1],median(log2(exprs(eset))[1,1:2]) - median(log2(exprs(eset))[1,5:6]) ) )
+
+ stopifnot(mean(r[,"A"]) < mean(r[,"B"]))
+ stopifnot(all.equal(r,getRatios(eset,method="mean")))
+ r <- getRatios(eset)
+ stopifnot(all.equal(mean(r[,"B"]),mean(r[,"B"])))
+
+ stopifnot(all(round(apply(getRatios(esetPaired, log2=F),2,mean),1) == c(1.5,1.2)))
+ stopifnot(ncol(r) == 2)
+
+ rPaired <- getRatios(esetPaired, method="paired")
+ stopifnot(ncol(rPaired) == 4)
+ stopifnot(all( log2(exprs(esetPaired)[,1]) - log2(exprs(esetPaired)[,5]) == rPaired[,1] ))
+ stopifnot(all( log2(exprs(esetPaired)[,4]) - log2(exprs(esetPaired)[,6]) == rPaired[,4] ))
+ stopifnot(all( exprs(esetPaired)[,4] / exprs(esetPaired)[,6] == getRatios(esetPaired, method="paired", log2=F)[,4] ))
+ # should fail
+ stopifnot((inherits(try( getRatios(eset, method="paired"), silent = TRUE), "try-error")))
+
+
+ stopifnot(all(round(getRatios(esetPaired)[,1],2) == round(apply(rPaired[,1:2],1,median),2)))
+
+
+ cat("--- testGetRatios: PASS ALL TEST --- \n")
+
+ }
>
> testGetAllCV <- function(){
+
+ cat("--- testGetAllCV: --- \n")
+
+ cv <- getAllCV(eset)
+
+ stopifnot(all.equal(cv[1,"A"] , (sd(exprs(eset)[1,unlist(pData(eset)$condition == "A")]) / mean(exprs(eset)[1,unlist(pData(eset)$condition == "A")]))))
+ stopifnot(all.equal(cv[200,"C"] , sd(exprs(eset)[200,unlist(pData(eset)$condition == "C")]) / mean(exprs(eset)[200,unlist(pData(eset)$condition == "C")])))
+
+ cvPaired <- getAllCV(esetPaired)
+ stopifnot(all(is.na(cvPaired[,1])))
+ stopifnot(all(!is.na(cvPaired[,2])))
+ stopifnot(cvPaired[3,"A"] == (sd(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6]) / mean(exprs(esetPaired)[3,1:2] / exprs(esetPaired)[3,5:6])))
+
+ cat("--- testGetAllCV: PASS ALL TEST --- \n")
+ }
>
> testGlobalNormalize <- function(){
+
+ cat("--- testGlobalNormalize: --- \n")
+
+ globalNormFactors <- getGlobalNormFactors(eset,method="sum")
+ ### add normalization factors to ExpressionSet
+ pData(eset) <- cbind(pData(eset),globalNormFactors)
+ esetNorm <- globalNormalize(eset,globalNormFactors)
+
+ stopifnot(all.equal(as.vector(unlist(apply(exprs(esetNorm),2,sum))),as.vector(rev(unlist(apply(exprs(esetNorm),2,sum))))))
+
+ stopifnot(pData(esetNorm)$normFactor[1] == 1)
+ stopifnot(pData(esetNorm)$normFactor[2] != 1)
+
+ cat("--- testGlobalNormalize: PASS ALL TEST --- \n")
+
+ # Should generate error and stop
+ # fData(eset)$isNormAnchor <- rep(F,nrow(eset))
+ # esetNorm <- normalizeIntensities(eset)
+
+ }
>
> testGetSignalPerCondition <- function(){
+
+ cat("--- testGetSignalPerCondition: --- \n")
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"A"] <= getSignalPerCondition(eset,method="max")[,"A"]) == nrow(eset))
+ stopifnot(sum(getSignalPerCondition(eset,method="min")[,"C"] <= getSignalPerCondition(eset,method="median")[,"C"]) == nrow(eset))
+ stopifnot(getSignalPerCondition(eset,method="sd")[1,2] == sd(exprs(eset)[1,3:4]))
+ cat("--- testGetSignalPerCondition: PASS ALL TEST --- \n")
+ }
>
> testBaselineIntensity <- function(){
+
+ cat("--- testBaselineIntensity: --- \n")
+
+ allInt <- as.vector(unlist(exprs(eset)))
+ bl <- round(getBaselineIntensity(allInt,promille=5),2)
+ #hist(allInt)
+ #abline(v=bl,lwd=2)
+ stopifnot(all.equal(bl[[1]] , 997.82) )
+
+
+ set.seed(1234)
+ suppressWarnings(allInt2 <- log10(rnorm(1000,1,1)))
+ bl2 <- round(getBaselineIntensity(allInt2,promille=5),2)
+ stopifnot(all.equal(-1.95,bl2[[1]]))
+ #hist(allInt2)
+ #abline(v=bl2,lwd=2)
+
+ cat("--- testBaselineIntensity: PASS ALL TEST --- \n")
+
+ }
>
> testRollUp <- function(){
+
+ cat(" --- testRollUp --- \n")
+
+ rollUpEset1 <- rollUp(eset,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$proteinName ) ) == nrow(rollUpEset1))
+
+ rollUpEset2 <- rollUp(eset ,featureDataColumnName= c("ptm"), method=c("sum"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset2))
+
+ rollUpEset3 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("ptm"), method=c("mean"))
+ stopifnot( length( unique( fData(eset)$ptm ) ) == nrow(rollUpEset3))
+
+ #print(exprs(rollUpEset2))
+
+ stopifnot(all.equal(sum(exprs(rollUpEset2)),sum(exprs(rollUpEset1)))) ### test sum
+ stopifnot(sum(exprs(rollUpEset1)) != sum(exprs(rollUpEset3))) ### test mean
+
+ rollUpEset4 <- rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))
+ stopifnot(sum(exprs(rollUpEset3)) != sum(exprs(rollUpEset4)) ) ### test top 3
+
+ cat(" --- testRollUp: PASS ALL TEST --- \n")
+
+ # progenesisFeatureCsvFile3 <- "/Users/ahrnee-adm/dev/R/workspace/SafeQuant/inst/testData/2014/peptides2.csv"
+ # d <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile3,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile3))
+ # system.time(e <- rollUp(d, method="sum", isProgressBar=T, featureDataColumnName= c("peptide")))
+ # system.time(e <- rollUpDT(d, method="sum", featureDataColumnName= c("peptide")))
+ #
+ esetTmp <- parseProgenesisPeptideMeasurementCsv(progenesisPeptideMeasurementCsvFile1,expDesign= getExpDesignProgenesisCsv(progenesisPeptideMeasurementCsvFile1))
+
+ fData(esetTmp)
+
+ rollUpEsetProteinAllAccessions <- rollUp(esetTmp,featureDataColumnName= c("proteinName"), method=c("sum"))
+ stopifnot(fData(rollUpEsetProteinAllAccessions)$allAccessionsTMP[68] == "sp|E9PAV3|NACAM_HUMAN;sp|Q9BZK3|NACP1_HUMAN")
+
+ }
>
> testTopX <- function(){
+
+ cat(" --- testTopX --- \n")
+
+ entryData1 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,5),ncol=4)))
+ rownames(entryData1) <- paste("peptide",1:nrow(entryData1),sep="_")
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 5
+ stopifnot(all.equal(rep(10/3,3) , as.vector(unlist(getTopX(entryData1))) ))
+
+ entryData2 <- data.frame(t(matrix(c(1,1,1,3,3,3,2,2,2,5,5,NA),ncol=4)))
+ rownames(entryData2) <- paste("peptide",1:nrow(entryData2),sep="_")
+
+ # X1 X2 X3
+ # peptide_1 1 1 1
+ # peptide_2 3 3 3
+ # peptide_3 2 2 2
+ # peptide_4 5 5 NA
+ stopifnot(all.equal(c(4,4,3) , as.vector(unlist(getTopX(entryData2,topX=2)))))
+
+ # 1 row
+ stopifnot(all.equal(rep(1,3),as.vector(unlist(getTopX(entryData1[1,])))))
+
+ # 1 col
+ stopifnot(all.equal(getTopX(entryData1)[[1]],getTopX(entryData1[,1])))
+
+ top1 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top1"))),1,sum)
+ top3 <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("top3"))),1,sum)
+ meanInt <- apply(exprs(rollUp(eset[!fData(eset)$isFiltered,] ,featureDataColumnName= c("proteinName"), method=c("mean"))),1,sum)
+
+ stopifnot(sum(top1 >= top3 ) == length(top3))
+ stopifnot(sum(top1) > sum(top3))
+ stopifnot(sum(top1) > sum(meanInt))
+ stopifnot(all.equal(sum(top3),sum(meanInt)))
+
+ cat(" --- testTopX: PASS ALL TEST --- \n")
+
+ }
>
> testGetIBAQEset <- function(){
+
+ cat(" --- testGetIBAQEset --- \n")
+
+ # read protein fasta
+ proteinDB <- read.fasta(fastaFile,seqtype = "AA",as.string = TRUE, set.attributes = FALSE)
+
+ iBaqEset <- getIBAQEset(eset,proteinDB=proteinDB)
+ stopifnot(round(exprs(iBaqEset))[1,1] == 125)
+ stopifnot(round(exprs(iBaqEset))[2,2] == 38)
+
+ cat(" --- testGetIBAQEset: PASS ALL TEST --- \n")
+ }
>
>
> testGetLoocvFoldError <- function(){
+
+ cat(" --- testGetLoocvFoldError --- \n")
+ #plotCalibrationCurve(fit)
+ stopifnot( round(sum(getLoocvFoldError(absEstSimData))) == -8)
+ cat(" --- testGetLoocvFoldError: PASS ALL TEST --- \n")
+ }
>
> testSqNormalize <- function(){
+
+ cat(" --- testSqNormalize --- \n")
+
+ stopifnot(nrow(sqNormalize(eset, method = "global")) == 900)
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ stopifnot(nrow(sqNormalize(esetTmp, method = "rt")) == 496)
+
+ cat(" --- testSqNormalize: PASS ALL TEST --- \n")
+ }
>
>
> testRtNormalize <- function(){
+
+
+ cat(" --- testRTNormalize --- \n")
+ esetTmp <- parseProgenesisFeatureCsv(file=progenesisFeatureCsvFile1,expDesign=getExpDesignProgenesisCsv(progenesisFeatureCsvFile1))
+ rtNormFactors <- getRTNormFactors(esetTmp, minFeaturesPerBin=100)
+ stopifnot(nrow(rtNormalize(esetTmp,rtNormFactors)) == 97)
+
+ # Stop if rtNormFactors doesn't cover all retention times.
+ #rtNormalize(esetTmp,rtNormFactors[1:2,])
+
+ cat(" --- testRTNormalize: PASS ALL TEST --- \n")
+ }
>
> testRemoveOutliers <- function(){
+
+ cat(" --- testRemoveOutliers --- \n")
+ set.seed(1234)
+ stopifnot(sum(is.na(removeOutliers(c(-10, rnorm(100), 10)))) == 2)
+ cat(" --- testRemoveOutliers: PASS ALL TEST --- \n")
+ }
>
> testPerFeatureNormalization <- function(){
+
+ cat(" --- testPerFeatureNormalization: --- \n")
+
+ normFactors <- exprs(eset)[1:10,1:3]
+ colnames(normFactors) <- c("A","B","C")
+ rownames(normFactors) <- fData(eset)[1:10,]$proteinName
+ normFactors[is.finite(normFactors)] <- 1
+ eNorm <- perFeatureNormalization(eset,normFactors)
+
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,2] , (exprs(eset)[1,2]-1)))
+ stopifnot(all.equal(exprs(eNorm)[13,2] , (exprs(eset)[13,2])))
+
+ normFactors[,2] <- 200
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,1] , (exprs(eset)[1,1]-1)))
+ stopifnot(all.equal(exprs(eNorm)[1,3] , (exprs(eset)[1,3]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,4] , (exprs(eset)[1,4]-200)))
+ stopifnot(all.equal(exprs(eNorm)[1,5] , (exprs(eset)[1,5]-1)))
+
+ normFactors[,3] <- 0
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[1,5] , exprs(eset)[1,5]))
+ stopifnot(all.equal(exprs(eNorm)[2,6] , exprs(eset)[2,6]))
+
+ normFactors[3,] <- 1000
+ eNorm <- perFeatureNormalization(eset,normFactors)
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ # re-order normFactors columns
+ eNorm <- perFeatureNormalization(eset,normFactors[,rev(colnames(normFactors))])
+ stopifnot(all.equal(exprs(eNorm)[3,] , (exprs(eset)[3,]-1000)))
+ stopifnot(all.equal(exprs(eNorm)[20:50,] , exprs(eset)[20:50,]))
+
+ cat(" --- testPerFeatureNormalization: PASS ALL TEST --- \n")
+
+ #coveredPeptideSel <- fData(eset)$proteinName %in% rownames(normFactors)
+ #exprs(eset)[coveredPeptideSel,] <- exprs(eset)[coveredPeptideSel, ] - normFactors[as.character(fData(eset)[coveredPeptideSel,]$proteinName),pData(eset)$condition]
+
+ }
>
>
> testStandardise <- function(){
+
+ cat(" --- testStandardise: --- \n")
+
+ d <- data.frame(rnorm(10000,5,20), rnorm(10000,10,10))
+ dStd <- standardise(d[,1])
+
+ stopifnot(round(mean(dStd)) == 0 )
+ stopifnot(round(sd(dStd)) == 1 )
+
+ dStd <- standardise(d)
+ stopifnot(round(apply(dStd,2,mean)[1]) == 0)
+ stopifnot(round(apply(dStd,2,sd)[1]) == 1)
+
+ cat(" --- testStandardise: PASS ALL TEST --- \n")
+
+ }
>
> testGetMaxIndex <-function(){
+
+ cat(" --- testGetMaxIndex: --- \n")
+ d <- data.frame(s=c(NA,NA,NA,NA,1,1:4),lab=sort(rep(c("A","B","C"),3)))
+ DT <- data.table(d)
+ setkey(DT,lab)
+
+
+ stopifnot(all.equal(c(1,5,9) , DT[, .I[getMaxIndex(s)], by=lab ]$V1 ))
+ cat(" --- testGetMaxIndex: PASS ALL TEST --- \n")
+
+ }
>
> testCreatePairedExpDesign <- function(){
+
+ cat(" --- testCreatePairedExpDesign: --- \n")
+ stopifnot(all( pData(createPairedExpDesign(eset))$subject == as.factor(rep(1:2,3))))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:3]), silent = TRUE), "try-error")))
+ stopifnot((inherits(try(createPairedExpDesign(eset[,1:4]), silent = TRUE), "ExpressionSet")))
+ cat(" --- testCreatePairedExpDesign: PASS ALL TEST --- \n")
+
+ }
>
> ### TEST FUNCTIONS END
>
> #### TESTS
> #testGetRatios()
> #testGetAllEBayes()
> #testGetSignalPerCondition()
> #testGetRatios()
>
> if(T){
+ testCreateExpressionDataset()
+ testGetAllEBayes()
+ testGetRatios()
+ testGetAllCV()
+ testGlobalNormalize()
+ #testNormalise()
+ testRtNormalize()
+
+ testBaselineIntensity()
+ testRollUp()
+ testTopX()
+
+ testGetLoocvFoldError()
+
+ testRemoveOutliers()
+ testPerFeatureNormalization()
+ testStandardise()
+ testGetMaxIndex()
+
+ testGetIBAQEset()
+
+ testCreatePairedExpDesign()
+
+ }
--- testCreateExpressionDataset: ---
Error in testCreateExpressionDataset() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testCreateExpressionDataset -> stopifnot
Execution halted
Running the tests in ‘tests/testUserOptions.R’ failed.
Complete output:
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
>
> # TODO: Add comment
> #
> # Author: ahrnee-adm
> ###############################################################################
>
> ### INIT
> if(!grepl("SafeQuant\\.Rcheck",getwd())){
+ setwd(dirname(sys.frame(1)$ofile))
+ }
> source("initTestSession.R")
Attaching package: 'gplots'
The following object is masked from 'package:stats':
lowess
Attaching package: 'seqinr'
The following object is masked from 'package:limma':
zscore
Loading required package: survival
Package epiR 1.0-14 is loaded
Type help(epi.about) for summary information
Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses
corrplot 0.84 loaded
Loading required package: BiocGenerics
Loading required package: parallel
Attaching package: 'BiocGenerics'
The following objects are masked from 'package:parallel':
clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
clusterExport, clusterMap, parApply, parCapply, parLapply,
parLapplyLB, parRapply, parSapply, parSapplyLB
The following object is masked from 'package:limma':
plotMA
The following objects are masked from 'package:stats':
IQR, mad, sd, var, xtabs
The following objects are masked from 'package:base':
Filter, Find, Map, Position, Reduce, anyDuplicated, append,
as.data.frame, basename, cbind, colnames, dirname, do.call,
duplicated, eval, evalq, get, grep, grepl, intersect, is.unsorted,
lapply, mapply, match, mget, order, paste, pmax, pmax.int, pmin,
pmin.int, rank, rbind, rownames, sapply, setdiff, sort, table,
tapply, union, unique, unsplit, which, which.max, which.min
Welcome to Bioconductor
Vignettes contain introductory material; view with
'browseVignettes()'. To cite Bioconductor, see
'citation("Biobase")', and for packages 'citation("pkgname")'.
> ### INIT END
>
>
> ### TEST FUNCTIONS
>
> testExpDesignTagToExpDesign <- function(){
+
+ cat("--- testExpDesignTagToExpDesign: --- \n")
+
+ stopifnot(all.equal(pData(eset),expDesign))
+ stopifnot(all.equal(sampleNames(eset),colnames(m)))
+ stopifnot(all.equal(nrow(exprs(eset)),nrow(m)))
+
+ expDesignString1 <- "1,2,3:4,5,6"
+
+ # 6-plex default: 1,2,3:4,5,6
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 1 TRUE
+ #3 Condition 1 TRUE
+ #4 Condition 2 FALSE
+ #5 Condition 2 FALSE
+ #6 Condition 2 FALSE
+
+
+ expDesign <- data.frame(condition=paste("Condition",sort(rep(c(1,2),3))),isControl=sort(rep(c(T,F),3),decreasing=T) )
+
+ expDesign1 <- expDesignTagToExpDesign(expDesignString1, expDesign)
+
+ stopifnot(nrow(expDesign1) == 6 )
+ stopifnot(length(unique(expDesign1$condition)) == 2 )
+ stopifnot(sum(expDesign1$isControl) == 3 )
+
+ expDesignString2 <- "1,4,7,10:2,5,8:3,6,9"
+
+ # 10-plex default is "1,4,7,10:2,5,8:3,6,9"
+ #condition isControl
+ #1 Condition 1 TRUE
+ #2 Condition 2 FALSE
+ #3 Condition 3 FALSE
+ #4 Condition 1 TRUE
+ #5 Condition 2 FALSE
+ #6 Condition 3 FALSE
+ #7 Condition 1 TRUE
+ #8 Condition 2 FALSE
+ #9 Condition 3 FALSE
+ #10 Condition 1 TRUE
+
+ expDesign <- data.frame(condition=paste("Condition",c(1,2,3,1,2,3,1,2,3,1)),isControl=c(T,F,F,T,F,F,T,F,F,T) )
+ expDesign2 <- expDesignTagToExpDesign(expDesignString2, expDesign)
+ stopifnot(nrow(expDesign2) == 10 )
+ stopifnot(length(unique(expDesign2$condition)) == 3 )
+ stopifnot(sum(expDesign2$isControl) == 4 )
+
+ ### condition name assignment when mixing runs from different conditions
+ expDesign <- data.frame(condition=paste("foo",c(1,1,1,2,2,3,3)),isControl=c(F,F,F,T,T,F,F) )
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5:6",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1:4,6:5",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("1,2,3:4,5",expDesign)$condition)))
+ stopifnot(all(grepl("Condition" ,expDesignTagToExpDesign("1,2,4",expDesign)$condition)))
+ stopifnot(all(grepl("foo" ,expDesignTagToExpDesign("2",expDesign)$condition)))
+ stopifnot( length(unique(expDesignTagToExpDesign("1:2:3:4:5:6",expDesign)$condition)) == 6)
+
+ cat("--- testExpDesignTagToExpDesign: PASS ALL TEST --- \n")
+
+ }
>
>
> ### TEST FUNCTIONS END
>
> ### TESTS
> testExpDesignTagToExpDesign()
--- testExpDesignTagToExpDesign: ---
Error in testExpDesignTagToExpDesign() :
pData(eset) and expDesign are not equal:
Component "condition": 'current' is not a factor
Calls: testExpDesignTagToExpDesign -> stopifnot
Execution halted
Flavor: r-patched-solaris-x86