ramon diaz-uriarte (at Phelsuma) authored on 17/04/2018 23:58:39
Showing56 changed files

... ...
@@ -1,8 +1,8 @@
1 1
 Package: OncoSimulR
2 2
 Type: Package
3 3
 Title: Forward Genetic Simulation of Cancer Progression with Epistasis 
4
-Version: 2.9.6
5
-Date: 2017-12-27
4
+Version: 2.9.9
5
+Date: 2018-04-10
6 6
 Authors@R: c(person("Ramon", "Diaz-Uriarte", role = c("aut", "cre"),
7 7
 		     email = "rdiaz02@gmail.com"),
8 8
 	      person("Mark", "Taylor", role = "ctb", email = "ningkiling@gmail.com"))
... ...
@@ -98,7 +98,8 @@ oncoSimulSample <- function(Nindiv,
98 98
                          extraTime = extraTime,
99 99
                          minDetectDrvCloneSz = minDetectDrvCloneSz,
100 100
                          detectionSize = detectionSize,
101
-                         detectionDrivers = detectionDrivers)[, -1, drop = FALSE]
101
+                         detectionDrivers = detectionDrivers,
102
+                         stringsAsFactors = TRUE)[, -1, drop = FALSE]
102 103
 
103 104
     ## FIXME: we are not triggering an error, just a message. This is on
104 105
     ## purpose, since some of these conditions DO provide useful
... ...
@@ -672,11 +673,11 @@ oncoSimulIndiv <- function(fp,
672 673
             if( (!is.list(fixation)) && (!is.vector(fixation))  )
673 674
                 stop("'fixation' must be a list or a vector.")
674 675
             if(!(all(unlist(lapply(fixation, is.vector)))))
675
-                stop("Each element of 'fixation' must be a single element character vector.")
676
-            if(!(all(unlist(lapply(fixation, class)) == "character")))
677
-                stop("Each element of 'fixation' must be a single element character vector.")
676
+                stop("Each element of 'fixation' must be a single element vector.")
677
+            if(!(any(unlist(lapply(fixation, class)) == "character")))
678
+                stop("At least one element of 'fixation' must be a single element character vector.")
678 679
             if(!(all( unlist(lapply(fixation, length)) == 1)))
679
-                stop("Each element of 'fixation' must be a single element character vector.")
680
+                stop("Each element of 'fixation' must be a single element vector.")
680 681
             if(AND_DrvProbExit)
681 682
                 stop("It makes no sense to pass AND_DrvProbExit and a fixation list.")
682 683
         }
... ...
@@ -778,7 +779,8 @@ print.oncosimul <- function(x, ...) {
778 779
         cat("\n")
779 780
         cat("Final population composition:\n")
780 781
         df <- data.frame(Genotype = x$GenotypesLabels,
781
-                         N = x$pops.by.time[nrow(x$pops.by.time), -1])
782
+                         N = x$pops.by.time[nrow(x$pops.by.time), -1],
783
+                         stringsAsFactors = TRUE)
782 784
         print(df)
783 785
     }
784 786
 }
... ...
@@ -833,7 +835,7 @@ summary.oncosimulpop <- function(object, ...) {
833 835
             warning("All simulations failed.")
834 836
             return(NA)
835 837
         }
836
-    as.data.frame(rbindlist(tmp))
838
+    as.data.frame(rbindlist(tmp), stringsAsFactors = TRUE)
837 839
 }
838 840
 
839 841
 
... ...
@@ -1922,7 +1924,8 @@ OncoSimulWide2Long <- function(x) {
1922 1924
     return(data.frame(Time = rep(x$pops.by.time[, 1], nc),
1923 1925
                       Y = y,
1924 1926
                       Drivers = factor(rep(ndr, rep(nr, nc))),
1925
-                      Genotype = rep(genotLabels, rep(nr, nc))))
1927
+                      Genotype = rep(genotLabels, rep(nr, nc)),
1928
+                      stringsAsFactors = TRUE))
1926 1929
 }
1927 1930
 
1928 1931
 
... ...
@@ -83,7 +83,8 @@ plotFitnessLandscape <- function(x, show_labels = TRUE,
83 83
                 
84 84
     dd <- data.frame(muts = mutated,
85 85
                      fitness = tfm$afe$Fitness,
86
-                     label = tfm$afe$Genotype)
86
+                     label = tfm$afe$Genotype,
87
+                     stringsAsFactors = TRUE)
87 88
     cl <- gaj[vv]
88 89
     sg <- data.frame(x_from = mutated[vv[, 1]],
89 90
                      y_from = tfm$afe$Fitness[vv[, 1]],
... ...
@@ -91,7 +92,8 @@ plotFitnessLandscape <- function(x, show_labels = TRUE,
91 92
                      y_to = tfm$afe$Fitness[vv[, 2]],
92 93
                      Change = factor(ifelse(cl == 0, "Neutral",
93 94
                                      ifelse(cl > 0, "Gain", "Loss")),
94
-                                     levels = c("Gain", "Loss", "Neutral")))
95
+                                     levels = c("Gain", "Loss", "Neutral")),
96
+                     stringsAsFactors = TRUE)
95 97
     ## From http://stackoverflow.com/a/17257422
96 98
     number_ticks <- function(n) {function(limits) pretty(limits, n)}
97 99
     
... ...
@@ -601,6 +603,7 @@ peak_valley <- function(x) {
601 603
 ##     ## mutated <- rowSums(gfm[, -ncol(gfm)])
602 604
 ##     gaj <- OncoSimulR:::genot_to_adj_mat(gfm)
603 605
 ##     gaj2 <- OncoSimulR:::filter_inaccessible(gaj, 0)
606
+##     Eh! that is assuming no genotype is inaccessible!
604 607
 ##     stopifnot(all(na.omit(as.vector(gaj == gaj2))))
605 608
 ##     remaining <- as.numeric(colnames(gaj2))
606 609
 ##     ## mutated <- mutated[remaining]
... ...
@@ -41,6 +41,20 @@ to_Magellan <- function(x, file,
41 41
     }
42 42
 }
43 43
 
44
+
45
+
46
+## ## genotype_fitness_matrix -> fitness landscape as data frame
47
+## fmatrix_to_afe <- function(x) {
48
+##     stopifnot(inherits(x, "genotype_fitness_matrix"))
49
+##     y <- x[, -ncol(x)]
50
+##     nn <- apply(y, 1,
51
+##                 function(u) paste(sort(colnames(y)[as.logical(u)]),
52
+##                                   collapse = ", "))
53
+##     nn[nn == ""] <- "WT"
54
+##     return(data.frame(Genotype = nn, Fitness = x[, ncol(x)],
55
+##            stringsAsFactors = FALSE))
56
+## }
57
+
44 58
 to_Fitness_Matrix <- function(x, max_num_genotypes) {
45 59
     ## A general converter. Ready to be used by plotFitnessLandscape and
46 60
     ## Magellan exporter.
... ...
@@ -54,6 +68,7 @@ to_Fitness_Matrix <- function(x, max_num_genotypes) {
54 68
         ## if( (is.null(colnames(x))) || any(grepl("^$", colnames(x))))
55 69
         ##    stop("Matrix x must have column names")
56 70
 
71
+        ## This could use fmatrix_to_afe, above!!!
57 72
         ## Major change as of flfast: no longer using from_genotype_fitness
58 73
         afe <- evalAllGenotypes(allFitnessEffects(
59 74
             genotFitness = x
... ...
@@ -63,7 +63,7 @@ check.gm <- function(gm) {
63 63
 }
64 64
 
65 65
 gtm2 <- function(x) {
66
-    data.frame(cbind(nice.vector.eo(x, ","), x))
66
+    data.frame(cbind(nice.vector.eo(x, ","), x), stringsAsFactors = TRUE)
67 67
 }
68 68
 
69 69
 ## nice.vector.eo <- function(z, sep) {
... ...
@@ -88,7 +88,8 @@ gm.to.geneModuleL <- function(gm, one.to.one) {
88 88
     gm <- check.gm(gm)
89 89
    
90 90
     ## the named vector with the mapping into the long geneModule df
91
-    geneMod <- as.data.frame(rbindlist(lapply(gm, gtm2)))
91
+    geneMod <- as.data.frame(rbindlist(lapply(gm, gtm2)),
92
+                             stringsAsFactors = TRUE) ## this stringsAsFactors is key
92 93
     geneMod$Module <- names(gm)[geneMod[, 2]] ## reverse lookup table
93 94
     colnames(geneMod)[1] <- c("Gene")
94 95
     geneMod <- geneMod[, -2]
... ...
@@ -285,7 +286,8 @@ epist.order.to.pairs.modules <- function(x, sep, rm.sign = TRUE) {
285 286
 to.pairs.modules <- function(x, sep, rm.sign = TRUE) {
286 287
     df <- data.frame(rbindlist(
287 288
         lapply(names(x),
288
-               function(z) epist.order.to.pairs.modules(z, sep))))
289
+               function(z) epist.order.to.pairs.modules(z, sep))),
290
+        stringsAsFactors = TRUE)
289 291
     if(nrow(df) == 0L) { ## if only single genes in epist, we get nothing here.
290 292
         return(df)
291 293
     } else {
... ...
@@ -1780,6 +1782,9 @@ nr_oncoSimul.internal <- function(rFE,
1780 1782
                                   MMUEF = NULL, ## avoid partial matching, and set default
1781 1783
                                   fixation = NULL ## avoid partial matching
1782 1784
                                   ) {
1785
+
1786
+    default_min_successive_fixation <- 50 ## yes, set at this for now
1787
+    
1783 1788
     if(!inherits(rFE, "fitnessEffects"))
1784 1789
         stop(paste("rFE must be an object of class fitnessEffects",
1785 1790
                    "as created, for instance, with function",
... ...
@@ -1939,11 +1944,75 @@ nr_oncoSimul.internal <- function(rFE,
1939 1944
     ## if( is.null(n2)) n2 <- -9
1940 1945
 
1941 1946
     ## call <- match.call()
1942
-    
1943 1947
     ## Process the fixed list, if any
1944 1948
     if(!is_null_na(fixation)) {
1945 1949
         ng <- namedGenes
1946
-        rownames(ng) <- namedGenes[, "Gene"]
1950
+        ## rownames(ng) <- namedGenes[, "Gene"]
1951
+        ## Proposed extension to have exact matching of genotypes
1952
+        ng <- rbind(
1953
+             data.frame(Gene = "_", GeneNumID = -9, stringsAsFactors = FALSE),
1954
+             ng)
1955
+        rownames(ng) <- ng[, "Gene"]
1956
+        ## FIXME
1957
+        ## Later, accept a last argument, called tolerance.
1958
+        ## If not present, set to 0
1959
+        ## and then, at at the head of fixation_list below
1960
+        if(is.list(fixation)) {
1961
+            if(
1962
+            (is.null(fixation[["fixation_tolerance"]])) ||
1963
+            (is.na(fixation[["fixation_tolerance"]]))) {
1964
+                fixation_tolerance <- 0
1965
+            } else {
1966
+                fixation_tolerance <- as.numeric(fixation[["fixation_tolerance"]])
1967
+                fixation <- fixation[-which(names(fixation) == "fixation_tolerance")]
1968
+            }
1969
+            if(
1970
+            (is.null(fixation[["min_successive_fixation"]])) ||
1971
+            (is.na(fixation[["min_successive_fixation"]]))) {
1972
+                min_successive_fixation <- default_min_successive_fixation
1973
+            } else {
1974
+                min_successive_fixation <- as.integer(fixation[["min_successive_fixation"]])
1975
+                fixation <- fixation[-which(names(fixation) == "min_successive_fixation")]
1976
+            }
1977
+            if(
1978
+            (is.null(fixation[["fixation_min_size"]])) ||
1979
+            (is.na(fixation[["fixation_min_size"]]))) {
1980
+                fixation_min_size <- 0
1981
+            } else {
1982
+                fixation_min_size <- as.integer(fixation[["fixation_min_size"]])
1983
+                fixation <- fixation[-which(names(fixation) == "fixation_min_size")]
1984
+            }
1985
+            
1986
+        } else {
1987
+            if(is_null_na(fixation["fixation_tolerance"])) {
1988
+                fixation_tolerance <- 0
1989
+            } else {
1990
+                fixation_tolerance <- as.numeric(fixation["fixation_tolerance"])
1991
+                fixation <- fixation[-which(names(fixation) == "fixation_tolerance")]
1992
+            }
1993
+            if(is_null_na(fixation["min_successive_fixation"])) {
1994
+                min_successive_fixation <- default_min_successive_fixation
1995
+            } else {
1996
+                min_successive_fixation <- as.integer(fixation["min_successive_fixation"])
1997
+                fixation <- fixation[-which(names(fixation) == "min_successive_fixation")]
1998
+            }
1999
+            if(is_null_na(fixation["fixation_min_size"])) {
2000
+                fixation_min_size <- 0
2001
+            } else {
2002
+                fixation_min_size <- as.integer(fixation["fixation_min_size"])
2003
+                fixation <- fixation[-which(names(fixation) == "fixation_min_size")]
2004
+            }
2005
+        }
2006
+
2007
+        if( (fixation_tolerance > 1) || (fixation_tolerance < 0) )
2008
+                    stop("Impossible range for fixation tolerance")
2009
+
2010
+        if( (min_successive_fixation < 0) )
2011
+                    stop("Impossible range for min_successive_fixation")
2012
+
2013
+        if( (fixation_min_size < 0) )
2014
+                    stop("Impossible range for fixation_min_size")
2015
+
1947 2016
         ## Usual genotype specification and might allow ordered vectors
1948 2017
         ## in the future
1949 2018
         fixation_b <- lapply(fixation, nice.vector.eo, sep = ",")
... ...
@@ -1956,6 +2025,10 @@ nr_oncoSimul.internal <- function(rFE,
1956 2025
                        " in the fitness effects."))
1957 2026
         ## Sorting here is crucial!!
1958 2027
         fixation_list <- lapply(fixation_b, function(x) sort(ng[x, 2]))
2028
+        fixation_list <- list(fixation_list = fixation_list,
2029
+                              fixation_tolerance = fixation_tolerance,
2030
+                              min_successive_fixation = min_successive_fixation,
2031
+                              fixation_min_size = fixation_min_size)
1959 2032
     } else {
1960 2033
         fixation_list <- list()
1961 2034
     }
... ...
@@ -2219,8 +2292,8 @@ detectionProbCheckParse <- function(x, initSize, verbosity) {
2219 2292
     
2220 2293
     if(x["checkSizePEvery"] <= 0)
2221 2294
         stop("checkSizePEvery <= 0")
2222
-    if(x["PDBaseline"] < 0)
2223
-        stop("PDBaseline < 0")
2295
+    if(x["PDBaseline"] <= 0)
2296
+        stop("PDBaseline <= 0")
2224 2297
     
2225 2298
     if(!is_null_na(x["n2"])) {
2226 2299
         if(x["n2"] <= x["PDBaseline"])
... ...
@@ -2257,7 +2330,8 @@ sampledGenotypes <- function(y, genes = NULL) {
2257 2330
     ## ))
2258 2331
     df <- data.frame(table(
2259 2332
         apply(y, 1, genotlabel),
2260
-        useNA = "ifany"))
2333
+        useNA = "ifany"),
2334
+        stringsAsFactors = TRUE)
2261 2335
 
2262 2336
     gn <- as.character(df[, 1])
2263 2337
     gn[gn == ""] <- "WT"
... ...
@@ -38,7 +38,7 @@ rfitness <- function(g, c= 0.5,
38 38
     ## FIXME future: do this with order too?
39 39
     ##    - do not generate a matrix of genotypes but a matrix of ordered genot.
40 40
     wt_is_1 = match.arg(wt_is_1)
41
-    
41
+    if(is_null_na(g)) stop("Number of genes argument (g) is null or NA")
42 42
     m <- generate_matrix_genotypes(g)
43 43
     done <- FALSE
44 44
     ## attempts <- 0 ## for debugging/tracking purposes
... ...
@@ -1,3 +1,16 @@
1
+Changes in version 2.9.9 (2018-04-10):
2
+	- probDetect mechanism changed. This could be a BREAKING CHANGE.
3
+	  The expression divides by the baseline. For fixed initSize, this
4
+	  is simply a matter of changing the cPDetect.
5
+
6
+Changes in version 2.9.8 (2018-03-26):
7
+	- fixation allows exact genotypes, includes tolerance,
8
+	and checks for a successive number of specified periods
9
+
10
+Changes in version 2.9.7 (2018-02-20):
11
+	- fixed crash in some conditions when run with
12
+	stringsAsFactors = FALSE as global option
13
+	
1 14
 Changes in version 2.9.6 (2017-12-27):
2 15
 	- Updated citation.
3 16
 	- An example (in miscell-files) about using and stopping with
4 17
new file mode 100644
5 18
Binary files /dev/null and b/inst/testdata_fee.RData differ
... ...
@@ -442,20 +442,18 @@ of \code{sampleEvery} that is larger than or equal to \code{keepEvery}.
442 442
   probability of reaching cancer for a set of simulations to be
443 443
   accepted.}
444 444
 
445
-\item{max.wall.time}{
446
-  Maximum wall time for each individual simulation run. If the
447
-  simulation is not done in this time, it is aborted.
448
-
445
+\item{max.wall.time}{ Maximum wall time for the simulation of one
446
+  individual (over all \code{max.num.tries}). If the simulation is
447
+  not done in this time, it is aborted.  %% (If \code{max.num.tries = k},
448
+  %% time is kept track of over the k attempts;)
449 449
 }
450 450
 
451 451
 \item{max.wall.time.total}{
452
-
453 452
   Maximum wall time for all the simulations (when using
454 453
   \code{oncoSimulSample}), in seconds. If the simulation is not
455 454
   completed in this time, it is aborted. To prevent problems from a
456 455
   single individual simulation going wild, this limit is also enforced
457 456
   per simulation (so the run can be aborted directly from C++).
458
-
459 457
 }
460 458
 
461 459
 \item{errorHitMaxTries}{ If TRUE (the default) a simulation that reaches
... ...
@@ -522,13 +520,44 @@ of the individual done, and the number of attempts and time used.}
522 520
   with \code{fixation} is not allowed (as it does not make much sense).}
523 521
 
524 522
 \item{fixation}{If non-NULL, a list or a vector, where each element of
525
-  is a string with a gene or a gene combination. Simulations will stop
526
-  as soon as any of the genes or gene combinations are fixed (i.e.,
527
-  reach frequency of one). If you pass gene combinations, separate genes
523
+  is a string with a gene or a gene combination or a genotype (see
524
+  below). Simulations will stop as soon as any of the genes or gene
525
+  combinations or genotypes are fixed (i.e., reach a minimal
526
+  frequency). If you pass gene combinations or genotypes, separate genes
528 527
   with commas (not '>'); this means order is not (yet?)  supported. This
529 528
   way of specifying gene combinations is the same as the one used for
530 529
   \code{initMutant} and \code{\link{evalGenotype}}.
531 530
 
531
+  To differentiate between gene combinations and specific genotypes,
532
+  genotypes are specified by prepending them with a "_,". For instance,
533
+  \code{fixation = c("A", "B, C")} specifies stopping on any genotypes
534
+  with those gene combinations. In contrast, \code{fixation = c("_,A",
535
+  "_,B, C" )} specifies stopping only on gentoypes "A" or "B, C". See
536
+  the vignette for further examples.
537
+  
538
+
539
+  In addition to the gene combinations or genotypes themeselves, you can
540
+  add to the list or vector the named elements
541
+  \code{fixation_tolerance}, \code{min_successive_fixation} and
542
+  \code{fixation_min_size}. \code{fixation_tolerance}: fixation is
543
+  considered to have happened if the genotype/gene combinations
544
+  specified as genotypes/gene combinations for fixation have reached a
545
+  frequency \code{> 1 - fixation_tolerance}. (The default is 0, so we
546
+  ask for genotypes/gene combinations with a frequency of 1, which might
547
+  not be what you want with large mutation rates and complex fitness
548
+  landscape with genotypes of similar
549
+  fitness.). \code{min_successive_fixation}: during how many successive
550
+  sampling periods the conditions of fixation need to be fulfilled
551
+  before declaring fixation. These must be successive sampling periods
552
+  without interruptions (i.e., a single period when the condition is not
553
+  fulfilled will set the counter to 0). This can help to exclude short,
554
+  transitional, local maxima that are quickly replaced by other
555
+  genotypes. (The default is 50, but this is probably too small for
556
+  ``real life'' usage). \code{fixation_min_size}: you might only want to
557
+  consider fixation to have happened if a minimal size has been reached
558
+  (this can help weed out local maxima that have fitness that is barely
559
+  above that of the wild-type genotype). (The default is 0).
560
+
532 561
   Using this option with \code{AND_DrvProbExit} is not allowed (as it
533 562
   does not make much sense). This option is not allowed either with the
534 563
   old v.1 specification.}
... ...
@@ -567,7 +596,7 @@ of the individual done, and the number of attempts and time used.}
567 596
   When using oncoSimulPop, if you want reproducibility, you might want
568 597
   to, in addition to setting \code{seed = NULL}, also do
569 598
   \code{RNGkind("L'Ecuyer-CMRG")} as we use
570
-  \code{\link[parallel]{mclapply}}; look at the vignette of
599
+  \code{\link{mclapply}}; look at the vignette of
571 600
   \pkg{parallel}.
572 601
 
573 602
 }
... ...
@@ -641,7 +670,7 @@ of the individual done, and the number of attempts and time used.}
641 670
   uniform number). Probability of detection changes with population size
642 671
   according to the function
643 672
   
644
-  \deqn{ 1 - e^{-cPDetect (populationsize - PDBaseline)}}.
673
+  \deqn{ 1 - e^{-cPDetect ( (populationsize - PDBaseline)/PDBaseline )}}.
645 674
 
646 675
   You can pass \code{cPDetect} manually (you will need to set \code{n2}
647 676
   and \code{p2} to NA). However, it might be more intuitive to specify
... ...
@@ -73,7 +73,7 @@ mean \code{mu} and standard deviation \code{sd}).}
73 73
   it is up to you to make sure that the range of the scale argument
74 74
   includes 1 or you might not get what you want). Note that using this
75 75
   option can easily lead to landscapes with no accessible genotypes
76
-  (unless you also use \code{scale}).
76
+  (even if you also use \code{scale}).
77 77
 
78 78
   If "none", the fitness of the wildtype is not touched.  }
79 79
 
... ...
@@ -230,6 +230,10 @@ void nr_totPopSize_and_fill_out_crude_P(int& outNS_i,
230 230
 					std::mt19937& ran_gen,
231 231
 					const bool& AND_DrvProbExit,
232 232
 					const std::vector<std::vector<int> >& fixation_l,
233
+					const double& fixation_tolerance,
234
+					const int& min_successive_fixation,
235
+					const double& fixation_min_size,
236
+					int& num_successive_fixation,
233 237
 					POM& pom,
234 238
 					const std::map<int, std::string>& intName,
235 239
 					const fitness_as_genes& genesInFitness,
... ...
@@ -275,23 +279,55 @@ void nr_totPopSize_and_fill_out_crude_P(int& outNS_i,
275 279
 	std::vector<int> thisg = allGenesinGenotype(Genotypes[i]);
276 280
 	for(size_t fc = 0; fc != popSize_fixation.size(); ++fc) {
277 281
 	  // Yes, fixation_l is sorted in R.
278
-	  if(std::includes(thisg.begin(), thisg.end(),
279
-			   fixation_l[fc].begin(), fixation_l[fc].end()) ) {
280
-	    popSize_fixation[fc] += popParams[i].popSize;
282
+	  // if fixation_l[fc] starts with a -9, we are asking
283
+	  // for exact genotype equality
284
+	  if(fixation_l[fc][0] == -9) {
285
+	    // // exact genotype identity?
286
+	    std::vector<int> this_fix(fixation_l[fc].begin() + 1,
287
+				      fixation_l[fc].end());
288
+	    if(thisg == this_fix) {
289
+	      popSize_fixation[fc] = popParams[i].popSize;
290
+	    }
291
+	  } else {	  
292
+	  // gene combination in fixation element present in genotype?
293
+	    if(std::includes(thisg.begin(), thisg.end(),
294
+			     fixation_l[fc].begin(), fixation_l[fc].end()) ) {
295
+	      popSize_fixation[fc] += popParams[i].popSize;
296
+	    }
281 297
 	  }
282 298
 	}
283 299
       }
284 300
       // Any fixated? But avoid trivial of totPopSize of 0!
285 301
       // Now check of > 0 is redundant as we check totPopSize > 0
302
+      // FIXME do we want tolerance around that value? 
286 303
       double max_popSize_fixation =
287 304
 	*std::max_element(popSize_fixation.begin(), popSize_fixation.end());
288
-      if( (max_popSize_fixation > 0 ) &&
289
-	  (max_popSize_fixation == totPopSize)) {
290
-	fixated = true;
305
+      if( (max_popSize_fixation >= fixation_min_size ) &&
306
+	  (max_popSize_fixation >= (totPopSize * (1 - fixation_tolerance) )) ) {
307
+	++num_successive_fixation;
308
+	// DP1("increased num_successive_fixation");
309
+	if( num_successive_fixation >= min_successive_fixation) fixated = true;
310
+      } else {
311
+	// DP1("zeroed num_successive_fixation");
312
+	num_successive_fixation = 0;
291 313
       }
292 314
     }
293 315
   }
316
+
317
+  // // DEBUG
318
+  // if(fixated) {
319
+  //   // print fixation_l
320
+  //   // print popSize_fixation
321
+  //   // print totPopSize
322
+  //   DP1("popSize_fixation");
323
+  //   for(size_t fc = 0; fc != popSize_fixation.size(); ++fc) {
324
+  //     DP2(fc);
325
+  //     DP2(popSize_fixation[fc]);
326
+  //   }
327
+  //   DP2(totPopSize);
294 328
     
329
+  // }
330
+  
295 331
   if (keepEvery < 0) {
296 332
     storeThis = false;
297 333
   } else if( currentTime >= (lastStoredSample + keepEvery) ) {
... ...
@@ -326,7 +362,20 @@ void nr_totPopSize_and_fill_out_crude_P(int& outNS_i,
326 362
     checkSizePNow = false;
327 363
   }
328 364
 
365
+  // We do not verify that conditions for exiting are also satisfied
366
+  // at the exit time when extraTime > 0. We could do that,
367
+  // checking again for the conditions (or the reasonable conditions, so
368
+  // probably not detectSizeP). For instance, with fixated.
369
+
370
+  // For fixated in particular, note that we evaluate fixation always, but
371
+  // we might be exiting when there is no longer fixation.  But the logic
372
+  // with fixation is probably to use as large a min_successive_fixation
373
+  // as desired and no extraTime.
374
+
375
+  // Probably would not need to check lastMaxDr and popSizeOverDDr
376
+  // as those should never decrease. Really?? FIXME
329 377
 
378
+  
330 379
   if(AND_DrvProbExit) {
331 380
     // The AND of detectionProb and drivers
332 381
     // fixated plays no role here, and cannot be passed from R
... ...
@@ -362,8 +411,12 @@ void nr_totPopSize_and_fill_out_crude_P(int& outNS_i,
362 411
 	  done_at = currentTime + extraTime;
363 412
 	}
364 413
       } else if (currentTime >= done_at) {
365
-  	simulsDone = true;
366
-  	reachDetection = true; 
414
+	// if(fixated) {
415
+	  simulsDone = true;
416
+	  reachDetection = true;
417
+	// } else {
418
+	//   done_at = -1;
419
+	// }
367 420
       }
368 421
     } else if( (fixated) ||
369 422
 	       (totPopSize >= detectionSize) ||
... ...
@@ -911,6 +964,9 @@ static void nr_innerBNB (const fitnessEffectsAll& fitnessEffects,
911 964
 			const double& checkSizePEvery,
912 965
 			const bool& AND_DrvProbExit,
913 966
 			const std::vector< std::vector<int> >& fixation_l,
967
+			 const double& fixation_tolerance,
968
+			 const int& min_successive_fixation,
969
+			 const double& fixation_min_size,
914 970
 			 int& ti_dbl_min,
915 971
 			 int& ti_e3,
916 972
 			 std::map<std::string, std::string>& lod,
... ...
@@ -1089,6 +1145,10 @@ static void nr_innerBNB (const fitnessEffectsAll& fitnessEffects,
1089 1145
   int lastMaxDr = 0;
1090 1146
   double done_at = -9;
1091 1147
 
1148
+
1149
+  int num_successive_fixation = 0; // none so far
1150
+
1151
+  
1092 1152
 #ifdef MIN_RATIO_MUTS_NR
1093 1153
   g_min_birth_mut_ratio_nr = DBL_MAX;
1094 1154
   g_min_death_mut_ratio_nr = DBL_MAX;
... ...
@@ -1881,6 +1941,10 @@ static void nr_innerBNB (const fitnessEffectsAll& fitnessEffects,
1881 1941
 					 ran_gen,
1882 1942
 					 AND_DrvProbExit,
1883 1943
 					 fixation_l,
1944
+					 fixation_tolerance,
1945
+					 min_successive_fixation,
1946
+					 fixation_min_size,
1947
+					 num_successive_fixation,
1884 1948
 					 pom, intName,
1885 1949
 					 genesInFitness); //keepEvery is for thinning
1886 1950
       if(verbosity >= 3) {
... ...
@@ -2011,6 +2075,7 @@ Rcpp::List nr_BNB_Algo5(Rcpp::List rFE,
2011 2075
 
2012 2076
   double cPDetect = cPDetect_i;
2013 2077
   if( (n2 > 0) && (p2 > 0) ) {
2078
+    if (PDBaseline <= 0) throw std::range_error("PDBaseline <= 0");
2014 2079
     cPDetect = set_cPDetect(n2, p2, PDBaseline);
2015 2080
     if(verbosity >= 1)
2016 2081
       Rcpp::Rcout << "  cPDetect set at " << cPDetect << "\n";
... ...
@@ -2041,11 +2106,22 @@ Rcpp::List nr_BNB_Algo5(Rcpp::List rFE,
2041 2106
   }
2042 2107
 
2043 2108
   // fixation: run until some genotype combinations fixed
2044
-  std::vector < std::vector<int> > fixation_l(fixation_i.size());
2109
+  
2110
+  double fixation_tolerance = -9;
2111
+  int min_successive_fixation = 100;
2112
+  double fixation_min_size = 0.0;
2113
+  std::vector < std::vector<int> > fixation_l;
2114
+
2045 2115
   if( fixation_i.size() != 0 ) {
2046
-    fixation_l = list_to_vector_of_int_vectors(fixation_i);
2116
+    Rcpp::List fggl = fixation_i["fixation_list"] ;
2117
+    fixation_l = list_to_vector_of_int_vectors(fggl); // FIXME
2118
+    fixation_tolerance = Rcpp::as<double>(fixation_i["fixation_tolerance"]);
2119
+    min_successive_fixation = Rcpp::as<int>(fixation_i["min_successive_fixation"]);
2120
+    fixation_min_size = Rcpp::as<double>(fixation_i["fixation_min_size"]);
2121
+  } else {
2122
+    fixation_l.resize(0); // explicit
2047 2123
   }
2048
-
2124
+ 
2049 2125
   
2050 2126
   bool runAgain = true;
2051 2127
   bool reachDetection = false;
... ...
@@ -2221,6 +2297,9 @@ Rcpp::List nr_BNB_Algo5(Rcpp::List rFE,
2221 2297
 		  checkSizePEvery,
2222 2298
 		  AND_DrvProbExit,
2223 2299
 		  fixation_l,
2300
+		  fixation_tolerance,
2301
+		  min_successive_fixation,
2302
+		  fixation_min_size,
2224 2303
 		  ti_dbl_min,
2225 2304
 		  ti_e3,
2226 2305
 		  lod,
... ...
@@ -298,6 +298,11 @@ double ti_nextTime_tmax_2_st(const spParamsP& spP,
298 298
 	// throw std::range_error("ti set to DBL_MIN");
299 299
 	// Even just touching DBL_MIN is enough to want a rerunExcept;
300 300
 	// no need for it to be 0.0.
301
+	
302
+	// Trying to understand what happens
303
+	Rcpp::Rcout << "         ti set to DBL_MIN: spP.popSize = " << spP.popSize << "\n";
304
+	// It seems poSize over 1e8, and even 3.5 e7 can trigger this exception (depending
305
+	// on mutation rate, of course)
301 306
 	throw rerunExcept("ti set to DBL_MIN");
302 307
       }
303 308
       if(ti < (2*DBL_MIN)) ++ti_e3; // Counting how often this happens.
... ...
@@ -74,9 +74,12 @@ double prodMuts(const std::vector<double>& s) {
74 74
 		    std::multiplies<double>());
75 75
 }
76 76
 
77
+
78
+
79
+// new cPDetect
77 80
 double set_cPDetect(const double n2, const double p2,
78 81
 		    const double PDBaseline) {
79
-  return (-log(1.0 - p2)/(n2 - PDBaseline));
82
+  return ( -log(1.0 - p2) *  (PDBaseline / (n2 - PDBaseline)) );
80 83
 }
81 84
 
82 85
 // Next two are identical, except for scaling the k. Use the simplest.
... ...
@@ -85,19 +88,37 @@ double probDetectSize(const double n, const double cPDetect,
85 88
   if(n <= PDBaseline) {
86 89
     return 0;
87 90
   } else {
88
-    return (1 - exp( -cPDetect * (n - PDBaseline)));
91
+    return (1 - exp( -cPDetect * ( (n - PDBaseline)/PDBaseline ) ));
89 92
   }
90 93
 }
91 94
 
92
-// double prob_exit_ratio(const double n, const double k, const double baseline) {
93
-//   if(n <= baseline) {
95
+
96
+// Former cpDetect mechanism
97
+
98
+// double set_cPDetect(const double n2, const double p2,
99
+// 		    const double PDBaseline) {
100
+//   return (-log(1.0 - p2)/(n2 - PDBaseline));
101
+// }
102
+
103
+// // Next two are identical, except for scaling the k. Use the simplest.
104
+// double probDetectSize(const double n, const double cPDetect,
105
+// 		      const double PDBaseline) {
106
+//   if(n <= PDBaseline) {
94 107
 //     return 0;
95 108
 //   } else {
96
-//     return (1 - exp( -c * ( (n - baseline)/baseline)));
109
+//     return (1 - exp( -cPDetect * (n - PDBaseline)));
97 110
 //   }
98 111
 // }
99 112
 
113
+// // double prob_exit_ratio(const double n, const double k, const double baseline) {
114
+// //   if(n <= baseline) {
115
+// //     return 0;
116
+// //   } else {
117
+// //     return (1 - exp( -c * ( (n - baseline)/baseline)));
118
+// //   }
119
+// // }
100 120
 
121
+// is this detected, by the probability of detection as a function of size?
101 122
 bool detectedSizeP(const double n, const double cPDetect,
102 123
 			const double PDBaseline, std::mt19937& ran_gen) {
103 124
   if(cPDetect < 0) {
... ...
@@ -115,6 +136,8 @@ bool detectedSizeP(const double n, const double cPDetect,
115 136
   }
116 137
 }
117 138
 
139
+
140
+
118 141
 bool operator==(const Genotype& lhs, const Genotype& rhs) {
119 142
   return (lhs.orderEff == rhs.orderEff) &&
120 143
     (lhs.epistRtEff == rhs.epistRtEff) &&
... ...
@@ -1,5 +1,11 @@
1 1
 ## RNGkind("Mersenne-Twister")
2
-cat(date())
2
+
3
+cat(paste("\n Starting exercise-plotting-code long at", date()))
4
+cat(paste("\n             a runif", runif(1), "\n"))
5
+cat(paste("\n             a runif", runif(1), "\n"))
6
+date()
7
+
8
+
3 9
 test_that("exercising plotClonePhylog", {
4 10
               data(examplesFitnessEffects)
5 11
               tmp <-  oncoSimulIndiv(examplesFitnessEffects[["o3"]],
... ...
@@ -26,6 +32,10 @@ test_that("exercising plotClonePhylog", {
26 32
               plotClonePhylog(tmp, N = 10, keepEvents = TRUE)
27 33
               ## Reaching the fixOverlap code
28 34
               plotClonePhylog(tmp, N = 0, timeEvents = TRUE)
35
+              expect_true(TRUE) ## dummy, to prevent the
36
+              ## attempt to apply non-function
37
+              ## If plotting failed, this would fail
38
+              expect_error(plotClonePhylog(c(1, 2)))
29 39
           })
30 40
 cat(date())
31 41
 
... ...
@@ -58,74 +68,12 @@ test_that("exercising the fitnessEffects plotting code", {
58 68
               plot(fp4m, "igraph", layout = igraph::layout.reingold.tilford, 
59 69
                    expandModules = TRUE, autofit = TRUE)
60 70
               plot(fp4m, expandModules = TRUE, autofit = TRUE)
71
+              expect_true(TRUE) ## dummy, to prevent the
72
+              ## attempt to apply non-function
73
+              ## If plotting failed, this would fail
61 74
           })
62 75
 date()
63 76
 
64
-
65
-
66
-
67
-date()
68
-test_that("stacked, stream, genotypes and some colors", {
69
-    data(examplesFitnessEffects)
70
-    max.tries <- 4
71
-    for(i in 1:max.tries) {
72
-      tmp <-  oncoSimulIndiv(examplesFitnessEffects[["o3"]],
73
-                             model = "McFL", 
74
-                             mu = 5e-5,
75
-                             detectionSize = 1e8, 
76
-                             detectionDrivers = 3,
77
-                             sampleEvery = 0.025,
78
-                             max.num.tries = 10,
79
-                             keepEvery = 5,
80
-                             initSize = 2000,
81
-                             finalTime = 3000,
82
-                             onlyCancer = FALSE, detectionProb = NA,
83
-                             keepPhylog = TRUE)
84
-      
85
-      if(nrow(tmp$pops.by.time) >= 5) {
86
-          break
87
-      } else {
88
-          cat("\n hummm.. had to run again in the plot")
89
-          if(i >= max.tries) {
90
-              print(tmp)
91
-            stop("stream will break")
92
-          }
93
-      }
94
-    }
95
-    plot(tmp, type = "stacked", show = "genotypes")
96
-    plot(tmp, type = "stream", show = "genotypes")
97
-      plot(tmp, type = "line", show = "genotypes")
98
-
99
-      plot(tmp, type = "stacked", show = "drivers")
100
-      plot(tmp, type = "stream", show = "drivers")
101
-      plot(tmp, type = "line", show = "drivers")
102
-
103
-      plot(tmp, type = "stacked", order.method = "max")
104
-      plot(tmp, type = "stacked", order.method = "first")
105
-
106
-      plot(tmp, type = "stream", order.method = "max")
107
-      plot(tmp, type = "stream", order.method = "first")
108
-
109
-      plot(tmp, type = "stream", stream.center = TRUE)
110
-      plot(tmp, type = "stream", stream.center = FALSE)
111
-
112
-      plot(tmp, type = "stream", stream.center = TRUE, log = "x")
113
-      plot(tmp, type = "stacked", stream.center = TRUE, log = "x")
114
-      
115
-      plot(tmp, type = "stacked", show = "genotypes",
116
-           breakSortColors = "random")
117
-      plot(tmp, type = "stream", show = "genotypes",
118
-           breakSortColors = "distave")
119
-
120
-      plot(tmp, type = "stacked", show = "genotypes", col = rainbow(9))
121
-      plot(tmp, type = "stream", show = "genotypes", col = rainbow(3))
122
-      plot(tmp, type = "line", show = "genotypes", col = rainbow(20))
123
-      
124
-})
125
-date()
126
-
127
-
128
-
129 77
 test_that("xlab, ylab, ylim, xlim can be passed", {
130 78
     data(examplePosets)
131 79
     p701 <- examplePosets[["p701"]]
... ...
@@ -233,6 +181,11 @@ test_that("xlab, ylab, ylim, xlim can be passed", {
233 181
          ylab = "ylab", ylim = c(-100, 1000),
234 182
          xlim = c(20, 70),
235 183
          plotDrivers = TRUE)
184
+    expect_true(TRUE) ## dummy, to prevent the
185
+    ## attempt to apply non-function
186
+    ## If plotting failed, this would fail
187
+    expect_error(plot(e1, type = "stremaitoooihoh"))
188
+    
236 189
 })
237 190
 
238 191
 
... ...
@@ -271,32 +224,108 @@ test_that("oncosimul v.1 objects and genotype plotting", {
271 224
     plot(p1, type = "stacked", show = "genotypes", thinData = TRUE)
272 225
     plot(p1, type = "stream", show = "genotypes", thinData = TRUE)
273 226
     plot(p1, type = "line", show = "genotypes", thinData = TRUE)
227
+    expect_true(TRUE) ## dummy, to prevent the
228
+    ## attempt to apply non-function
229
+    ## If plotting failed, this would fail
230
+    expect_error(plot(tmp, type = "linito"))
274 231
 })
275 232
 date()
276 233
 
277 234
 
235
+## The following are not run because of the weird issue
236
+## using test_dir. But I test for colors and type in the
237
+## usual, regular, testing (test.exercise-plotting-code.R)
278 238
 
279 239
 
280
-test_that("passing colors", {
281
-    data(examplePosets)
282
-    ## An object of class oncosimul
283
-    p705 <- examplePosets[["p705"]]
284
-    max.tries <- 4
285
-    for(i in 1:max.tries) {
286
-    p1 <- oncoSimulIndiv(p705)
287
-    if(nrow(p1$pops.by.time) >= 11) {
288
-            break
289
-    } else {
290
-        cat("\n hummm.. had to run again in the plot")
291
-        if(i >= max.tries) {
292
-            print(p1)
293
-            stop("stream will break")
294
-        }
295
-    }
296
-    }
297
-    
298
-    class(p1)
299
-    plot(p1, type = "stacked", show = "genotypes", col = rainbow(8))
300
-    plot(p1, type = "stream", show = "genotypes", col = rainbow(18))
301
-    plot(p1, type = "line", show = "genotypes", col = rainbow(3))
302
-})
240
+
241
+## test_that("passing colors", {
242
+##     data(examplePosets)
243
+##     ## An object of class oncosimul
244
+##     p705 <- examplePosets[["p705"]]
245
+##     max.tries <- 4
246
+##     for(i in 1:max.tries) {
247
+##     p1 <- oncoSimulIndiv(p705)
248
+##     if(nrow(p1$pops.by.time) >= 11) {
249
+##             break
250
+##     } else {
251
+##         cat("\n hummm.. had to run again in the plot")
252
+##         if(i >= max.tries) {
253
+##             print(p1)
254
+##             stop("stream will break")
255
+##         }
256
+##     }
257
+##     }
258
+##     ## class(p1)
259
+##     plot(p1, type = "stacked", show = "genotypes", thinData = TRUE)
260
+##     ## with newest testthat, the next make if fail with test_dir, but
261
+##     ## not if run from REPL. Go figure
262
+##     plot(p1, type = "stacked", show = "genotypes", col = rainbow(8))
263
+##     plot(p1, type = "stream", show = "genotypes", col = rainbow(18))
264
+##     plot(p1, type = "line", show = "genotypes", col = rainbow(3))
265
+##     expect_true(TRUE) ## dummy, to prevent the
266
+##     ## attempt to apply non-function
267
+##     ## If plotting failed, this would fail
268
+##     expect_error(plot(p1, type = "linito"))
269
+## })
270
+
271
+
272
+
273
+
274
+
275
+## date()
276
+## test_that("stacked, stream, genotypes and some colors", {
277
+##     data(examplesFitnessEffects)
278
+##     max.tries <- 4
279
+##     for(i in 1:max.tries) {
280
+##         tmp <-  oncoSimulIndiv(examplesFitnessEffects[["o3"]],
281
+##                                model = "McFL", 
282
+##                                mu = 5e-5,
283
+##                                detectionSize = 1e8, 
284
+##                                detectionDrivers = 3,
285
+##                                sampleEvery = 0.025,
286
+##                                max.num.tries = 10,
287
+##                                keepEvery = 5,
288
+##                                initSize = 2000,
289
+##                                finalTime = 3000,
290
+##                                onlyCancer = FALSE, detectionProb = NA,
291
+##                                keepPhylog = TRUE)
292
+##         if(nrow(tmp$pops.by.time) >= 5) {
293
+##             break
294
+##         } else {
295
+##             cat("\n hummm.. had to run again in the plot")
296
+##             if(i >= max.tries) {
297
+##                 print(tmp)
298
+##                 stop("stream will break")
299
+##             }
300
+##         }
301
+##     }
302
+##     plot(tmp, type = "stacked", show = "genotypes")
303
+##     plot(tmp, type = "stream", show = "genotypes")
304
+##     plot(tmp, type = "line", show = "genotypes")
305
+##     plot(tmp, type = "stacked", show = "drivers")
306
+##     plot(tmp, type = "stream", show = "drivers")
307
+##     plot(tmp, type = "line", show = "drivers")
308
+##     plot(tmp, type = "stacked", order.method = "max")
309
+##     plot(tmp, type = "stacked", order.method = "first")
310
+##     plot(tmp, type = "stream", order.method = "max")
311
+##     plot(tmp, type = "stream", order.method = "first")
312
+##     plot(tmp, type = "stream", stream.center = TRUE)
313
+##     plot(tmp, type = "stream", stream.center = FALSE)
314
+##     plot(tmp, type = "stream", stream.center = TRUE, log = "x")
315
+##     plot(tmp, type = "stacked", stream.center = TRUE, log = "x")
316
+##     plot(tmp, type = "stacked", show = "genotypes",
317
+##          breakSortColors = "random")
318
+##     plot(tmp, type = "stream", show = "genotypes",
319
+##          breakSortColors = "distave")
320
+##     plot(tmp, type = "stacked", show = "genotypes", col = rainbow(9))
321
+##     plot(tmp, type = "stream", show = "genotypes", col = rainbow(3))
322
+##     plot(tmp, type = "line", show = "genotypes", col = rainbow(20))
323
+##     expect_true(TRUE) ## dummy, to prevent the
324
+##     ## attempt to apply non-function
325
+##     ## If plotting failed, this would fail
326
+##     expect_error(plot(tmp, type = "linito"))
327
+## })
328
+## date()
329
+
330
+
331
+cat(paste("\n Ending exercise-plotting-code long at", date()))
... ...
@@ -240,5 +240,112 @@ test_that("Check output is correct", {
240 240
 
241 241
     
242 242
 })
243
+
244
+
245
+
246
+
247
+## the really relevant is r2. The other two if they succeed in few
248
+## will succeed in more.
249
+system.time(
250
+    test_that("long Local max: not stopping, stopping, and tolerance", {
251
+         cat("\n\n ************** fixation: long local max  ***********\n")  
252
+        initS <- 4000
253
+    r1 <- matrix(0, ncol = 6, nrow = 9)
254
+    colnames(r1) <- c(LETTERS[1:5], "Fitness")
255
+    r1[1, 6] <- 1
256
+    r1[cbind((2:4), c(1:3))] <- 1
257
+    r1[2, 6] <- 1.4
258
+    r1[3, 6] <- 1.32
259
+    r1[4, 6] <- 1.32
260
+    r1[5, ] <- c(0, 1, 0, 0, 1, 1.5)
261
+    r1[6, ] <- c(0, 0, 1, 1, 0, 1.54)
262
+    r1[7, ] <- c(1, 0, 1, 1, 0, 1.65)
263
+    r1[8, ] <- c(1, 1, 1, 1, 0, 1.75)
264
+    r1[9, ] <- c(1, 1, 1, 1, 1, 1.85)
265
+    class(r1) <- c("matrix", "genotype_fitness_matrix")
266
+    ## plot(r1) ## to see the fitness landscape
267
+    local_max_g <- c("A", "B, E", "A, B, C, D, E")
268
+    local_max <- paste0("_,", local_max_g)
269
+    fr1 <- allFitnessEffects(genotFitness = r1, drvNames = LETTERS[1:5])
270
+    ## we pass sets of genes, so not stopping at genotypes
271
+    r1 <- oncoSimulPop(200,
272
+                       fp = fr1,
273
+                       model = "McFL",
274
+                       initSize = initS,
275
+                       mu = 1e-4,
276
+                       detectionSize = NA,
277
+                       sampleEvery = .03,
278
+                       keepEvery = 1, 
279
+                       finalTime = 50000,
280
+                       fixation = local_max_g, 
281
+                       detectionDrivers = NA,
282
+                       detectionProb = NA,
283
+                       onlyCancer = TRUE,
284
+                       max.num.tries = 500,
285
+                       max.wall.time = 20, 
286
+                       errorHitMaxTries = TRUE,
287
+                       keepPhylog = FALSE,
288
+                       mc.cores = 2)
289
+    sr1 <- summary(r1)
290
+    expect_true(!all(sr1$TotalPopSize == sr1$LargestClone))
291
+    sp1 <- samplePop(r1, "last", "singleCell")
292
+    sgsp1 <- sampledGenotypes(sp1)
293
+    expect_true(!all(sgsp1$Genotype %in% local_max_g))
294
+    ## genotypes, exactly
295
+    mm <- rep(1e-4, 5)
296
+    mm[3] <- 2e-4
297
+    mm[1] <- 1e-5
298
+    names(mm) <- LETTERS[1:5]
299
+    r2 <- oncoSimulPop(2000,
300
+                       fp = fr1,
301
+                       model = "McFL",
302
+                       initSize = initS,
303
+                       mu = 1e-4,
304
+                       detectionSize = NA,
305
+                       sampleEvery = .03,
306
+                       keepEvery = 1, 
307
+                       finalTime = 50000,
308
+                       fixation = local_max, 
309
+                       detectionDrivers = NA,
310
+                       detectionProb = NA,
311
+                       onlyCancer = TRUE,
312
+                       max.num.tries = 500,
313
+                       max.wall.time = 20, 
314
+                       errorHitMaxTries = TRUE,
315
+                       keepPhylog = FALSE,
316
+                       mc.cores = 2)
317
+    sr2 <- summary(r2)
318
+    expect_true(all(sr2$TotalPopSize == sr2$LargestClone))
319
+    sp2 <- samplePop(r2, "last", "singleCell")
320
+    sgsp2 <- sampledGenotypes(sp2)
321
+    expect_true(all(sgsp2$Genotype %in% local_max_g))
322
+    ## tolerance
323
+    r3 <- oncoSimulPop(200,
324
+                       fp = fr1,
325
+                       model = "McFL",
326
+                       initSize = initS,
327
+                       mu = 1e-4,
328
+                       detectionSize = NA,
329
+                       sampleEvery = .03,
330
+                       keepEvery = 1, 
331
+                       finalTime = 50000,
332
+                       fixation = c(local_max, fixation_tolerance = 0.1),
333
+                       detectionDrivers = NA,
334
+                       detectionProb = NA,
335
+                       onlyCancer = TRUE,
336
+                       max.num.tries = 500,
337
+                       max.wall.time = 20, 
338
+                       errorHitMaxTries = TRUE,
339
+                       keepPhylog = FALSE,
340
+                       mc.cores = 2)
341
+    sr3 <- summary(r3)
342
+    expect_true(!all(sr3$TotalPopSize == sr3$LargestClone))
343
+    sp3 <- samplePop(r3, "last", "singleCell")
344
+    sgsp3 <- sampledGenotypes(sp3)
345
+    expect_true(!all(sgsp3$Genotype %in% local_max_g))
346
+})
347
+)
348
+
349
+
243 350
 cat("\n Ending long fixation  at", date(), "\n") 
244 351
 
... ...
@@ -21,7 +21,7 @@ test_that("Increasing cPDetect decreases time, Exp" , {
21 21
                            model = "Exp",
22 22
                            initSize = 1000,
23 23
                            keepEvery = -9,
24
-                           detectionProb = c(p2 = NULL, n2 = NULL, cPDetect = 1e-5),
24
+                           detectionProb = c(p2 = NULL, n2 = NULL, cPDetect = 0.01),
25 25
                            finalTime = NA,
26 26
                            onlyCancer = FALSE,
27 27
                            detectionDrivers = 99, mc.cores = 2)
... ...
@@ -30,7 +30,7 @@ test_that("Increasing cPDetect decreases time, Exp" , {
30 30
                            model = "Exp",
31 31
                            initSize = 1000,
32 32
                            keepEvery = -9,
33
-                           detectionProb = c(p2 = NULL, n2 = NULL, cPDetect = .01),
33
+                           detectionProb = c(p2 = NULL, n2 = NULL, cPDetect = .2),
34 34
                            finalTime = NA,
35 35
                            onlyCancer = FALSE,
36 36
                            detectionDrivers = 99, mc.cores = 2)
... ...
@@ -155,3 +155,8 @@ test_that("Increasing checkSizePEvery increases time, Exp" , {
155 155
 })
156 156
 
157 157
 cat(paste("\n Ending sample-prob-long tests", date(), "\n"))
158
+
159
+
160
+
161
+
162
+
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting LOD_POM at", date(), "\n"))
2 3
 date()
3 4
 test_that("Exercise LOD and POM code", {
... ...
@@ -430,10 +431,6 @@ date()
430 431
 
431 432
 cat(paste("\n Ending LOD_POM at", date(), "\n"))
432 433
 
433
-
434
-
435
-
436
-
437 434
 ### Why we need to exclude some POMs in the testing
438 435
 
439 436
 ## with i = 2335   ## new one removes entries
... ...
@@ -459,3 +456,5 @@ cat(paste("\n Ending LOD_POM at", date(), "\n"))
459 456
 ##         expect_true(identical(s7$other$POM, pom))
460 457
 ## }
461 458
 
459
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
460
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting test.Z-all-fitness at", date(), "\n"))
2 3
 
3 4
 RNGkind("Mersenne-Twister")
... ...
@@ -131,3 +132,5 @@ test_that("long example OK", {
131 132
 set.seed(NULL)
132 133
 
133 134
 cat(paste("\n Ending test.Z-all-fitness at", date(), "\n"))
135
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
136
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting test.Z-driver-counts at", date(), "\n"))
2 3
 date()
3 4
 test_that("Assertion is correct when nothing returned",{
... ...
@@ -74,3 +75,5 @@ test_that("driverCounts: a run that used to cause crashes", {
74 75
 set.seed(NULL)
75 76
 
76 77
 cat(paste("\n Ending test.Z-driver-counts at", date(), "\n"))
78
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
79
+rm(inittime)
77 80
new file mode 100644
... ...
@@ -0,0 +1,97 @@
1
+inittime <- Sys.time()
2
+cat(paste("\n Starting test.Z-fixation at", date(), "\n"))
3
+
4
+
5
+
6
+test_that("Three cases with fixation of genotypes" ,{
7
+    load(system.file("testdata_fee.RData", package="OncoSimulR"))
8
+    i <- 3
9
+    ng <- 7
10
+    RNGkind("Mersenne-Twister")
11
+
12
+    set.seed(i)
13
+    r3 <- oncoSimulIndiv( fp = fee,
14
+                         model = "McFL",
15
+                         initSize = 2000,
16
+                         mu = 1e-4,
17
+                         detectionSize = NA,
18
+                         sampleEvery = .03,
19
+                         keepEvery = 1,
20
+                         finalTime = 50000,
21
+                         fixation = unlist(feex[["labelled_peaks"]]), 
22
+                         detectionDrivers = NA,
23
+                         detectionProb = NA,
24
+                         onlyCancer = TRUE,
25
+                         max.num.tries = 500,
26
+                         max.wall.time = 20, 
27
+                         errorHitMaxTries = TRUE,
28
+                         keepPhylog = FALSE)
29
+    
30
+    summary(r3)
31
+    ## stopping at ABCG, which is not a maximum, not a labelled peak
32
+    expect_equal(
33
+        c(A = 1, B = 1, C = 1, D = 0, E = 0, F = 0, G = 1),
34
+        samplePop(r3, "last", "singleCell")[1, ])
35
+    feex$labelled_peaks
36
+
37
+    ## And not a single genotype unique
38
+    expect_true(r3$TotalPopSize > r3$LargestClone)
39
+    
40
+    ## stop on genotypes
41
+    set.seed(i)
42
+    r4 <- oncoSimulIndiv( fp = fee,
43
+                     model = "McFL",
44
+                     initSize = 2000,
45
+                     mu = 1e-4,
46
+                     detectionSize = NA,
47
+                     sampleEvery = .03,
48
+                     keepEvery = 1,
49
+                     finalTime = 50000,
50
+                     fixation = paste0("_,", unlist(feex[["labelled_peaks"]])),
51
+                     detectionDrivers = NA,
52
+                     detectionProb = NA,
53
+                     onlyCancer = TRUE,
54
+                     max.num.tries = 500,
55
+                     max.wall.time = 20, 
56
+                     errorHitMaxTries = TRUE,
57
+                     keepPhylog = FALSE)
58
+    summary(r4)
59
+    ## now a local max is the single clone
60
+    expect_equal(
61
+        c(A = 1, B = 1, C = 1, D = 0, E = 0, F = 1, G = 1),
62
+        samplePop(r4, "last", "singleCell")[1, ])
63
+    expect_true(r4$TotalPopSize == r4$LargestClone)
64
+
65
+
66
+    ## tolerance
67
+    set.seed(i)
68
+    r5 <- oncoSimulIndiv( fp = fee,
69
+                         model = "McFL",
70
+                         initSize = 2000,
71
+                         mu = 1e-4,
72
+                         detectionSize = NA,
73
+                         sampleEvery = .03,
74
+                         keepEvery = 1,
75
+                         finalTime = 50000,
76
+                         fixation = c(paste0("_,", unlist(feex[["labelled_peaks"]])),
77
+                                      fixation_tolerance = 0.05),
78
+                         detectionDrivers = NA,
79
+                         detectionProb = NA,
80
+                         onlyCancer = TRUE,
81
+                         max.num.tries = 500,
82
+                         max.wall.time = 20, 
83
+                         errorHitMaxTries = TRUE,
84
+                         keepPhylog = FALSE)
85
+    summary(r5)
86
+    expect_equal(
87
+        c(A = 1, B = 1, C = 1, D = 0, E = 0, F = 1, G = 1),
88
+        samplePop(r5, "last", "singleCell")[1, ])
89
+    ## but other clones present too
90
+    expect_true(r5$TotalPopSize > r5$LargestClone)
91
+})
92
+
93
+
94
+set.seed(NULL)
95
+cat(paste("\n Ending test.Z-fixation at", date(), "\n"))
96
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
97
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting test.Z-mutator at", date(), "\n"))
2 3
 test_that("Mutator genes missing from fitness", {
3 4
     RNGkind("Mersenne-Twister")
... ...
@@ -271,3 +272,5 @@ test_that("fitness and mutator effects evaluation of actual values, long example
271 272
 set.seed(NULL)
272 273
 
273 274
 cat(paste("\n Ending test.Z-mutator at", date(), "\n"))
275
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
276
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting test.Z-oncoSimulIndiv at", date(), "\n"))
2 3
 ## Some tests below might only work on Linux because of compiler
3 4
 ## differences, because the rng is done in C++, etc.
... ...
@@ -165,3 +166,5 @@ test_that("exercise mu > 1, new format", {
165 166
 set.seed(NULL)
166 167
 
167 168
 cat(paste("\n Ending test.Z-oncoSimulIndiv at", date(), "\n"))
169
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
170
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting test.Z-rfitness-landscape at", date(), "\n"))
2 3
 test_that("exercise accessible genotypes code", {
3 4
     ## Because of compiler differences, this might only test the relevant
... ...
@@ -34,3 +35,5 @@ test_that("exercise accessible genotypes code", {
34 35
 set.seed(NULL)
35 36
 
36 37
 cat(paste("\n Ending test.Z-rfitness-landscape at", date(), "\n"))
38
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
39
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting Z-sample-only-last tests", date(), "\n"))
2 3
 
3 4
 data(examplePosets)
... ...
@@ -52,7 +53,7 @@ runBothFuncts <- function(seed, Poset, functionPair) {
52 53
 
53 54
 ## We only use one from each of 11, 9, 7.
54 55
 ## Whole collection tested in long tests
55
-examplePosets <- examplePosets[c(1, 5, 9)]
56
+examplePosets <- examplePosets[c(1, 5)] ##, 9)]
56 57
 for(i in 1:length(examplePosets)) {
57 58
     s1 <- round(runif(1) * 10000) ## do better as: as.integer(runif(1, 1, 1e9))
58 59
     Poset <- examplePosets[[i]]
... ...
@@ -102,3 +103,5 @@ for(i in 1:length(examplePosets)) {
102 103
 
103 104
 set.seed(NULL)
104 105
 cat(paste("\n Ending Z-sample-only-last tests", date(), "\n"))
106
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
107
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting Z-total-present-drivers tests", date(), "\n"))
2 3
 
3 4
 
... ...
@@ -93,3 +94,5 @@ set.seed(NULL)
93 94
 cat(paste("\n Ending Z-total-present-drivers tests", date(), "\n"))
94 95
 
95 96
 
97
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
98
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting accessible_genotypes at", date(), "\n"))
2 3
 test_that("We obtain same accessible genotypes with different functions plus genot_to_adjm_mat", {
3 4
     ## More likely to catch bugs if many iters, rather than large matrices
... ...
@@ -185,6 +186,7 @@ test_that("The indices of adjancey matrices are correct", {
185 186
 })
186 187
 
187 188
 
188
-cat(paste("\n Ending accessible_genotypes at", date(), "\n"))
189
-
190 189
 ## For peaks, see code in test.plotFitnessLandscape.R
190
+cat(paste("\n Ending accessible_genotypes at", date(), "\n"))
191
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
192
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting all fitness at", date()))
2 3
 ## RNGkind("Mersenne-Twister") ## we have some examples below with random
3 4
 ## genotype generation. We leave the default. We use L'Ecuyer when using
... ...
@@ -1370,5 +1371,6 @@ test_that("We can deal with single-gene genotypes and trivial cases" ,{
1370 1371
 })
1371 1372
 
1372 1373
 
1373
-cat(paste("\n Ending all-fitness at", date()))
1374
-
1374
+cat(paste("\n Ending all-fitness at", date(), "\n"))
1375
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
1376
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting driverCounts at", date()))
2 3
 ## RNGkind("Mersenne-Twister") ## we have some examples below with random
3 4
 
... ...
@@ -67,3 +68,5 @@ date()
67 68
 
68 69
 
69 70
 cat(paste("\n Ending driverCounts at", date(), "\n"))
71
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
72
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting epist-order-modules at", date()))
2 3
 
3 4
 ## A minimal thing, to make sure no screw ups
... ...
@@ -123,4 +124,6 @@ test_that("error if root out of place in gm", {
123 124
           })
124 125
 
125 126
 
126
-cat(paste("\n Ending epist-order-modules at", date()))
127
+cat(paste("\n Ending epist-order-modules at", date(), "\n"))
128
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
129
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting exercise-plotting-code at", date()))
2 3
 
3 4
 ## These are all used in the vignette and the help functions but we add
... ...
@@ -526,5 +527,7 @@ test_that("exercising phylogClone", {
526 527
     }
527 528
 })
528 529
 
529
-cat(paste("\n Ending exercise-plotting-code at", date()))
530
+cat(paste("\n Ending exercise-plotting-code at", date(), "\n"))
530 531
 
532
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
533
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting exercise-rfitness at", date(), "\n"))
2 3
 test_that("Expect output", {
3 4
 
... ...
@@ -47,4 +48,15 @@ test_that("Warnings if scale out of scale", {
47 48
                    "Using wt_is_1 = force", fixed = TRUE)
48 49
 })
49 50
 
51
+test_that("Error if wrong arguments", {
52
+    expect_error(rfitness(NA),
53
+                 "Number of genes argument (g) is null or NA",
54
+                 fixed = TRUE)
55
+    expect_error(rfitness(NULL),
56
+                 "Number of genes argument (g) is null or NA",
57
+                 fixed = TRUE)
58
+})
59
+
50 60
 cat(paste("\n Starting exercise-rfitness at", date(), "\n"))
61
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
62
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting to_Magella at", date(), "\n"))
2 3
 test_that("Expect output", {
3 4
     r1 <- rfitness(4)
... ...
@@ -10,3 +11,5 @@ test_that("Expect output", {
10 11
     expect_output(to_Magellan(allFitnessEffects(cs), NULL))
11 12
 })
12 13
 cat(paste("\n Ending to_Magella at", date(), "\n"))
14
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
15
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 ## This is a short version of test.fitness-preds-long.R But it encompasses
2 3
 ## the most complex cases. It is expected that this will fail occasionally
3 4
 ## (based on p-values); thus, we loop twice if needed.
... ...
@@ -265,3 +266,5 @@ test_that("Observed vs expected, case III", {
265 266
 date()
266 267
 
267 268
 cat(paste("\n Ending fitness preds long at", date(), "\n"))
269
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
270
+rm(inittime)
... ...
@@ -1,4 +1,6 @@
1
+inittime <- Sys.time()
1 2
 cat("\n Starting fixation  at", date(), "\n") ## about 4 seconds
3
+
2 4
 test_that("Minimal run", {
3 5
     initS <- 2000
4 6
     u <- 0.2; i <- -0.02; vi <- 0.6; ui <- uv <- -Inf
... ...
@@ -25,6 +27,13 @@ test_that("Minimal run", {
25 27
                    keepEvery = NA,
26 28
                    fixation = list("u", "v")
27 29
                    )
30
+    oncoSimulIndiv(od, muEF = odm, model = "McFL",
31
+                   mu = 1e-4, 
32
+                   onlyCancer = TRUE, finalTime = 15000, detectionSize = NA, detectionProb = NA,
33
+                   initSize = initS, 
34
+                   keepEvery = NA,
35
+                   fixation = list("u", "v", fixation_tolerance = 0.01)
36
+                   )
28 37
     oncoSimulPop(2, od, muEF = odm, model = "McFL",
29 38
                  mu = 1e-4, 
30 39
                  onlyCancer = TRUE, finalTime = 15000, detectionSize = NA, detectionProb = NA,
... ...
@@ -63,7 +72,6 @@ test_that("Minimal run", {
63 72
                    )
64 73
 })
65 74
 
66
-
67 75
 test_that("Catch errors", {
68 76
     initS <- 2000
69 77
     u <- 0.2; i <- -0.02; vi <- 0.6; ui <- uv <- -Inf
... ...
@@ -108,7 +116,7 @@ test_that("Catch errors", {
108 116
                    keepEvery = NA,
109 117
                    fixation = 98
110 118
                    ),
111
-                 "Each element of 'fixation' must be a single element character vector",
119
+                 "At least one element of 'fixation' must be a single element character vector",
112 120
                  fixed = TRUE)
113 121
     expect_error(oncoSimulIndiv(od, muEF = odm, model = "McFL",
114 122
                                 mu = 1e-4, 
... ...
@@ -117,7 +125,7 @@ test_that("Catch errors", {
117 125
                    keepEvery = NA,
118 126
                    fixation = list("u", c("u", "v"))
119 127
                    ),
120
-                 "Each element of 'fixation' must be a single element character vector",
128
+                 "Each element of 'fixation' must be a single element vector",
121 129
                  fixed = TRUE)
122 130
     expect_error(oncoSimulIndiv(od, muEF = odm, model = "McFL",
123 131
                                 mu = 1e-4, 
... ...
@@ -126,7 +134,7 @@ test_that("Catch errors", {
126 134
                    keepEvery = NA,
127 135
                    fixation = list("u", list("u", "v"))
128 136
                    ),
129
-                 "Each element of 'fixation' must be a single element character vector",
137
+                 "Each element of 'fixation' must be a single element vector",
130 138
                  fixed = TRUE)
131 139
     expect_error(oncoSimulIndiv(od, muEF = odm, model = "McFL",
132 140
                                 mu = 1e-4, 
... ...
@@ -151,9 +159,24 @@ test_that("Catch errors", {
151 159
                                 ),
152 160
                  "'fixation' cannot be specified with the old poset format",
153 161
                  fixed = TRUE)
162
+    expect_error(oncoSimulIndiv(od, model = "McFL",
163
+                   mu = 1e-4, 
164
+                   onlyCancer = TRUE, finalTime = NA, detectionSize = NA, detectionProb = NA,
165
+                   initSize = initS, 
166
+                   keepEvery = NA,
167
+                   fixation = c("u",fixation_tolerance = -0.3)
168
+                   ),
169
+                 "Impossible range for fixation tolerance", fixed = TRUE)
170
+    expect_error(oncoSimulIndiv(od,  model = "McFL",
171
+                   mu = 1e-4, 
172
+                   onlyCancer = TRUE, finalTime = NA, detectionSize = NA, detectionProb = NA,
173
+                   initSize = initS, 
174
+                   keepEvery = NA,
175
+                   fixation = c("u",fixation_tolerance = 1.1)
176
+                   ),
177
+                 "Impossible range for fixation tolerance", fixed = TRUE)
154 178
 })
155 179
 
156
-
157 180
 test_that("Internal checking function works", {
158 181
     x <- c("i, u, g", "g, u", "i")
159 182
     y <- c("i", "g") ## TRUE
... ...
@@ -232,7 +255,7 @@ test_that("Internal checking function works", {
232 255
     expect_false(list_g_matches_fixed(x3, y12))    
233 256
 })
234 257
 
235
-
258
+date()
236 259
 test_that("Check output is correct", {
237 260
     initS <- 2000
238 261
     u <- 0.2; i <- -0.02; vi <- 0.6; ui <- uv <- -Inf
... ...
@@ -246,7 +269,8 @@ test_that("Check output is correct", {
246 269
     initS <- 2000
247 270
     op <- oncoSimulPop(100, od, muEF = odm, model = "McFL",
248 271
                         mu = 1e-4, 
249
-                        onlyCancer = TRUE, finalTime = 15000, detectionSize = NA, detectionProb = NA,
272
+                       onlyCancer = TRUE, finalTime = 15000,
273
+                       detectionSize = NA, detectionProb = NA,
250 274
                         initSize = initS, 
251 275
                         keepEvery = NA,
252 276
                         fixation = c("u", "v"),
... ...
@@ -260,7 +284,8 @@ test_that("Check output is correct", {
260 284
     expect_false(list_g_matches_fixed(sg[, "Genotype"], c("uv")))
261 285
     op <- oncoSimulPop(100, od, muEF = odm, model = "McFL",
262 286
                         mu = 1e-4, 
263
-                        onlyCancer = TRUE, finalTime = NA, detectionSize = NA, detectionProb = NA,
287
+                       onlyCancer = TRUE, finalTime = NA,
288
+                       detectionSize = NA, detectionProb = NA,
264 289
                         initSize = initS, 
265 290
                         keepEvery = NA,
266 291
                         fixation = c("u", "i"),
... ...
@@ -309,7 +334,8 @@ test_that("Check output is correct", {
309 334
     odm <- allMutatorEffects(noIntGenes = c("i" = 50))
310 335
     evalAllGenotypesFitAndMut(od, odm, addwt = TRUE)
311 336
     initS <- 20
312
-    op <- oncoSimulPop(50, od, model = "McFL",
337
+    op <- oncoSimulPop(10, ## 50
338
+                       od, model = "McFL",
313 339
                        mu = 1e-3, 
314 340
                        onlyCancer = TRUE,
315 341
                        finalTime = 1000, detectionSize = NA, detectionProb = NA,
... ...
@@ -325,22 +351,6 @@ test_that("Check output is correct", {
325 351
     sg <- sampledGenotypes(sp)
326 352
     expect_true(list_g_matches_fixed(sg[, "Genotype"], c("i")))
327 353
     expect_false(list_g_matches_fixed(sg[, "Genotype"], c("iv")))
328
-    ## ## very slow; in long tests
329
-    ## op <- oncoSimulPop(20, od, model = "McFL",
330
-    ##                    mu = 1e-3, 
331
-    ##                    onlyCancer = TRUE, finalTime = NA, detectionSize = NA, detectionProb = NA,
332
-    ##                    initSize = initS,
333
-    ##                    keepEvery = NA,
334
-    ##                    fixation = c("v"),
335
-    ##                    max.num.tries = 5000,
336
-    ##                    mc.cores = 2
337
-    ##                    )
338
-    ## sp <- samplePop(op)
339
-    ## rsop <- rowSums(sp)
340
-    ## stopifnot(all(rsop >= 1))
341
-    ## sg <- sampledGenotypes(sp)
342
-    ## expect_true(list_g_matches_fixed(sg[, "Genotype"], c("v")))
343
-    ## expect_false(list_g_matches_fixed(sg[, "Genotype"], c("iv")))
344 354
     initS <- 2000
345 355
     u <- 0.2; i <- 0; vi <- 0.6; ui <- uv <- 1.2
346 356
     od <- allFitnessEffects(
... ...
@@ -407,7 +417,7 @@ test_that("Check output is correct", {
407 417
     expect_true(list_g_matches_fixed(sg[, "Genotype"], c("v, i, u")))
408 418
     expect_false(list_g_matches_fixed(sg[, "Genotype"], c("uv")))
409 419
 })
410
-
420
+date()
411 421
 
412 422
 
413 423
 ## ## This need not ever finish successfully, as there is
... ...
@@ -427,4 +437,107 @@ test_that("Check output is correct", {
427 437
 ## sg5 <- sampledGenotypes(sp5)
428 438
 ## expect_true(list_g_matches_fixed(sg5[, "Genotype"], c("v")))
429 439
 
440
+
441
+
442
+
443
+test_that("Local max: not stopping, stopping, and tolerance", {
444
+        initS <- 2000
445
+    rl1 <- matrix(0, ncol = 6, nrow = 9)
446
+    colnames(rl1) <- c(LETTERS[1:5], "Fitness")
447
+    rl1[1, 6] <- 1
448
+    rl1[cbind((2:4), c(1:3))] <- 1
449
+    rl1[2, 6] <- 1.4
450
+    rl1[3, 6] <- 1.32
451
+    rl1[4, 6] <- 1.32
452
+    rl1[5, ] <- c(0, 1, 0, 0, 1, 1.5)
453
+    rl1[6, ] <- c(0, 0, 1, 1, 0, 1.54)
454
+    rl1[7, ] <- c(1, 0, 1, 1, 0, 1.65)
455
+    rl1[8, ] <- c(1, 1, 1, 1, 0, 1.75)
456
+    rl1[9, ] <- c(1, 1, 1, 1, 1, 1.85)
457
+    class(rl1) <- c("matrix", "genotype_fitness_matrix")
458
+    ## plot(rl1) ## to see the fitness landscape
459
+    local_max_g <- c("A", "B, E", "A, B, C, D, E")
460
+    local_max <- paste0("_,", local_max_g)
461
+    fr1 <- allFitnessEffects(genotFitness = rl1, drvNames = LETTERS[1:5])
462
+    ## we pass sets of genes, so not stopping at genotypes
463
+    r1 <- oncoSimulPop(100,
464
+                       fp = fr1,
465
+                       model = "McFL",
466
+                       initSize = initS,
467
+                       mu = 1e-4,
468
+                       detectionSize = NA,
469
+                       sampleEvery = .03,
470
+                       keepEvery = 1, 
471
+                       finalTime = 50000,
472
+                       fixation = local_max_g, 
473
+                       detectionDrivers = NA,
474
+                       detectionProb = NA,
475
+                       onlyCancer = TRUE,
476
+                       max.num.tries = 500,
477
+                       max.wall.time = 20, 
478
+                       errorHitMaxTries = TRUE,
479
+                       keepPhylog = FALSE,
480
+                       mc.cores = 2)
481
+    sr1 <- summary(r1)
482
+    expect_true(!all(sr1$TotalPopSize == sr1$LargestClone))
483
+    sp1 <- samplePop(r1, "last", "singleCell")
484
+    sgsp1 <- sampledGenotypes(sp1)
485
+    expect_true(!all(sgsp1$Genotype %in% local_max_g))
486
+    ## genotypes, exactly
487
+    mm <- rep(1e-4, 5)
488
+    mm[3] <- 2e-4
489
+    mm[1] <- 1e-5
490
+    names(mm) <- LETTERS[1:5]
491
+    r2 <- oncoSimulPop(100,
492
+                       fp = fr1,
493
+                       model = "McFL",
494
+                       initSize = initS,
495
+                       mu = 1e-4,
496
+                       detectionSize = NA,
497
+                       sampleEvery = .03,
498
+                       keepEvery = 1, 
499
+                       finalTime = 50000,
500
+                       fixation = local_max, 
501
+                       detectionDrivers = NA,
502
+                       detectionProb = NA,
503
+                       onlyCancer = TRUE,
504
+                       max.num.tries = 500,
505
+                       max.wall.time = 20, 
506
+                       errorHitMaxTries = TRUE,
507
+                       keepPhylog = FALSE,
508
+                       mc.cores = 2)
509
+    sr2 <- summary(r2)
510
+    expect_true(all(sr2$TotalPopSize == sr2$LargestClone))
511
+    sp2 <- samplePop(r2, "last", "singleCell")
512
+    sgsp2 <- sampledGenotypes(sp2)
513
+    expect_true(all(sgsp2$Genotype %in% local_max_g))
514
+    ## tolerance
515
+    r3 <- oncoSimulPop(100,
516
+                       fp = fr1,
517
+                       model = "McFL",
518
+                       initSize = initS,
519
+                       mu = 1e-4,
520
+                       detectionSize = NA,
521
+                       sampleEvery = .03,
522
+                       keepEvery = 1, 
523
+                       finalTime = 50000,
524
+                       fixation = c(local_max, fixation_tolerance = 0.1),
525
+                       detectionDrivers = NA,
526
+                       detectionProb = NA,
527
+                       onlyCancer = TRUE,
528
+                       max.num.tries = 500,
529
+                       max.wall.time = 20, 
530
+                       errorHitMaxTries = TRUE,
531
+                       keepPhylog = FALSE,
532
+                       mc.cores = 2)
533
+    sr3 <- summary(r3)
534
+    expect_true(!all(sr3$TotalPopSize == sr3$LargestClone))
535
+    sp3 <- samplePop(r3, "last", "singleCell")
536
+    sgsp3 <- sampledGenotypes(sp3)
537
+    expect_true(!all(sgsp3$Genotype %in% local_max_g))
538
+})
539
+
540
+
430 541
 cat("\n Ending fixation  at", date(), "\n")
542
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
543
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting test.flfast-additional.R test at", date()))
2 3
 date()
3 4
 
... ...
@@ -262,3 +263,5 @@ test_that("rt and fl specifications are the same", {
262 263
 
263 264
 
264 265
 cat(paste("\n Ending test.flfast-additional.R test at", date(), "\n"))
266
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
267
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 ### Since some tests are slow and some tests are very fragile, for now I
2 3
 ### leave date() and seed()
3 4
 
... ...
@@ -1253,3 +1254,5 @@ cat(paste("\n Finished test.flfast-mutator.R test at", date(), "\n"))
1253 1254
 
1254 1255
 
1255 1256
 
1257
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
1258
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting genotFitness at", date(), "\n"))
2 3
 
3 4
 test_that("Conversion for data frame", {
... ...
@@ -107,3 +108,5 @@ test_that("genotFitness not combined with others", {
107 108
 
108 109
 
109 110
 cat(paste("\n Ending genotFitness at", date(), "\n"))
111
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
112
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting genot_fitness_to_epistasis at", date(), "\n"))
2 3
 
3 4
 ## A minimal, simple check of this function which is a
... ...
@@ -27,3 +28,5 @@ test_that("genot_fitness_to_epistasis works minimally", {
27 28
 })
28 29
 
29 30
 cat(paste("\n Ending genot_fitness_to_epistasis at", date(), "\n"))
31
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
32
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting init-mutant tests", date(), "\n"))
2 3
 
3 4
 ## RNGkind("Mersenne-Twister")
... ...
@@ -656,3 +657,5 @@ cat(paste("\n Ending init-mutant tests", date(), "\n"))
656 657
 
657 658
 
658 659
 
660
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
661
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 ## Starting with v. 2.1.2 modules do not require Root (unless, of course,
2 3
 ## you have a node named Root, as when using a DAG). They can use it, though.
3 4
 
... ...
@@ -65,3 +66,5 @@ test_that("Root needed with DAGs", {
65 66
                  fixed = TRUE)
66 67
 })
67 68
 cat(paste("\n Ending test.modules-root-no-root at", date(), "\n"))
69
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
70
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting at mutPropGrowth ", date(), "\n"))
2 3
 
3 4
 ## RNGkind("L'Ecuyer-CMRG") ## for the mclapplies
... ...
@@ -551,3 +552,5 @@ cat("\n Ended test.mutPropGrowth: ", date(), "\n")
551 552
 
552 553
 
553 554
 
555
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
556
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 ## Repeat tests in test.mutator, using oncoSimulSample.
2 3
 ## This is a concession to extreme paranoia.
3 4
 
... ...
@@ -624,3 +625,5 @@ cat(paste("\n Finished test.mutator-oncoSimulSample.R test at", date(), "\n"))
624 625
 ## sed -i 's/summary(\([A-Za-z0-9]*\))/\1$popSummary\[, c(1:3, 8:9)\]/g' test.mutator-oncoSimulSample.R
625 626
 ## the last is not quite ok. Leaves to sets of the [, c(1:3, 8:9)][, c(1:3, 8:9)]. Replace in emacs.
626 627
 ## and a few others are missed. 
628
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
629
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 ### Since some tests are slow and some tests are very fragile, for now I
2 3
 ### leave date() and seed()
3 4
 
... ...
@@ -1230,3 +1231,5 @@ cat(paste("\n Finished test.mutator.R test at", date(), "\n"))
1230 1231
 
1231 1232
 
1232 1233
 
1234
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
1235
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting oncoSimulIndiv-miscell tests", date(), "\n"))
2 3
 
3 4
 test_that("sampleEvery must have a value", {
... ...
@@ -1029,3 +1030,5 @@ cat(paste("\n Ending oncoSimulIndiv-miscell tests", date(), "\n"))
1029 1030
 
1030 1031
 
1031 1032
 
1033
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
1034
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting oncoSimulSample-failures tests", date(), "\n"))
2 3
 
3 4
 ## RNGkind("Mersenne-Twister")
... ...
@@ -113,3 +114,5 @@ test_that("oncoSimulSample C++ exception triggered", {
113 114
           })
114 115
 
115 116
 cat(paste("\n Ending oncoSimulSample-failures tests", date(), "\n"))
117
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
118
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat(paste("\n Starting oncoSimulSample-limits tests", date(), "\n"))
2 3
 
3 4
 ## RNGkind("Mersenne-Twister")
... ...
@@ -68,3 +69,5 @@ test_that("oncoSimulSample does not use drivers as stopping when there are none"
68 69
 })
69 70
 
70 71
 cat(paste("\n Ending oncoSimulSample-limits tests", date(), "\n"))
72
+cat(paste("  Took ", round(difftime(Sys.time(), inittime, units = "secs"), 2), "\n\n"))
73
+rm(inittime)
... ...
@@ -1,3 +1,4 @@
1
+inittime <- Sys.time()
1 2
 cat("\n Starting per-gene-mutation rates at", date(), "\n") ## whole file takes about 30 seconds
2 3
 ## When submitting, probably move half of the tests (mcfl?) to the "long"
3 4
 ## file.
... ...
@@ -52,8 +53,6 @@ mutsPerCloneLast <- function(x, per.pop.mean = TRUE) {
52 53
 p.value.threshold <- 0.01
53 54
 
54 55
 test_that("single named gene in mut. fail", {
55
-    
56
-    
57 56
     cat("\n s01: a runif is", runif(1), "\n")
58 57
     fea9 <- allFitnessEffects(noIntGenes = c("m" = 0.1, "D" = 0.3))
59 58
     muvar <- c("m" = 1e-5)
... ...
@@ -63,8 +62,6 @@ test_that("single named gene in mut. fail", {
63 62
 } )
64 63
 
65 64
 test_that("Per-gene mutation rates with old poset format, fail", {
66
-    
67
-    
68 65
     cat("\n s02: a runif is", runif(1), "\n")
69 66
     data(examplePosets)
70 67
     p701 <- examplePosets[["p701"]]
... ...
@@ -75,8 +72,6 @@ test_that("Per-gene mutation rates with old poset format, fail", {
75 72
 } )
76 73
 
77 74
 test_that("Only no-int, and sorting", {
78
-    
79
-    
80 75
     cat("\n s03: a runif is", runif(1), "\n")
81 76
     fea9 <- allFitnessEffects(noIntGenes = c("m" = 0.1, "D" = 0.3))
82 77
     ## OncoSimulR:::allNamedGenes(fea9)
... ...
@@ -102,8 +97,6 @@ test_that("Only no-int, and sorting", {
102 97
 } )
103 98
 
104 99
 test_that("Only no-int, unnamed, fail", {
105
-    
106
-    
107 100
     cat("\n s04: a runif is", runif(1), "\n")
108 101
     fea9 <- allFitnessEffects(noIntGenes = c(0.1, 0.3))
109 102
     OncoSimulR:::allNamedGenes(fea9)
... ...
@@ -114,8 +107,6 @@ test_that("Only no-int, unnamed, fail", {
114 107
 } )
115 108
 
116 109
 test_that("Only one, named, fail", {
117
-    
118
-    
119 110
     cat("\n s05: a runif is", runif(1), "\n")
120 111
     fea9 <- allFitnessEffects(noIntGenes = c("m" = 0.1))
121 112
     muvar <- c("m" = 1e-5)
... ...
@@ -125,8 +116,6 @@ test_that("Only one, named, fail", {
125 116
 } )
126 117
 
127 118
 test_that("Only no-int, different names, fail", {
128
-    
129
-    
130 119
     cat("\n s06: a runif is", runif(1), "\n")
131 120
     fea9 <- allFitnessEffects(noIntGenes = c("m" = 0.1, "D" = 0.3))
132 121
     ## OncoSimulR:::allNamedGenes(fea9)
... ...
@@ -137,8 +126,6 @@ test_that("Only no-int, different names, fail", {
137 126
 } )
138 127
 
139 128
 test_that("Only no-int, different numbers, fail", {
140
-    
141
-    
142 129
     cat("\n s07: a runif is", runif(1), "\n")
143 130
     fea9 <- allFitnessEffects(noIntGenes = c("m" = 0.1, "D" = 0.3))
144 131
     muvar <- c("m" = 1e-5, "D" = 1e-7, "E" = 1e-7)
... ...
@@ -155,8 +142,6 @@ test_that("Only no-int, different numbers, fail", {
155 142
 
156 143
 date()
157 144
 test_that("0 or negative mu not allowed", {
158
-    
159
-    
160 145
     cat("\n s15: a runif is", runif(1), "\n")
161 146
     muvar2 <- c("U" = 0, "z" = 1e-5, "e" = 1e-5, "m" = 1e-5, "D" = 1e-5)
162 147
     ni1 <- rep(0.02, 5)
... ...
@@ -199,8 +184,6 @@ date()
199 184
 #### Repeating above, but with McFL
200 185
 
201 186
 test_that("McFL: Per-gene mutation rates with old poset format, fail", {
202
-    
203
-    
204 187
     cat("\n sz01: a runif is", runif(1), "\n")
205 188
     data(examplePosets)
206 189
     p701 <- examplePosets[["p701"]]
... ...
@@ -210,9 +193,8 @@ test_that("McFL: Per-gene mutation rates with old poset format, fail", {
210 193
                  "Per-gene mutation rates cannot be used with the old poset format")
211 194
 } )
212 195
 
196
+
213 197
 test_that("McFL: Only no-int, and sorting", {
214
-    
215
-    
216 198
     cat("\n sz02: a runif is", runif(1), "\n")
217 199
     fea9 <- allFitnessEffects(noIntGenes = c("m" = 0.1, "D" = 0.3))
218 200
     ## OncoSimulR:::allNamedGenes(fea9)
... ...
@@ -243,8 +225,6 @@ test_that("McFL: Only no-int, and sorting", {
243 225
 } )
244 226
 
245 227
 test_that("McFL: Only no-int, unnamed, fail", {
246
-    
247
-    
248 228
     cat("\n sz03: a runif is", runif(1), "\n")
249 229
     fea9 <- allFitnessEffects(noIntGenes = c(0.1, 0.3))
250 230
     OncoSimulR:::allNamedGenes(fea9)
... ...
@@ -256,8 +236,6 @@ test_that("McFL: Only no-int, unnamed, fail", {
256 236
 } )
257 237
 
258 238
 test_that("McFL: Only one, named, fail", {
259
-    
260
-    
261 239
     cat("\n sz04: a runif is", runif(1), "\n")
262 240
     fea9 <- allFitnessEffects(noIntGenes = c("m" = 0.1))
263 241
     muvar <- c("m" = 1e-5)
... ...
@@ -268,8 +246,6 @@ test_that("McFL: Only one, named, fail", {
268 246
 } )
269 247
 
270 248
 test_that("McFL: Only no-int, different names, fail", {
271
-    
272
-    
273 249
     cat("\n sz05: a runif is", runif(1), "\n")
274 250
     fea9 <- allFitnessEffects(noIntGenes = c("m" = 0.1, "D" = 0.3))
275 251
     ## OncoSimulR:::allNamedGenes(fea9)
... ...
@@ -281,8 +257,6 @@ test_that("McFL: Only no-int, different names, fail", {
281 257
 } )
282 258
 
283 259
 test_that("McFL: Only no-int, different numbers, fail", {
284
-    
285
-    
286 260
     cat("\n sz06: a runif is", runif(1), "\n")
287 261
     fea9 <- allFitnessEffects(noIntGenes = c("m" = 0.1, "D" = 0.3))
288 262
     muvar <- c("m" = 1e-5, "D" = 1e-7, "E" = 1e-7)
... ...
@@ -298,10 +272,10 @@ test_that("McFL: Only no-int, different numbers, fail", {
298 272
 
299 273
 date()
300 274
 
275
+
301 276
 test_that("McFL: Same freqs, chisq, when s=0", {
302 277
     max.tries <- 4
303 278
     for(tries in 1:max.tries) {
304
-
305 279
         cat("\n s3: a runif is", runif(1), "\n")
306 280
         muvar2 <- c("U" = 1e-5, "z" = 1e-5, "e" = 1e-5, "m" = 1e-5, "D" = 1e-5)
307 281
         ni1 <- rep(0, 5)
... ...
@@ -330,8 +304,6 @@ test_that("McFL: Same freqs, chisq, when s=0", {
330 304
     
331 305
 date()
332 306
     
333
-date()
334
-
335 307
 test_that("McFL: Same freqs, chisq, when s", {
336 308
     max.tries <- 4
337 309
     for(tries in 1:max.tries) {
... ...
@@ -364,7 +336,7 @@ test_that("McFL: Same freqs, chisq, when s", {
364 336
 })
365 337
 date()
366 338
 
367
-date()
339
+
368 340
 test_that("McFL: Different freqs as they should be ordered and chisq, when s=0", {
369 341
     max.tries <- 4
370 342
     for(tries in 1:max.tries) {
... ...
@@ -434,7 +406,6 @@ test_that("McFL: Different freqs as they should be ordered when s and t > 1", {
434 406
 date()
435 407
 
436 408
 date()
437
-
438 409
 test_that("McFL: Different freqs as they should be ordered when s and t > 1, again", {
439 410
     max.tries <- 4
440 411
     for(tries in 1:max.tries) {
... ...
@@ -467,7 +438,7 @@ test_that("McFL: Different freqs as they should be ordered when s and t > 1, aga
467 438
 })
468 439
 date()
469 440
 
470
-date()
441
+
471 442
 test_that("McFL: Complex fitness specification, s diffs, tiny finalTime, systematic mu", {
472 443
     max.tries <- 4
473 444
     for(tries in 1:max.tries) {
... ...
@@ -684,63 +655,6 @@ test_that("McFL: Init mutant with tiny mutation always present", {
684 655
 })
685 656
 date()
686 657
 
687
-date()
688
-test_that("McFL: Different freqs as they should be ordered and chisq, when s  and a tiny mu", {
689
-    max.tries <- 4
690
-    for(tries in 1:max.tries) {
691
-        T1 <- T2 <- T3 <- T4 <- T5 <- T6 <- T7 &l