@@ -1,8 +1,8 @@

 Package: OncoSimulR

 Type: Package

 Title: Forward Genetic Simulation of Cancer Progression with Epistasis 

-Version: 2.99.3

-Date: 2020-12-13

+Version: 2.99.4

+Date: 2020-12-17

 Authors@R: c(

 	      person("Ramon", "Diaz-Uriarte", role = c("aut", "cre"),	

  	   		     email = "rdiaz02@gmail.com"),

@@ -53,17 +53,7 @@ phcl_from_lod <- function(df, x) {

     ## df <- df[!duplicated(df[, c(1, 2)]), , drop = FALSE]

     tG <- unique(c(as.character(df[, 1]), as.character(df[, 2])))

-    ## ## Do as in phylogClone. So that we have the same nodes

-    ## ## in LOD all and not LOD all?

-    ## z <- which_N_at_T(x, N = 1, t = "last")

-    ## tG <- x$GenotypesLabels[z]

-    

-    ## ## FIXME: aren't these two warnings redundant or aliased?

-    ## ## yes, partlt

-    ##  I think this can never happen now

-    ## if ((length(tG) == 1) && (tG == "")) {

-    ##     warning("There never was a descendant of WT")

-    ## }

+

     if (nrow(df) == 0) {

         warning("LOD structure has 0 rows: no descendants of initMutant ever appeared. ")

         return(NA)

@@ -149,15 +139,6 @@ diversityLOD <- function(llod) {

     shannonI(table(pathstr))

 }

-## diversityLOD <- function(llod) {

-##     nn <- names(llod[[1]])

-##     if( is_null_na(nn) ||

-##         !(is.list(llod)))

-##         stop("Object must be a list of LODs")

-##     pathstr <- unlist(lapply(llod, function(x) paste(names(x),

-##                                                      collapse = "_")))

-##     shannonI(table(pathstr))

-## }

 LOD_as_path <- function(llod) {

     path_l <- function(u) {

@@ -223,44 +204,6 @@ LOD.oncosimulpop <- function(x) return(lapply(x, LOD.internal))

-## POM.oncosimul2 <- function(x) {

-##     out <- POM.internal(x)

-##     class(out) <- c(class(out), "oncosimul_pom")

-##     return(out)

-## }

-

-## LOD.oncosimul2 <- function(x) {

-##     out <- LOD.internal(x)

-##     class(out) <- c(class(out), "oncosimul_lod")

-##     return(out)

-## }

-

-

-## POM.oncosimulpop <- function(x) {

-##     out <- lapply(x, POM.internal)

-##     class(out) <- c(class(out), "oncosimul_pom_list")

-##     return(out)

-## }

-

-## LOD.oncosimulpop <- function(x) {

-##     out <- lapply(x, LOD.internal)

-##     class(out) <- c(class(out), "oncosimul_lod_list")

-##     return(out)

-## }

-

-

-## summary.oncosimul_lod_list <- function(x) {

-##     cat("List of ", length(x), " simulations\n.")

-##     cat("Shannon's diversity (entropy) = ", diversityLOD(x), "\n")

-## }

-

-## summary.oncosimul_pom_list <- function(x) {

-##     cat("List of ", length(x), " simulations\n.")

-##     cat("Shannon's diversity (entropy) = ", diversityPOM(x), "\n")

-## }

-

-

-

 POM_pre_2.9.2 <- function(x) {

     if(is.null(x$pops.by.time)) {

         warning("Missing needed components. This might be a failed simulation.",

@@ -369,45 +312,6 @@ LOD.internal_pre_2.9.2 <- function(x, strict) {

-## LOD_as_path_pre_2.9.2 <- function(llod) {

-##     path_l <- function(u) {

-##         if(length(u$lod_single) == 1) {

-##             if(is.null(attributes(u)$initMutant))

-##                 initMutant <- ""

-##             else

-##                 initMutant <- attributes(u)$initMutant

-##             if(initMutant == "") initMutant <- "WT"

-##             if(grepl("_is_end", u$lod_single))

-##                 return(initMutant)

-##             if(u$lod_single == "No_descendants")

-##                 return(initMutant)

-##         } else {

-##             ## Deal with "" meaning WT

-##             the_names <- names(u$lod_single)

-##             the_names_wt <- which(the_names == "")

-            

-##             if(length(the_names_wt)) {

-##                 if(length(the_names_wt) > 1) stop("more than 1 WT?!")

-##                 if(the_names_wt > 1) stop("WT in position not 1?!")

-##                 the_names[the_names_wt] <- "WT"

-##             }

-##             return(paste(the_names, collapse = " -> ")) 

-##             ## return(paste0("WT", paste(names(u$lod_single),

-##             ##                           collapse = " -> ")) )

-##         }

-##     }

-##     if(identical(names(llod), c("all_paths", "lod_single")))

-##         pathstr <- path_l(llod)

-##     else {

-##         ## should be a list

-##         pathstr <- unlist(lapply(llod, path_l))

-##     }

-##     return(pathstr)

-##     ## pathstr <- unlist(lapply(llod, function(x) paste(names(x$lod_single),

-##     ##                                                  collapse = " -> ")))

-##     ## return(paste0("WT", pathstr))

-## }

-

 LOD.oncosimul2_pre_2.9.2 <- function(x, strict = TRUE)

@@ -16,12 +16,9 @@

 ## Posets, restriction tables, etc.

-

 ## This is all too complicated. Have here just the minimal set we need,

 ## because we will soon be changing formats.

-

-

 ## When we go poset -> rT or

 ##  adjMat -> rT

@@ -151,35 +148,7 @@ adjmat.to.restrictTable <- function(x, root = FALSE,

                              orderedNames = TRUE)

     if(root)

         x <- x[-1, -1, drop = FALSE]

-    ## ## we have the zero

-    ## if( any(colnames(x) %in% c("0", "root", "Root")) & !root)

-    ##     warning("Looks like the matrix has a root but you specified root = FALSE")

-

-    ## if(!identical(colnames(x), rownames(x)))

-    ##     stop("colnames and rownames not identical")

-    ## if(root) {

-    ##     posRoot <- which(colnames(x) %in% rootNames)

-    ##     if(!length(posRoot))

-    ##         stop("No column with the root name")

-    ##     if(length(posRoot) > 1)

-    ##         stop("Ambiguous location of root")

-    ##     x <- x[-posRoot, -posRoot]

-    ## }

-

-    ## if(typeof(x) != "integer")

-    ##     warning("This is not an _integer_ adjacency matrix")

-    ## if( !all(x %in% c(0, 1) ))

-    ##     stop("Values not in [0, 1]")

-

-    ## if(!is.null(colnames(x))) {

-    ##     ## FIXME: this makes sense with numeric labels for columns, but

-    ##     ## not ow.

-    ##     oi <- order(as.numeric(colnames(x)))

-    ##     if(any(oi != (1:ncol(x)))) {

-    ##         warning("Reordering adjacency matrix")

-    ##         x <- x[oi, oi]

-    ##     }

-    ## }

+ 

     num.deps <- colSums(x)

     max.n.deps <- max(num.deps)

@@ -205,29 +174,11 @@ adjmat.to.restrictTable <- function(x, root = FALSE,

 OTtoPoset <- function(x) {

     checkProperOTAdjMat(x)

-    ## ## root must always be dropped, as we are creating a poset

-    ## dropRoot <- TRUE

-    ## if(!dropRoot)

-    ##     warning("Are you sure you do not want dropRoot?")

-    ## if(dropRoot) {

-    ##     ncx <- ncol(x)

-    ##     x <- x[-1, -1]

-    ##     ## y <- (which(x == 1L, arr.ind = TRUE) )

-    ##     ## if(nrow(y) == 0) ## all nodes descend from 0

-    ##     ##     y <- cbind(0L, ncx - 1L)

-    ##     namesInts <- type.convert(colnames(x), as.is = TRUE)

-        

-    ## } else {

-    ##     ## y <- (which(x == 1L, arr.ind = TRUE) )

-    ##     namesInts <- c(0L, type.convert(colnames(x)[-1], as.is = TRUE))

-    ## }

+

     ncx <- ncol(x)

     x <- x[-1, -1, drop = FALSE]

-    ## y <- (which(x == 1L, arr.ind = TRUE) )

-    ## if(nrow(y) == 0) ## all nodes descend from 0

-    ##     y <- cbind(0L, ncx - 1L)

-    namesInts <- type.convert(colnames(x), as.is = TRUE)

+  namesInts <- type.convert(colnames(x), as.is = TRUE)

     if(!is.integer(namesInts))

         stop("cannot convert to poset adj mat with non-int colnames")

@@ -242,34 +193,6 @@ OTtoPoset <- function(x) {

     return(p2)

 }    

-## the next is just a convenience

-## sortAdjMat <- function(am) {

-##     cn <- colnames(am)

-##     rootpos <- grep("^Root$", cn) 

-##     if(length(rootpos) != 1)

-##         stop("No root in adj mat, or multiple Roots")

-##     cn <- c("Root", sort(colnames(am)[-rootpos]))

-##     return(am[cn, cn])

-## }

-

-

-## No longer used

-## sortAdjMat <- function(am) {

-##     ## If column names, except Root, are integers, sort as integers. O.w.,

-##     ## general lexicog. sort.

-##     cn <- colnames(am)

-##     rootpos <- grep("^Root$", cn) 

-##     if(length(rootpos) != 1)

-##         stop("No root in adj mat, or multiple Roots")

-##     cn0 <- colnames(am)[-rootpos]

-##     namesInts <- type.convert(cn0, as.is = TRUE)

-##     if(is.integer(namesInts)) {

-##         cn <- c("Root", sort(namesInts))

-##     } else {

-##         cn <- c("Root", sort(cn0))

-##     }

-##     return(am[cn, cn])

-## }

@@ -16,12 +16,6 @@

 ## plot.evalAllGenotypes <- plot.evalAllGenotypesMut <-

 ##     plot.genotype_fitness_matrix <- plotFitnessLandscape 

-## FIXME: show only accessible paths? 

-## FIXME: when show_labels = FALSE we still show the boxes

-##        and some of the labels.!!!

-## FIXME: if using only_accessible, maybe we

-## can try to use fast_peaks, and use the slower

-## approach as fallback (if identical fitness)

 plotFitnessLandscape <- function(x, show_labels = TRUE,

                                  col = c("green4", "red", "yellow"),

                                  lty = c(1, 2, 3), use_ggrepel = FALSE,

@@ -31,7 +25,12 @@ plotFitnessLandscape <- function(x, show_labels = TRUE,

                                  ...) {

     ## FIXME future:

-

+    ## FIXME: when show_labels = FALSE we still show the boxes

+    ##        and some of the labels.!!!

+    ## FIXME: if using only_accessible, maybe we

+    ## can try to use fast_peaks, and use the slower

+    ## approach as fallback (if identical fitness)

+    

     ## - Allow passing order effects. Change "allGenotypes_to_matrix"

     ##   below? Probably not, as we cannot put order effects as a

     ##   matrix. Do something else, like allow only order effects if from

@@ -70,14 +69,7 @@ plotFitnessLandscape <- function(x, show_labels = TRUE,

     }

     vv <- which(!is.na(gaj), arr.ind = TRUE)

-    ## plot(x = mutated, y = e1$Fitness, ylab = "Fitness",

-    ##      xlab = "", type = "n", axes = FALSE)

-    ## box()

-    ## axis(2)

-    ## text(x = mutated, y = x$Fitness, labels = x$Genotype)

-

-    ## The R CMD CHEKC notes about no visible binding for global variable

-

+  

     x_from <- y_from <- x_to <- y_to <- Change <- muts <-

         label <- fitness <- Type <- NULL

@@ -184,27 +176,6 @@ plot.evalAllGenotypes <- plot.evalAllGenotypesMut <-

 ######################################################################

-## wrap_filter_inaccessible <- function(x, max_num_genotypes, accessible_th) {

-##     ## wrap it, for my consumption

-##     tfm <- to_Fitness_Matrix(x, max_num_genotypes = max_num_genotypes)

-##     mutated <- rowSums(tfm$gfm[, -ncol(tfm$gfm)])

-##     gaj <- genot_to_adj_mat(tfm$gfm)

-##     gaj <- filter_inaccessible(gaj, accessible_th)

-##     remaining <- as.numeric(colnames(gaj))

-##     mutated <- mutated[remaining]

-##     tfm$afe <- tfm$afe[remaining, , drop = FALSE]

-##     return(list(remaining = remaining,

-##                 mutated = mutated,

-##                 tfm = tfm))

-## }

-

-## No longer being used. Used to be in rfitness

-## count_accessible_g <- function(gfm, accessible_th) {

-##     gaj <- genot_to_adj_mat(gfm)

-##     gaj <- filter_inaccessible(gaj, accessible_th)

-##     return(ncol(gaj) - 1)

-## }

-

 ## There is now C++ code to get just the locations/positions of the

 ## accessible genotypes

@@ -47,18 +47,6 @@ to_Magellan <- function(x, file,

-## ## genotype_fitness_matrix -> fitness landscape as data frame

-## fmatrix_to_afe <- function(x) {

-##     stopifnot(inherits(x, "genotype_fitness_matrix"))

-##     y <- x[, -ncol(x)]

-##     nn <- apply(y, 1,

-##                 function(u) paste(sort(colnames(y)[as.logical(u)]),

-##                                   collapse = ", "))

-##     nn[nn == ""] <- "WT"

-##     return(data.frame(Genotype = nn, Fitness = x[, ncol(x)],

-##            stringsAsFactors = FALSE))

-## }

-

 to_Fitness_Matrix <- function(x, max_num_genotypes) {

     ## A general converter. Ready to be used by plotFitnessLandscape and

     ## Magellan exporter.

@@ -124,217 +112,181 @@ to_Fitness_Matrix <- function(x, max_num_genotypes) {

 ## but if we are passed a fitness landscapes as produced by

 ## rfitness, do nothing. Well, it actually does something.

-

-##Modified

 to_genotFitness_std <- function(x,

                                 frequencyDependentFitness = FALSE,

                                 frequencyType = frequencyType,

                                 simplify = TRUE,

                                 min_filter_fitness = 1e-9,

                                 sort_gene_names = TRUE) {

-  ## Would break with output from allFitnessEffects and

-  ## output from allGenotypeAndMut

-

-  ## For the very special and weird case of

-  ## a matrix but only a single gene so with a 0 and 1

-  ## No, this is a silly and meaningless case.

-  ## if( ( ncol(x) == 2 ) && (nrow(x) == 1) && (x[1, 1] == 1) ) {

-

-  ## } else  blabla:

-

-

-

-  ## if((ncol(x) > 2) && !(inherits(x, "matrix"))

-  ##     stop(paste0("Genotype fitness input either two-column data frame",

-  ##          " or a numeric matrix with > 2 columns."))

-  ## if( (ncol(x) > 2) && (nrow(x) == 1) )

-  ##     stop(paste0("It looks like you have a matrix for a single genotype",

-  ##                 " of a single gene. For this degenerate cases use",

-  ##                 " a data frame specification."))

-

-

+    ## Would break with output from allFitnessEffects and

+    ## output from allGenotypeAndMut

     if(! (inherits(x, "matrix") || inherits(x, "data.frame")) )

-      stop("Input must inherit from matrix or data.frame.")

+        stop("Input must inherit from matrix or data.frame.")

     if(ncol(x) > 2) {

-      if (!frequencyDependentFitness){

-        if(inherits(x, "matrix")) {

-          if(!is.numeric(x))

-            stop("A genotype fitness matrix/data.frame must be numeric.")

-        } else if(inherits(x, "data.frame")) {

-          if(!all(unlist(lapply(x, is.numeric))))

-            stop("A genotype fitness matrix/data.frame must be numeric.")

-        }

-      }else{

-        if(!inherits(x, "data.frame"))

-           stop("Input must inherit from data.frame.")

-        if(ncol(x) == 0){

-          stop("You have an empty data.frame")

-        }

-        if(!all(unlist(lapply(x[,-ncol(x)], is.numeric)))){

-          stop("All columns except last one must be numeric.")

+        if (!frequencyDependentFitness){

+            if(inherits(x, "matrix")) {

+                if(!is.numeric(x))

+                    stop("A genotype fitness matrix/data.frame must be numeric.")

+            } else if(inherits(x, "data.frame")) {

+                if(!all(unlist(lapply(x, is.numeric))))

+                    stop("A genotype fitness matrix/data.frame must be numeric.")

+            }

+        }else{

+            if(!inherits(x, "data.frame"))

+                stop("Input must inherit from data.frame.")

+            if(ncol(x) == 0){

+                stop("You have an empty data.frame")

+            }

+            if(!all(unlist(lapply(x[,-ncol(x)], is.numeric)))){

+                stop("All columns except last one must be numeric.")

+            }

+            if(is.factor(x[, ncol(x)])) {

+                warning("Last column of genotype fitness is a factor. ",

+                        "Converting to character.")

+                x[, ncol(x)] <- as.character(x[, ncol(x)])

+            }

+            if(!all(unlist(lapply(x[, ncol(x)], is.character)))){

+                stop("All elements in last column must be character.")

+            }

         }

-        if(is.factor(x[, ncol(x)])) {

-          warning("Last column of genotype fitness is a factor. ",

-                  "Converting to character.")

-          x[, ncol(x)] <- as.character(x[, ncol(x)])

+

+        ## We are expecting here a matrix of 0/1 where columns are genes

+        ## except for the last column, that is Fitness

+        ## Of course, can ONLY work with epistastis, NOT order

+        ## return(genot_fitness_to_epistasis(x))

+        if(any(duplicated(colnames(x))))

+            stop("duplicated column names")

+

+        cnfl <- which(colnames(x)[-ncol(x)] == "")

+        if(length(cnfl)) {

+            freeletter <- setdiff(LETTERS, colnames(x))[1]

+            if(length(freeletter) == 0) stop("Renaiming failed")

+            warning("One column named ''. Renaming to ", freeletter)

+            colnames(x)[cnfl] <- freeletter

         }

-        if(!all(unlist(lapply(x[, ncol(x)], is.character)))){

-          stop("All elements in last column must be character.")

+        if(!is.null(colnames(x)) && sort_gene_names) {

+            ncx <- ncol(x)

+            cnx <- colnames(x)[-ncx]

+            ocnx <- gtools::mixedorder(cnx)

+            if(!(identical(cnx[ocnx], cnx))) {

+                message("Sorting gene column names alphabetically")

+                x <- cbind(x[, ocnx, drop = FALSE], Fitness = x[, (ncx)])

+            }

         }

-      }

-

-      ## We are expecting here a matrix of 0/1 where columns are genes

-      ## except for the last column, that is Fitness

-      ## Of course, can ONLY work with epistastis, NOT order

-      ## return(genot_fitness_to_epistasis(x))

-      if(any(duplicated(colnames(x))))

-        stop("duplicated column names")

-

-      cnfl <- which(colnames(x)[-ncol(x)] == "")

-      if(length(cnfl)) {

-        freeletter <- setdiff(LETTERS, colnames(x))[1]

-        if(length(freeletter) == 0) stop("Renaiming failed")

-        warning("One column named ''. Renaming to ", freeletter)

-        colnames(x)[cnfl] <- freeletter

-      }

-      if(!is.null(colnames(x)) && sort_gene_names) {

-        ncx <- ncol(x)

-        cnx <- colnames(x)[-ncx]

-        ocnx <- gtools::mixedorder(cnx)

-        if(!(identical(cnx[ocnx], cnx))) {

-          message("Sorting gene column names alphabetically")

-          x <- cbind(x[, ocnx, drop = FALSE], Fitness = x[, (ncx)])

+

+        if(is.null(colnames(x))) {

+            ncx <- (ncol(x) - 1)

+            message("No column names: assigning gene names from LETTERS")

+            if(ncx > length(LETTERS))

+                stop("More genes than LETTERS; please give gene names",

+                     " as you see fit.")

+            colnames(x) <- c(LETTERS[1:ncx], "Fitness")

         }

-      }

-

-      if(is.null(colnames(x))) {

-        ncx <- (ncol(x) - 1)

-        message("No column names: assigning gene names from LETTERS")

-        if(ncx > length(LETTERS))

-          stop("More genes than LETTERS; please give gene names",

-               " as you see fit.")

-        colnames(x) <- c(LETTERS[1:ncx], "Fitness")

-      }

-      if(!all(as.matrix(x[, -ncol(x)]) %in% c(0, 1) ))

-        stop("First ncol - 1 entries not in {0, 1}.")

+        if(!all(as.matrix(x[, -ncol(x)]) %in% c(0, 1) ))

+            stop("First ncol - 1 entries not in {0, 1}.")

     } else {

-      if(!inherits(x, "data.frame"))

-        stop("genotFitness: if two-column must be data frame")

-      if(ncol(x) == 0){

-        stop("You have an empty data.frame")

-      }

-      ## Make sure no factors

-      if(is.factor(x[, 1])) {

-        warning("First column of genotype fitness is a factor. ",

-                "Converting to character.")

-        x[, 1] <- as.character(x[, 1])

-      }

-      ## Make sure no numbers

-      if(any(is.numeric(x[, 1])))

-        stop(paste0("genotFitness: first column of data frame is numeric.",

-                    " Ambiguous and suggests possible error. If sure,",

-                    " enter that column as character"))

-

-      omarker <- any(grepl(">", x[, 1], fixed = TRUE))

-      emarker <- any(grepl(",", x[, 1], fixed = TRUE))

-      nogoodepi <- any(grepl(":", x[, 1], fixed = TRUE))

-      ## if(omarker && emarker) stop("Specify only epistasis or order, not both.")

-      if(nogoodepi && emarker) stop("Specify the genotypes separated by a ',', not ':'.")

-      if(nogoodepi && !emarker) stop("Specify the genotypes separated by a ',', not ':'.")

-      ## if(nogoodepi && omarker) stop("If you want order, use '>' and if epistasis ','.")

-      ## if(!omarker && !emarker) stop("You specified neither epistasis nor order")

-      if(omarker) {

-        ## do something. To be completed

-        stop("This code not yet ready")

-        ## You can pass to allFitnessEffects genotype -> fitness mappings that

-        ## involve epistasis and order. But they must have different

-        ## genes. Otherwise, it is not manageable.

-      }

-      if( emarker || ( (!omarker) && (!emarker) && (!nogoodepi)) ) {

-        ## the second case above corresponds to passing just single letter genotypes

-        ## as there is not a single marker

-        x <- x[, c(1, 2), drop = FALSE]

-        if(!all(colnames(x) == c("Genotype", "Fitness"))) {

-          message("Column names of object not Genotype and Fitness.",

-                  " Renaming them assuming that is what you wanted")

-          colnames(x) <- c("Genotype", "Fitness")

-        }

-        if((!omarker) && (!emarker) && (!nogoodepi)) {

-          message("All single-gene genotypes as input to to_genotFitness_std")

+        if(!inherits(x, "data.frame"))

+            stop("genotFitness: if two-column must be data frame")

+        if(ncol(x) == 0){

+            stop("You have an empty data.frame")

         }

-        ## Yes, we need to do this to  scale the fitness and put the "-"

-        if(frequencyDependentFitness){

-          anywt <- which(x[, 1] == "WT")

-          if (length(anywt) > 1){

-              stop("WT should not appear more than once in fitness specification")

-              ## stop("WT must appear once.")

-          }

-          ## if(length(anywt) == 0) {

-          ##     x <- rbind(data.frame(Genotype = "WT", Fitness = "0"),

-          ##                x)

-          ## }

-          if(is.factor(x[, ncol(x)])) {

-            warning("Second column of genotype fitness is a factor. ",

+        ## Make sure no factors

+        if(is.factor(x[, 1])) {

+            warning("First column of genotype fitness is a factor. ",

                     "Converting to character.")

-            x[, ncol(x)] <- as.character(x[, ncol(x)])

-          }

+            x[, 1] <- as.character(x[, 1])

+        }

+        ## Make sure no numbers

+        if(any(is.numeric(x[, 1])))

+            stop(paste0("genotFitness: first column of data frame is numeric.",

+                        " Ambiguous and suggests possible error. If sure,",

+                        " enter that column as character"))

+

+        omarker <- any(grepl(">", x[, 1], fixed = TRUE))

+        emarker <- any(grepl(",", x[, 1], fixed = TRUE))

+        nogoodepi <- any(grepl(":", x[, 1], fixed = TRUE))

+        if(nogoodepi && emarker) stop("Specify the genotypes separated by a ',', not ':'.")

+        if(nogoodepi && !emarker) stop("Specify the genotypes separated by a ',', not ':'.")

+        if(omarker) {

+            ## do something. To be completed

+            stop("This code not yet ready")

+            ## You can pass to allFitnessEffects genotype -> fitness mappings that

+            ## involve epistasis and order. But they must have different

+            ## genes. Otherwise, it is not manageable.

+        }

+        if( emarker || ( (!omarker) && (!emarker) && (!nogoodepi)) ) {

+            ## the second case above corresponds to passing just single letter genotypes

+            ## as there is not a single marker

+            x <- x[, c(1, 2), drop = FALSE]

+            if(!all(colnames(x) == c("Genotype", "Fitness"))) {

+                message("Column names of object not Genotype and Fitness.",

+                        " Renaming them assuming that is what you wanted")

+                colnames(x) <- c("Genotype", "Fitness")

+            }

+            if((!omarker) && (!emarker) && (!nogoodepi)) {

+                message("All single-gene genotypes as input to to_genotFitness_std")

+            }

+            ## Yes, we need to do this to  scale the fitness and put the "-"

+            if(frequencyDependentFitness){

+                anywt <- which(x[, 1] == "WT")

+                if (length(anywt) > 1){

+                    stop("WT should not appear more than once in fitness specification")

+                }

+                if(is.factor(x[, ncol(x)])) {

+                    warning("Second column of genotype fitness is a factor. ",

+                            "Converting to character.")

+                    x[, ncol(x)] <- as.character(x[, ncol(x)])

+                }

+            }

+

+            x <- allGenotypes_to_matrix(x, frequencyDependentFitness)

         }

-

-        x <- allGenotypes_to_matrix(x, frequencyDependentFitness)

-      }

     }

     ## And, yes, scale all fitnesses by that of the WT

     if (!frequencyDependentFitness){

-      whichroot <- which(rowSums(x[, -ncol(x), drop = FALSE]) == 0)

-      if(length(whichroot) == 0) {

-        warning("No wildtype in the fitness landscape!!! Adding it with fitness 1.")

-        x <- rbind(c(rep(0, ncol(x) - 1), 1), x)

-      } else if(x[whichroot, ncol(x)] != 1) {

-        warning("Fitness of wildtype != 1.",

-                " Dividing all fitnesses by fitness of wildtype.")

-        vwt <- x[whichroot, ncol(x)]

-        x[, ncol(x)] <- x[, ncol(x)]/vwt

-      }

+        whichroot <- which(rowSums(x[, -ncol(x), drop = FALSE]) == 0)

+        if(length(whichroot) == 0) {

+            warning("No wildtype in the fitness landscape!!! Adding it with fitness 1.")

+            x <- rbind(c(rep(0, ncol(x) - 1), 1), x)

+        } else if(x[whichroot, ncol(x)] != 1) {

+            warning("Fitness of wildtype != 1.",

+                    " Dividing all fitnesses by fitness of wildtype.")

+            vwt <- x[whichroot, ncol(x)]

+            x[, ncol(x)] <- x[, ncol(x)]/vwt

+        }

     }

     if(any(is.na(x)))

         stop("NAs in fitness matrix")

     if(!frequencyDependentFitness) {

         if(is.data.frame(x)) 

-        x <- as.matrix(x)

+            x <- as.matrix(x)

         stopifnot(inherits(x, "matrix"))

         if(simplify) {

-           x <- x[x[, ncol(x)] > min_filter_fitness, , drop = FALSE]  

+            x <- x[x[, ncol(x)] > min_filter_fitness, , drop = FALSE]  

         }

         class(x) <- c("matrix", "genotype_fitness_matrix")

     } else { ## frequency-dependent fitness

-        ## RDU: what is this for? It converts to numbers.

-        ## But it does not work reliably. It does not work when given as "n_"

-        ## We will do this at end. in full_FDF_spec

-        ## conversionTable_o <- conversionTable(ncol(x) - 1, frequencyType)

-        

-        ## x[, ncol(x)] <- sapply(x[, ncol(x)],

-        ##                        function(x){ findAndReplace(x, conversionTable_o)})

-        

-    if(frequencyType == "auto"){

-      ch <- paste(as.character(x[, ncol(x)]), collapse = "")

-      if( grepl("f_", ch, fixed = TRUE) ){

-        frequencyType = "rel"

-        pattern <- stringr::regex("f_(\\d*_*)*")

-        

-      } else if ( grepl("n_", ch, fixed = TRUE) ){

-        frequencyType = "abs"

-        pattern <- stringr::regex("n_(\\d*_*)*")

-      } else { stop("No pattern found when frequencyType set to 'auto'") }

-        

-    } else if(frequencyType == "abs"){

+        if(frequencyType == "auto"){

+            ch <- paste(as.character(x[, ncol(x)]), collapse = "")

+            if( grepl("f_", ch, fixed = TRUE) ){

+                frequencyType = "rel"

+                pattern <- stringr::regex("f_(\\d*_*)*")

+                

+            } else if ( grepl("n_", ch, fixed = TRUE) ){

+                frequencyType = "abs"

+                pattern <- stringr::regex("n_(\\d*_*)*")

+                

+            } else { stop("No pattern found when frequencyType set to 'auto'") }

+            

+        } else if(frequencyType == "abs"){

             pattern <- stringr::regex("n_(\\d*_*)*")

         } else {

             pattern <- stringr::regex("f_(\\d*_*)*")

@@ -352,7 +304,7 @@ to_genotFitness_std <- function(x,

         }

     }

-  return(x)

+    return(x)

 }

 ## Deprecated after flfast

@@ -624,8 +576,6 @@ Magellan_stats <- function(x, max_num_genotypes = 2000,

                       args = paste(shortarg, logarg, zarg, "-o", fnret, fn),

                       stdout = NULL)

     if(short) {

-        ## tmp <- as.vector(read.table(fnret, skip = 1, header = TRUE)[-1])

-

         tmp <- unlist(read.table(fnret, skip = 1, header = TRUE)[c(-1)])

         ## ## Make names more explicit, but check we have what we think we have

         ## ## New versions of Magellan produce different output apparently of variable length

@@ -12,92 +12,26 @@

 ## License: GPL (>= 2)

 nem_transitive.reduction <- function(g){

-	if (!any(class(g)%in%c("matrix","graphNEL"))) stop("Input must be an adjacency matrix or graphNEL object")

-	if(any(class(g) == "graphNEL")){

-		g = as(g, "matrix")		

-	}

-# 	if("Rglpk" %in% loadedNamespaces()){ # constraints müssen einzeln hinzugefügt und jedesmal das ILP gelöst werden. Danach müssen jedesmal die constraints überprüft werden und nicht mehr gebrauchte rausgeschmissen werden

-# 		g = abs(g) - diag(diag(g))

-# 		mat = matrix(0, ncol=sum(g), nrow=0)

-# 		idx = cbind(which(g == 1, arr.ind=T), 1:sum(g))		

-# 		for(y in 1:nrow(g)){

-# 			for(x in 1:nrow(g)){

-# 				if(g[x,y] != 0){

-# 					for(j in 1:nrow(g)){

-# 						if((g[y,j] != 0) && (g[x,j] != 0)){

-# 							mat.tmp = double(sum(g))

-# 							mat.tmp[idx[idx[,1] == x & idx[,2] == y, 3]] = 1

-# 							mat.tmp[idx[idx[,1] == y & idx[,2] == j, 3]] = 1

-# 							mat.tmp[idx[idx[,1] == x & idx[,2] == j, 3]] = -1

-# 							mat = rbind(mat, mat.tmp)

-# 						}						

-# 					}

-# 				}

-# 			}

-# 		}

-# 		

-# 		solve.problem = function(mat.tmp){

-# 			obj = rep(1, NCOL(mat.tmp))

-# 			rhs = 2

-# 			dir = ">="

-# 			sol = Rglpk_solve_LP(obj, mat.tmp, dir, rhs, max=TRUE, types=rep("B", NCOL(mat.tmp)))

-# 			print(sol)			

-# 			del = idx[which(sol$solution == 0), c(1, 2),drop=F]

-# 			for(i in 1:NROW(del)){

-# 				g[del[i,1], del[i,2]] = 0

-# 			}

-# 			g

-# 		}

-# 		

-# 		while(NROW(mat) > 0){

-# 			g = solve.problem(mat[1,,drop=F])

-# 			i = 1

-# 			while(i <= NROW(mat)){

-# 				idx.pos = which(mat[i,,drop=F] == 1)

-# 				idx.neg = which(mat[i,,drop=F] == -1)

-# 				xy = idx[idx[,3] %in% idx.pos, c(1,2)]

-# 				z = idx[idx[,3] == idx.neg, c(1,2)]

-# 				if(!(g[xy[1,1], xy[1,2]] == 1 & g[xy[2,1], xy[2,2]] == 1 & g[z[1], z[2]] == 1)) # remove resolved constraints

-# 					mat = mat[-i,,drop=F]

-# 				else

-# 					i = i + 1

-# 			}

-# 		}

-# 	}

-# 	else{

-# 	if(class(g) == "matrix"){		

-		# modified algorithm from Sedgewick book: just remove transitive edges instead of inserting them		

+    if (!any(class(g)%in%c("matrix","graphNEL"))) stop("Input must be an adjacency matrix or graphNEL object")

+    if(any(class(g) == "graphNEL")){

+        g = as(g, "matrix")		

+    }

+

     g = nem_transitive.closure(g, mat=TRUE) # bug fix: algorithm only works for transitively closed graphs!

-		g = g - diag(diag(g))

-		type = (g > 1)*1 - (g < 0)*1	

-		for(y in 1:nrow(g)){

-			for(x in 1:nrow(g)){

-				if(g[x,y] != 0){

-					for(j in 1:nrow(g)){

-						if((g[y,j] != 0) & sign(type[x,j])*sign(type[x,y])*sign(type[y,j]) != -1){ 

-						    g[x,j] = 0

-						}

-					}

-				}

-			}

-		}

-# 	}

-# 	else{		

-# 		nodenames=nodes(g)		

-# 		for(y in 1:length(nodes(g))){

-# 			edges = edgeL(g)

-# 			x = which(sapply(edges,function(l) y %in% unlist(l)))

-# 			j = unlist(edges[[y]])

-# 			cands = sapply(edges[x], function(e) list(intersect(unlist(e),j)))			

-# 			cands = cands[sapply(cands,length) > 0]

-# 			if(length(cands) > 0)

-# 				for(c in 1:length(cands)){ 				

-# 					jj = unlist(cands[c])					

-# 					g = removeEdge(rep(names(cands)[c],length(jj)),nodenames[jj],g)

-# 				}

-# 		}

-# 	}	

-	g		

+    g = g - diag(diag(g))

+    type = (g > 1)*1 - (g < 0)*1	

+    for(y in 1:nrow(g)){

+        for(x in 1:nrow(g)){

+            if(g[x,y] != 0){

+                for(j in 1:nrow(g)){

+                    if((g[y,j] != 0) & sign(type[x,j])*sign(type[x,y])*sign(type[y,j]) != -1){ 

+                        g[x,j] = 0

+                    }

+                }

+            }

+        }

+    }

+    g		

 }

@@ -107,33 +41,24 @@ nem_transitive.closure <- function(g,mat=FALSE,loops=TRUE){

     if (!any(class(g)%in%c("graphNEL","matrix"))) stop("Input must be either graphNEL object or adjacency matrix")

     g <- as(g, "matrix")

-    #-- adjacency matrix

-#     if (class(g)=="matrix"){

-		n <- ncol(g)

-		matExpIterativ <- function(x,pow,y=x,z=x,i=1) {

-		while(i < pow) {

-			z <- z %*% x

-			y <- y+z

-			i <- i+1

-		}

-		return(y)

-		}

-	

-		h <- matExpIterativ(g,n)

-		h <- (h>0)*1   

-		dimnames(h) <- dimnames(g)

-		if (!loops) diag(h) <- rep(0,n) else diag(h) <- rep(1,n)

-		if (!mat) h <- as(h,"graphNEL")	

-#     }

+                                        #-- adjacency matrix

+                                        #     if (class(g)=="matrix"){

+    n <- ncol(g)

+    matExpIterativ <- function(x,pow,y=x,z=x,i=1) {

+        while(i < pow) {

+            z <- z %*% x

+            y <- y+z

+            i <- i+1

+        }

+        return(y)

+    }

+    

+    h <- matExpIterativ(g,n)

+    h <- (h>0)*1   

+    dimnames(h) <- dimnames(g)

+    if (!loops) diag(h) <- rep(0,n) else diag(h) <- rep(1,n)

+    if (!mat) h <- as(h,"graphNEL")	

+                                        #     }

-# #     -- graphNEL object

-#     if (class(g)=="graphNEL"){

-#         tc <- RBGL::transitive.closure(g)