R Under development (unstable) (2024-02-16 r85931 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

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.

> library("PSCBS")
PSCBS v0.67.0 successfully loaded. See ?PSCBS for help.
> 
> ## Compare segments
> assertMatchingSegments <- function(fitM, fit) {
+   chrs <- getChromosomes(fitM)
+   segsM <- lapply(chrs, FUN=function(chr) {
+     getSegments(extractChromosome(fitM, chr))
+   })
+   segs <- lapply(fit[chrs], FUN=getSegments)
+   stopifnot(all.equal(segsM, segs, check.attributes=FALSE))
+ }
> 
> ## Simulate data
> set.seed(0xBEEF)
> J <- 1000
> mu <- double(J)
> mu[200:300] <- mu[200:300] + 1
> mu[350:400] <- NA
> mu[650:800] <- mu[650:800] - 1
> eps <- rnorm(J, sd=1/2)
> y <- mu + eps
> x <- sort(runif(length(y), max=length(y))) * 1e5
> 
> data <- list()
> for (chr in 1:2) {
+   data[[chr]] <- data.frame(chromosome=chr, x=x, y=y)
+ }
> data$M <- Reduce(rbind, data)
> 
> ## Segment
> message("*** segmentByCBS()")
*** segmentByCBS()
> fit <- lapply(data, FUN=segmentByCBS)
> print(fit)
[[1]]
  sampleName chromosome       start      end nbrOfLoci    mean
1       <NA>          1    55167.82 20774251       201  0.0164
2       <NA>          1 20774250.85 29320105        99  1.0474
3       <NA>          1 29320104.86 65874675       298 -0.0203
4       <NA>          1 65874675.06 81348129       151 -1.0813
5       <NA>          1 81348129.20 99910827       200 -0.0612

[[2]]
  sampleName chromosome       start      end nbrOfLoci    mean
1       <NA>          2    55167.82 20774251       201  0.0164
2       <NA>          2 20774250.85 29320105        99  1.0474
3       <NA>          2 29320104.86 65874675       298 -0.0203
4       <NA>          2 65874675.06 81348129       151 -1.0813
5       <NA>          2 81348129.20 99910827       200 -0.0612

$M
   sampleName chromosome       start      end nbrOfLoci    mean
1        <NA>          1    55167.82 20774251       201  0.0164
2        <NA>          1 20774250.85 29320105        99  1.0474
3        <NA>          1 29320104.86 65874675       298 -0.0203
4        <NA>          1 65874675.06 81348129       151 -1.0813
5        <NA>          1 81348129.20 99910827       200 -0.0612
6        <NA>         NA          NA       NA        NA      NA
7        <NA>          2    55167.82 20774251       201  0.0164
8        <NA>          2 20774250.85 29320105        99  1.0474
9        <NA>          2 29320104.86 65874675       298 -0.0203
10       <NA>          2 65874675.06 81348129       151 -1.0813
11       <NA>          2 81348129.20 99910827       200 -0.0612

> assertMatchingSegments(fit$M, fit)
> 
> ## Join segments
> message("*** joinSegments()")
*** joinSegments()
> fitj <- lapply(fit, FUN=joinSegments)
> print(fitj)
[[1]]
  sampleName chromosome       start      end nbrOfLoci    mean
1       <NA>          1    55167.82 20774251       201  0.0164
2       <NA>          1 20774250.85 29320105        99  1.0474
3       <NA>          1 29320104.86 65874675       298 -0.0203
4       <NA>          1 65874675.06 81348129       151 -1.0813
5       <NA>          1 81348129.20 99910827       200 -0.0612

[[2]]
  sampleName chromosome       start      end nbrOfLoci    mean
1       <NA>          2    55167.82 20774251       201  0.0164
2       <NA>          2 20774250.85 29320105        99  1.0474
3       <NA>          2 29320104.86 65874675       298 -0.0203
4       <NA>          2 65874675.06 81348129       151 -1.0813
5       <NA>          2 81348129.20 99910827       200 -0.0612

$M
   sampleName chromosome       start      end nbrOfLoci    mean
1        <NA>          1    55167.82 20774251       201  0.0164
2        <NA>          1 20774250.85 29320105        99  1.0474
3        <NA>          1 29320104.86 65874675       298 -0.0203
4        <NA>          1 65874675.06 81348129       151 -1.0813
5        <NA>          1 81348129.20 99910827       200 -0.0612
6        <NA>         NA          NA       NA        NA      NA
7        <NA>          2    55167.82 20774251       201  0.0164
8        <NA>          2 20774250.85 29320105        99  1.0474
9        <NA>          2 29320104.86 65874675       298 -0.0203
10       <NA>          2 65874675.06 81348129       151 -1.0813
11       <NA>          2 81348129.20 99910827       200 -0.0612

> assertMatchingSegments(fitj$M, fitj)
> 
> ## Reset segments
> message("*** resetSegments()")
*** resetSegments()
> fitj <- lapply(fit, FUN=resetSegments)
> print(fitj)
[[1]]
  sampleName chromosome       start      end nbrOfLoci    mean
1       <NA>          1    55167.82 20774251       201  0.0164
2       <NA>          1 20774250.85 29320105        99  1.0474
3       <NA>          1 29320104.86 65874675       298 -0.0203
4       <NA>          1 65874675.06 81348129       151 -1.0813
5       <NA>          1 81348129.20 99910827       200 -0.0612

[[2]]
  sampleName chromosome       start      end nbrOfLoci    mean
1       <NA>          2    55167.82 20774251       201  0.0164
2       <NA>          2 20774250.85 29320105        99  1.0474
3       <NA>          2 29320104.86 65874675       298 -0.0203
4       <NA>          2 65874675.06 81348129       151 -1.0813
5       <NA>          2 81348129.20 99910827       200 -0.0612

$M
   sampleName chromosome       start      end nbrOfLoci    mean
1        <NA>          1    55167.82 20774251       201  0.0164
2        <NA>          1 20774250.85 29320105        99  1.0474
3        <NA>          1 29320104.86 65874675       298 -0.0203
4        <NA>          1 65874675.06 81348129       151 -1.0813
5        <NA>          1 81348129.20 99910827       200 -0.0612
6        <NA>         NA          NA       NA        NA      NA
7        <NA>          2    55167.82 20774251       201  0.0164
8        <NA>          2 20774250.85 29320105        99  1.0474
9        <NA>          2 29320104.86 65874675       298 -0.0203
10       <NA>          2 65874675.06 81348129       151 -1.0813
11       <NA>          2 81348129.20 99910827       200 -0.0612

> assertMatchingSegments(fitj$M, fitj)
> 
> ## Prune by SD undo
> message("*** pruneBySdUndo()")
*** pruneBySdUndo()
> fitp <- lapply(fit, FUN=pruneBySdUndo)
> print(fitp)
[[1]]
  sampleName chromosome    start      end nbrOfLoci        mean
1       <NA>          1 55167.82 99910827       949 -0.07857059

[[2]]
  sampleName chromosome    start      end nbrOfLoci        mean
1       <NA>          2 55167.82 99910827       949 -0.07857059

$M
  sampleName chromosome    start      end nbrOfLoci        mean
1       <NA>          1 55167.82 99910827       949 -0.07857059
2       <NA>         NA       NA       NA        NA          NA
3       <NA>          2 55167.82 99910827       949 -0.07857059

> assertMatchingSegments(fitp$M, fitp)
> 
> ## Prune by hierarchical clustering
> message("*** pruneByHClust()")
*** pruneByHClust()
> fitp <- lapply(fit, FUN=pruneByHClust, k=1L)
> print(fitp)
[[1]]
  sampleName chromosome    start      end nbrOfLoci        mean
1       <NA>          1 55167.82 99910827       949 -0.07857059

[[2]]
  sampleName chromosome    start      end nbrOfLoci        mean
1       <NA>          2 55167.82 99910827       949 -0.07857059

$M
  sampleName chromosome    start      end nbrOfLoci        mean
1       <NA>          1 55167.82 99910827       949 -0.07857059
6       <NA>         NA       NA       NA        NA          NA
7       <NA>          2 55167.82 99910827       949 -0.07857059

> assertMatchingSegments(fitp$M, fitp)
> 
> proc.time()
   user  system elapsed 
   1.09    0.09    1.25