DNAcopy.Rcheck/tests_i386/redundancy,20090610,segment.Rout
R version 3.5.1 Patched (2018-07-24 r75005) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> ######################################################################
> # Type: Redundancy test
> # Created by: Henrik Bengtsson <hb@stat.berkeley.edu>
> # Created on: 2009-06-10
> ######################################################################
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Startup
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> library("DNAcopy")
>
> # Record current random seed
> sample(1) # Assert that a random seed exists
[1] 1
> oldSeed <- .Random.seed
> # Alway use the same random seed
> set.seed(0xbeef)
>
> # Tolerance (maybe decrease?)
> tol <- .Machine$double.eps^0.5
>
> print(sessionInfo())
R version 3.5.1 Patched (2018-07-24 r75005)
Platform: i386-w64-mingw32/i386 (32-bit)
Running under: Windows Server 2012 R2 x64 (build 9600)
Matrix products: default
locale:
[1] LC_COLLATE=C
[2] LC_CTYPE=English_United States.1252
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C
[5] LC_TIME=English_United States.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] DNAcopy_1.54.0
loaded via a namespace (and not attached):
[1] compiler_3.5.1
>
>
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Simulating copy-number data
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Number of loci
> J <- 1000
>
> x <- sort(runif(J, min=0, max=1000))
> w <- runif(J)
> mu <- double(J)
> jj <- (200 <= x & x < 300)
> mu[jj] <- mu[jj] + 1
> jj <- (650 <= x & x < 800)
> mu[jj] <- mu[jj] - 1
> w[jj] <- 0.001
> eps <- rnorm(J, sd=1/2)
> y <- mu + eps
>
>
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Setting up a raw CNA object
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> cnR <- CNA(
+ genomdat = y,
+ chrom = rep(1, times=J),
+ maploc = x,
+ data.type = "logratio",
+ sampleid = "SampleA"
+ )
> print(cnR)
Number of Samples 1
Number of Probes 1000
Data Type logratio
>
>
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Test: Non-weighted segmentation
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> t <- system.time({
+ fitR <- segment(cnR, verbose=1)
+ })
Analyzing: SampleA
> cat("Processing time:\n")
Processing time:
> print(t)
user system elapsed
0.08 0.00 0.08
> print(fitR)
Call:
segment(x = cnR, verbose = 1)
ID chrom loc.start loc.end num.mark seg.mean
1 SampleA 1 1.368577 199.0840 209 0.0256
2 SampleA 1 201.604291 301.0669 105 1.0099
3 SampleA 1 303.775112 647.4270 337 -0.0084
4 SampleA 1 650.741212 798.9718 138 -0.9792
5 SampleA 1 800.302447 999.3290 211 -0.0289
>
> # Expected results
> # These were obtained by dput(fitR$output) using DNAcopy v1.19.0
> truth <- structure(list(ID = c("SampleA", "SampleA", "SampleA", "SampleA",
+ "SampleA"), chrom = c(1, 1, 1, 1, 1), loc.start = c(1.36857712641358,
+ 201.604291098192, 303.775111911818, 650.741211604327, 800.302447052673
+ ), loc.end = c(199.083976913244, 301.066882908344, 647.42697100155,
+ 798.971758922562, 999.329038895667), num.mark = c(209, 105, 337,
+ 138, 211), seg.mean = c(0.0256, 1.0099, -0.0084, -0.9792, -0.0289
+ )), .Names = c("ID", "chrom", "loc.start", "loc.end", "num.mark",
+ "seg.mean"), row.names = c(NA, -5L), class = "data.frame")
>
> stopifnot(all.equal(fitR$output, truth, tolerance=tol))
>
>
>
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Test: Weighted segmentation
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> t <- system.time({
+ fitR <- segment(cnR, weights=w, verbose=1)
+ })
Analyzing: SampleA
> cat("Processing time:\n")
Processing time:
> print(t)
user system elapsed
0.06 0.00 0.06
> print(fitR)
Call:
segment(x = cnR, weights = w, verbose = 1)
ID chrom loc.start loc.end num.mark seg.mean
1 SampleA 1 1.368577 199.0840 209 0.0259
2 SampleA 1 201.604291 301.0669 105 1.0004
3 SampleA 1 303.775112 999.3290 686 -0.0233
>
> # Expected results
> # These were obtained by dput(fitR$output) using DNAcopy v1.19.0
> truth <- structure(list(ID = c("SampleA", "SampleA", "SampleA"), chrom = c(1,
+ 1, 1), loc.start = c(1.36857712641358, 201.604291098192, 303.775111911818
+ ), loc.end = c(199.083976913244, 301.066882908344, 999.329038895667
+ ), num.mark = c(209, 105, 686), seg.mean = c(0.0259, 1.0004,
+ -0.0233)), .Names = c("ID", "chrom", "loc.start", "loc.end",
+ "num.mark", "seg.mean"), row.names = c(NA, -3L), class = "data.frame")
>
> stopifnot(all.equal(fitR$output, truth, tolerance=tol))
>
>
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Cleanup
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Reset to previous random seed
> .Random.seed <- oldSeed
>
> print(sessionInfo())
R version 3.5.1 Patched (2018-07-24 r75005)
Platform: i386-w64-mingw32/i386 (32-bit)
Running under: Windows Server 2012 R2 x64 (build 9600)
Matrix products: default
locale:
[1] LC_COLLATE=C
[2] LC_CTYPE=English_United States.1252
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C
[5] LC_TIME=English_United States.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] DNAcopy_1.54.0
loaded via a namespace (and not attached):
[1] compiler_3.5.1
>
>
> ######################################################################
> # HISTORY
> # 2009-06-10
> # o ROBUSTNESS: Added this test to assert that DNAcopy v1.19.2 and
> # newer will numerically give the same results as DNAcopy v1.19.0.
> # This test is ran each time with R CMD check.
> # o Created.
> ######################################################################
>
> proc.time()
user system elapsed
0.48 0.04 0.51
|
DNAcopy.Rcheck/tests_x64/redundancy,20090610,segment.Rout
R version 3.5.1 Patched (2018-07-24 r75005) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> ######################################################################
> # Type: Redundancy test
> # Created by: Henrik Bengtsson <hb@stat.berkeley.edu>
> # Created on: 2009-06-10
> ######################################################################
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Startup
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> library("DNAcopy")
>
> # Record current random seed
> sample(1) # Assert that a random seed exists
[1] 1
> oldSeed <- .Random.seed
> # Alway use the same random seed
> set.seed(0xbeef)
>
> # Tolerance (maybe decrease?)
> tol <- .Machine$double.eps^0.5
>
> print(sessionInfo())
R version 3.5.1 Patched (2018-07-24 r75005)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows Server 2012 R2 x64 (build 9600)
Matrix products: default
locale:
[1] LC_COLLATE=C
[2] LC_CTYPE=English_United States.1252
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C
[5] LC_TIME=English_United States.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] DNAcopy_1.54.0
loaded via a namespace (and not attached):
[1] compiler_3.5.1
>
>
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Simulating copy-number data
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Number of loci
> J <- 1000
>
> x <- sort(runif(J, min=0, max=1000))
> w <- runif(J)
> mu <- double(J)
> jj <- (200 <= x & x < 300)
> mu[jj] <- mu[jj] + 1
> jj <- (650 <= x & x < 800)
> mu[jj] <- mu[jj] - 1
> w[jj] <- 0.001
> eps <- rnorm(J, sd=1/2)
> y <- mu + eps
>
>
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Setting up a raw CNA object
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> cnR <- CNA(
+ genomdat = y,
+ chrom = rep(1, times=J),
+ maploc = x,
+ data.type = "logratio",
+ sampleid = "SampleA"
+ )
> print(cnR)
Number of Samples 1
Number of Probes 1000
Data Type logratio
>
>
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Test: Non-weighted segmentation
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> t <- system.time({
+ fitR <- segment(cnR, verbose=1)
+ })
Analyzing: SampleA
> cat("Processing time:\n")
Processing time:
> print(t)
user system elapsed
0.08 0.00 0.08
> print(fitR)
Call:
segment(x = cnR, verbose = 1)
ID chrom loc.start loc.end num.mark seg.mean
1 SampleA 1 1.368577 199.0840 209 0.0256
2 SampleA 1 201.604291 301.0669 105 1.0099
3 SampleA 1 303.775112 647.4270 337 -0.0084
4 SampleA 1 650.741212 798.9718 138 -0.9792
5 SampleA 1 800.302447 999.3290 211 -0.0289
>
> # Expected results
> # These were obtained by dput(fitR$output) using DNAcopy v1.19.0
> truth <- structure(list(ID = c("SampleA", "SampleA", "SampleA", "SampleA",
+ "SampleA"), chrom = c(1, 1, 1, 1, 1), loc.start = c(1.36857712641358,
+ 201.604291098192, 303.775111911818, 650.741211604327, 800.302447052673
+ ), loc.end = c(199.083976913244, 301.066882908344, 647.42697100155,
+ 798.971758922562, 999.329038895667), num.mark = c(209, 105, 337,
+ 138, 211), seg.mean = c(0.0256, 1.0099, -0.0084, -0.9792, -0.0289
+ )), .Names = c("ID", "chrom", "loc.start", "loc.end", "num.mark",
+ "seg.mean"), row.names = c(NA, -5L), class = "data.frame")
>
> stopifnot(all.equal(fitR$output, truth, tolerance=tol))
>
>
>
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Test: Weighted segmentation
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> t <- system.time({
+ fitR <- segment(cnR, weights=w, verbose=1)
+ })
Analyzing: SampleA
> cat("Processing time:\n")
Processing time:
> print(t)
user system elapsed
0.04 0.00 0.05
> print(fitR)
Call:
segment(x = cnR, weights = w, verbose = 1)
ID chrom loc.start loc.end num.mark seg.mean
1 SampleA 1 1.368577 199.0840 209 0.0259
2 SampleA 1 201.604291 301.0669 105 1.0004
3 SampleA 1 303.775112 999.3290 686 -0.0233
>
> # Expected results
> # These were obtained by dput(fitR$output) using DNAcopy v1.19.0
> truth <- structure(list(ID = c("SampleA", "SampleA", "SampleA"), chrom = c(1,
+ 1, 1), loc.start = c(1.36857712641358, 201.604291098192, 303.775111911818
+ ), loc.end = c(199.083976913244, 301.066882908344, 999.329038895667
+ ), num.mark = c(209, 105, 686), seg.mean = c(0.0259, 1.0004,
+ -0.0233)), .Names = c("ID", "chrom", "loc.start", "loc.end",
+ "num.mark", "seg.mean"), row.names = c(NA, -3L), class = "data.frame")
>
> stopifnot(all.equal(fitR$output, truth, tolerance=tol))
>
>
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Cleanup
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Reset to previous random seed
> .Random.seed <- oldSeed
>
> print(sessionInfo())
R version 3.5.1 Patched (2018-07-24 r75005)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows Server 2012 R2 x64 (build 9600)
Matrix products: default
locale:
[1] LC_COLLATE=C
[2] LC_CTYPE=English_United States.1252
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C
[5] LC_TIME=English_United States.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] DNAcopy_1.54.0
loaded via a namespace (and not attached):
[1] compiler_3.5.1
>
>
> ######################################################################
> # HISTORY
> # 2009-06-10
> # o ROBUSTNESS: Added this test to assert that DNAcopy v1.19.2 and
> # newer will numerically give the same results as DNAcopy v1.19.0.
> # This test is ran each time with R CMD check.
> # o Created.
> ######################################################################
>
> proc.time()
user system elapsed
0.46 0.03 0.48
|