1. OncoSimulR
  2. R
  3. new-restrict.R
Browse code

3.99.1: interventions, death with fdf, user variables

ramon diaz-uriarte (at Phelsuma) authored on 25/06/2022 14:24:13
Showing 1 changed files
R/new-restrict.R
History View file @ 79ffadf
... ... 
@@ -363,48 +363,128 @@ getGeneIDNum <- function(geneModule, geneNoInt, fitnessLandscape_gene_id,
363 363 
 }
364 364
365 365
366 
-## genotFitnes and frequency type -> fitnesLanscapeVariables for FDF and
366 
+## genotFitness and frequency type -> fitnessLanscapeVariables for FDF and
367 367 
 ##          fitness with numbers, not names
368 368 
 ##   Done in a single function since both operations make
369 369 
 ##   the same assumptions
370 
-create_flvars_fitvars <- function(genotFitness, frequencyType) {
371 
-    x <- genotFitness[, -ncol(genotFitness), drop = FALSE]
370 
+create_flvars_fitvars <- function(genotFitness, frequencyType, frequencyDependentBirth,
371 
+                                  frequencyDependentDeath, frequencyDependentFitness,
372 
+                                  deathSpec) {
373 
+    if(deathSpec) {
374 
+      x <- genotFitness[, -c((ncol(genotFitness)-1):ncol(genotFitness)), drop = FALSE]
375 
+
376 
+    }
377 
+    else {
378 
+      x <- genotFitness[, -ncol(genotFitness), drop = FALSE]
379 
+    }
380 
+
372 381 
     pasted <- apply(x, 1, function(z) paste(sort(which(z == 1)), collapse = "_"))
373 382 
     npasted <- apply(x, 1, function(z) paste(sort(colnames(x)[which(z == 1)]), collapse = "_"))
374 
-    if(frequencyType == "abs") {
383 
+
384 
+    if(frequencyDependentBirth) {
385 
+
386 
+      if(frequencyType == "abs") {
387 
+          prefix <- "n_"
388 
+          prefixre <- "^n_"
389 
+      } else {
390 
+          prefix <- "f_"
391 
+          prefixre <- "^f_"
392 
+      }
393 
+      flvarsb <- paste0(prefix, pasted)
394 
+      names(flvarsb) <- npasted
395 
+
396 
+      ## make sure we get f_1_2 and not f_2_1, etc
397 
+      flvars2 <- flvarsb
398 
+      names(flvars2) <- paste0(prefix, names(flvarsb))
399 
+
400 
+      rmwt <- which(flvars2 == prefix)
401 
+      if(length(rmwt)) flvars2 <- flvars2[-rmwt] ## rm this.
402 
+
403 
+      ## Need to rev the vector, to ensure larger patterns come first
404 
+      ## and to place "f_" as last.
405 
+      rflvars2 <- rev(flvars2)
406 
+      count_seps <- stringr::str_count(rflvars2, stringr::fixed("_"))
407 
+
408 
+      if(any(diff(count_seps) > 0)) {
409 
+          warning("flvars not ordered?",
410 
+                  "Check the conversion of gene names to numbers in birth spec")
411 
+          rflvars2 <- rflvars2[order(count_seps, decreasing = TRUE)]
412 
+      }
413 
+
414 
+      ## Users can pass in many possible orderings. Get all.
415 
+      full_rflvars <- all_orders_fv(rflvars2, prefix, prefixre)
416 
+
417 
+      if (!is.null(frequencyDependentFitness)) {
418 
+        Fitness_as_fvars <- stringr::str_replace_all(genotFitness$Fitness,
419 
+                                                   stringr::fixed(full_rflvars))
420 
+      }
421 
+      else {
422 
+        Birth_as_fvars <- stringr::str_replace_all(genotFitness$Birth,
423 
+                                                   stringr::fixed(full_rflvars))
424 
+      }
425 
+
426 
+    }
427 
+
428 
+    if(frequencyDependentDeath) {
429 
+
430 
+      if(frequencyType == "abs") {
375 431 
         prefix <- "n_"
376 432 
         prefixre <- "^n_"
377 
-    } else {
433 
+      } else {
378 434 
         prefix <- "f_"
379 435 
         prefixre <- "^f_"
380 
-    }
381 
-    flvars <- paste0(prefix, pasted)
382 
-    names(flvars) <- npasted
383 
-
384 
-    ## make sure we get f_1_2 and not f_2_1, etc
385 
-    flvars2 <- flvars
386 
-    names(flvars2) <- paste0(prefix, names(flvars))
387 
-
388 
-    rmwt <- which(flvars2 == prefix)
389 
-    if(length(rmwt)) flvars2 <- flvars2[-rmwt] ## rm this.
390 
-
391 
-    ## Need to rev the vector, to ensure larger patterns come first
392 
-    ## and to place "f_" as last.
393 
-    rflvars2 <- rev(flvars2)
394 
-    count_seps <- stringr::str_count(rflvars2, stringr::fixed("_"))
395 
-
396 
-    if(any(diff(count_seps) > 0)) {
436 
+      }
437 
+
438 
+      flvarsd <- paste0(prefix, pasted)
439 
+      names(flvarsd) <- npasted
440 
+
441 
+      ## make sure we get f_1_2 and not f_2_1, etc
442 
+      flvars2 <- flvarsd
443 
+      names(flvars2) <- paste0(prefix, names(flvarsd))
444 
+
445 
+      rmwt <- which(flvars2 == prefix)
446 
+      if(length(rmwt)) flvars2 <- flvars2[-rmwt] ## rm this.
447 
+
448 
+      ## Need to rev the vector, to ensure larger patterns come first
449 
+      ## and to place "f_" as last.
450 
+      rflvars2 <- rev(flvars2)
451 
+      count_seps <- stringr::str_count(rflvars2, stringr::fixed("_"))
452 
+
453 
+      if(any(diff(count_seps) > 0)) {
397 454 
         warning("flvars not ordered?",
398 
-                "Check the conversion of gene names to numbers in fitness spec")
455 
+                "Check the conversion of gene names to numbers in death spec")
399 456 
         rflvars2 <- rflvars2[order(count_seps, decreasing = TRUE)]
400 
-    }
401 
-
402 
-    ## Users can pass in many possible orderings. Get all.
403 
-    full_rflvars <- all_orders_fv(rflvars2, prefix, prefixre)
404 
-    Fitness_as_fvars <- stringr::str_replace_all(genotFitness$Fitness,
457 
+      }
458 
+
459 
+      ## Users can pass in many possible orderings. Get all.
460 
+      full_rflvars <- all_orders_fv(rflvars2, prefix, prefixre)
461 
+      Death_as_fvars <- stringr::str_replace_all(genotFitness$Death,
405 462 
                                                  stringr::fixed(full_rflvars))
406 
-    return(list(flvars = flvars,
407 
-                Fitness_as_fvars = Fitness_as_fvars))
463 
+
464 
+      if(frequencyDependentBirth) {
465 
+        return(list(flvarsb = flvarsb,
466 
+                    flvarsd = flvarsd,
467 
+                    Birth_as_fvars = Birth_as_fvars,
468 
+                    Death_as_fvars = Death_as_fvars))
469 
+      }
470 
+      else {
471 
+        return(list(flvarsd = flvarsd,
472 
+                    Death_as_fvars = Death_as_fvars))
473 
+      }
474 
+
475 
+    }
476 
+
477 
+    else  {
478 
+      if (!is.null(frequencyDependentFitness)) {
479 
+        return(list(flvarsb = flvarsb,
480 
+                    Fitness_as_fvars = Fitness_as_fvars))
481 
+      } else {
482 
+        return(list(flvarsb = flvarsb,
483 
+                    Birth_as_fvars = Birth_as_fvars))
484 
+      }
485 
+
486 
+    }
487 
+
408 488 
 }
409 489
410 490
... ... 
@@ -470,7 +550,10 @@ allFitnessORMutatorEffects <- function(rT = NULL,
470 550 
                                        genotFitness = NULL,
471 551 
                                        ## refFE = NULL,
472 552 
                                        calledBy = NULL,
473 
-                                       frequencyDependentFitness = FALSE,
553 
+                                       frequencyDependentBirth = FALSE,
554 
+                                       frequencyDependentDeath = FALSE,
555 
+                                       frequencyDependentFitness = NULL,
556 
+                                       deathSpec = FALSE,
474 557 
                                        frequencyType = "freq_dep_not_used"){
475 558 
                                        #spPopSizes = NULL) {
476 559 
   ## From allFitnessEffects. Generalized so we deal with Fitness
... ... 
@@ -506,7 +589,7 @@ allFitnessORMutatorEffects <- function(rT = NULL,
506 589 
            "Is this an attempt to subvert the function?")
507 590 
   }
508 591
509 
-  if(!frequencyDependentFitness) {
592 
+  if(!frequencyDependentBirth && !frequencyDependentDeath) {
510 593 
     rtNames <- NULL
511 594 
     epiNames <- NULL
512 595 
     orNames <- NULL
... ... 
@@ -626,19 +709,50 @@ allFitnessORMutatorEffects <- function(rT = NULL,
626 709 
       ## This makes life simpler in C++:
627 710 
       ## In the map, the key is the genotype name, as
628 711 
       ## cnn <- colnames(genotFitness)[-ncol(genotFitness)]
629 
-      cnn <- 1:(ncol(genotFitness) - 1)
630 
-      gfn <- apply(genotFitness[, -ncol(genotFitness), drop = FALSE], 1,
631 
-                   function(x) paste(cnn[as.logical(x)],
632 
-                                     collapse = ", "))
712 
+      if(deathSpec) {
713 
+        cnn <- 1:(ncol(genotFitness) - 2)
714 
+        gfn <- apply(genotFitness[, -c((ncol(genotFitness)-1):ncol(genotFitness)), drop = FALSE], 1,
715 
+                     function(x) paste(cnn[as.logical(x)],
716 
+                                       collapse = ", "))
717 
+      }
718 
+      else {
719 
+        cnn <- 1:(ncol(genotFitness) - 1)
720 
+        gfn <- apply(genotFitness[, -ncol(genotFitness), drop = FALSE], 1,
721 
+                     function(x) paste(cnn[as.logical(x)],
722 
+                                       collapse = ", "))
723 
+      }
724 
+
633 725 
       ## rownames(genotFitness) <- gfn
634 
-      fitnessLandscape_df <-
635 
-        data.frame(Genotype = gfn,
636 
-                   Fitness = genotFitness[, ncol(genotFitness)],
637 
-                   stringsAsFactors = FALSE)
638 
-      fitnessLandscape_gene_id <- data.frame(
639 
-        Gene = colnames(genotFitness)[-ncol(genotFitness)],
640 
-        GeneNumID = cnn,
641 
-        stringsAsFactors = FALSE)
726 
+      if(deathSpec) {
727 
+        fitnessLandscape_df <-
728 
+          data.frame(Genotype = gfn,
729 
+                     Birth = genotFitness[, ncol(genotFitness)-1],
730 
+                     Death = genotFitness[, ncol(genotFitness)],
731 
+                     stringsAsFactors = FALSE)
732 
+        fitnessLandscape_gene_id <- data.frame(
733 
+          Gene = colnames(genotFitness)[-c((ncol(genotFitness)-1):ncol(genotFitness))],
734 
+          GeneNumID = cnn,
735 
+          stringsAsFactors = FALSE)
736 
+      }
737 
+      else {
738 
+
739 
+        if(!is.null(frequencyDependentFitness)) {
740 
+          fitnessLandscape_df <-
741 
+            data.frame(Genotype = gfn,
742 
+                       Fitness = genotFitness[, ncol(genotFitness)],
743 
+                       stringsAsFactors = FALSE)
744 
+        } else {
745 
+          fitnessLandscape_df <-
746 
+            data.frame(Genotype = gfn,
747 
+                       Birth = genotFitness[, ncol(genotFitness)],
748 
+                       stringsAsFactors = FALSE)
749 
+        }
750 
+
751 
+        fitnessLandscape_gene_id <- data.frame(
752 
+          Gene = colnames(genotFitness)[-ncol(genotFitness)],
753 
+          GeneNumID = cnn,
754 
+          stringsAsFactors = FALSE)
755 
+      }
642 756
643 757 
     }
644 758
... ... 
@@ -678,32 +792,62 @@ allFitnessORMutatorEffects <- function(rT = NULL,
678 792 
     if(!keepInput) {
679 793 
       rT <- epistasis <- orderEffects <- noIntGenes <- NULL
680 794 
     }
681 
-
682 
-    out <- list(long.rt = long.rt,
683 
-                long.epistasis = long.epistasis,
684 
-                long.orderEffects = long.orderEffects,
685 
-                long.geneNoInt = geneNoInt,
686 
-                geneModule = geneModule,
687 
-                gMOneToOne = gMOneToOne,
688 
-                geneToModule = geneToModule,
689 
-                graph = graphE,
690 
-                drv = drv,
691 
-                rT = rT,
692 
-                epistasis = epistasis,
693 
-                orderEffects = orderEffects,
694 
-                noIntGenes = noIntGenes,
695 
-                fitnessLandscape = genotFitness,
696 
-                fitnessLandscape_df = fitnessLandscape_df,
697 
-                fitnessLandscape_gene_id = fitnessLandscape_gene_id,
698 
-                fitnessLandscapeVariables = vector(mode = "character", length = 0L),
699 
-                frequencyDependentFitness = frequencyDependentFitness,
700 
-                frequencyType = frequencyType)
795 
+
796 
+    if(!is.null(frequencyDependentFitness)) {
797 
+      out <- list(long.rt = long.rt,
798 
+                  long.epistasis = long.epistasis,
799 
+                  long.orderEffects = long.orderEffects,
800 
+                  long.geneNoInt = geneNoInt,
801 
+                  geneModule = geneModule,
802 
+                  gMOneToOne = gMOneToOne,
803 
+                  geneToModule = geneToModule,
804 
+                  graph = graphE,
805 
+                  drv = drv,
806 
+                  rT = rT,
807 
+                  epistasis = epistasis,
808 
+                  orderEffects = orderEffects,
809 
+                  noIntGenes = noIntGenes,
810 
+                  fitnessLandscape = genotFitness,
811 
+                  fitnessLandscape_df = fitnessLandscape_df,
812 
+                  fitnessLandscape_gene_id = fitnessLandscape_gene_id,
813 
+                  fitnessLandscapeVariables = vector(mode = "character", length = 0L),
814 
+                  frequencyDependentFitness = frequencyDependentFitness,
815 
+                  frequencyType = frequencyType)
816 
+    } else {
817 
+
818 
+      out <- list(long.rt = long.rt,
819 
+                  long.epistasis = long.epistasis,
820 
+                  long.orderEffects = long.orderEffects,
821 
+                  long.geneNoInt = geneNoInt,
822 
+                  geneModule = geneModule,
823 
+                  gMOneToOne = gMOneToOne,
824 
+                  geneToModule = geneToModule,
825 
+                  graph = graphE,
826 
+                  drv = drv,
827 
+                  rT = rT,
828 
+                  epistasis = epistasis,
829 
+                  orderEffects = orderEffects,
830 
+                  noIntGenes = noIntGenes,
831 
+                  fitnessLandscape = genotFitness,
832 
+                  fitnessLandscape_df = fitnessLandscape_df,
833 
+                  fitnessLandscape_gene_id = fitnessLandscape_gene_id,
834 
+                  fitnessLandscapeVariables = vector(mode = "character", length = 0L),
835 
+                  frequencyDependentBirth = frequencyDependentBirth,
836 
+                  frequencyDependentDeath = frequencyDependentDeath,
837 
+                  frequencyType = frequencyType,
838 
+                  deathSpec = deathSpec)
839 
+    }
701 840 
                 #spPopSizes = vector(mode = "integer", length = 0L)
702 841
703 842 
     if(calledBy == "allFitnessEffects") {
704 
-      class(out) <- c("fitnessEffects")
843 
+      if (!is.null(frequencyDependentFitness)) {
844 
+        class(out) <- c("fitnessEffects")
845 
+      } else {
846 
+        class(out) <- c("fitnessEffects", "fitnessEffects_v3")
847 
+      }
848 
+
705 849 
     } else if(calledBy == "allMutatorEffects") {
706 
-      class(out) <- c("mutatorEffects")
850 
+      class(out) <- c("mutatorEffects", "mutatorEffects_v3")
707 851 
     }
708 852 
   } else { ## Frequency-dependent fitness
709 853
... ... 
@@ -713,39 +857,129 @@ allFitnessORMutatorEffects <- function(rT = NULL,
713 857 
       #fitnessLandscape_gene_id <- data.frame()
714 858 
       stop("You have a null genotFitness in a frequency dependent fitness situation.")
715 859 
     } else {
716 
-      cnn <- 1:(ncol(genotFitness) - 1)
717 
-      gfn <- apply(genotFitness[, -ncol(genotFitness), drop = FALSE], 1,
718 
-                   function(x) paste(cnn[as.logical(x)],
719 
-                                     collapse = ", "))
720 
-      ## rownames(genotFitness) <- gfn
721 
-      fitnessLandscape_df <-
722 
-        data.frame(Genotype = gfn,
723 
-                   Fitness = genotFitness[, ncol(genotFitness)],
724 
-                   stringsAsFactors = FALSE)
860 
+      if(deathSpec) {
861 
+        cnn <- 1:(ncol(genotFitness) - 2)
862 
+        gfn <- apply(genotFitness[, -c((ncol(genotFitness)-1):ncol(genotFitness)), drop = FALSE], 1,
863 
+                     function(x) paste(cnn[as.logical(x)],
864 
+                                       collapse = ", "))
865 
+
866 
+        fitnessLandscape_df <-
867 
+          data.frame(Genotype = gfn,
868 
+                     Birth = genotFitness[, ncol(genotFitness)-1],
869 
+                     Death = genotFitness[, ncol(genotFitness)],
870 
+                     stringsAsFactors = FALSE)
871 
+        fitnessLandscape_gene_id <- data.frame(
872 
+          Gene = colnames(genotFitness)[-c((ncol(genotFitness)-1):ncol(genotFitness))],
873 
+          GeneNumID = cnn,
874 
+          stringsAsFactors = FALSE)
875 
+      }
876 
+      else {
877 
+        cnn <- 1:(ncol(genotFitness) - 1)
878 
+        gfn <- apply(genotFitness[, -ncol(genotFitness), drop = FALSE], 1,
879 
+                     function(x) paste(cnn[as.logical(x)],
880 
+                                       collapse = ", "))
881 
+
882 
+        if (!is.null(frequencyDependentFitness)) {
883 
+          fitnessLandscape_df <-
884 
+            data.frame(Genotype = gfn,
885 
+                       Fitness = genotFitness[, ncol(genotFitness)],
886 
+                       stringsAsFactors = FALSE)
887 
+        } else {
888 
+          fitnessLandscape_df <-
889 
+            data.frame(Genotype = gfn,
890 
+                       Birth = genotFitness[, ncol(genotFitness)],
891 
+                       stringsAsFactors = FALSE)
892 
+        }
893 
+
894 
+
895 
+        fitnessLandscape_gene_id <- data.frame(
896 
+          Gene = colnames(genotFitness)[-ncol(genotFitness)],
897 
+          GeneNumID = cnn,
898 
+          stringsAsFactors = FALSE)
899 
+      }
725 900
726 901 
       attr(fitnessLandscape_df,'row.names') <-
727 902 
         as.integer(attr(fitnessLandscape_df,'row.names'))
728 903
729 
-      fitnessLandscape_gene_id <- data.frame(
730 
-        Gene = colnames(genotFitness)[-ncol(genotFitness)],
731 
-        GeneNumID = cnn,
732 
-        stringsAsFactors = FALSE)
733 
-
734 904 
       if(frequencyType == "auto"){
735 
-        ch <- paste(as.character(fitnessLandscape_df[, ncol(fitnessLandscape_df)]), collapse = "")
736 
-        #print(ch)
737 
-        if( grepl("f_", ch, fixed = TRUE) ){
738 
-          frequencyType = "rel"
739 
-        } else{
740 
-          frequencyType = "abs"
905 
+
906 
+        if(frequencyDependentBirth && frequencyDependentDeath) {
907 
+
908 
+          # We have to make sure both are the same frequencyType
909 
+          ch <- paste(as.character(fitnessLandscape_df$Birth), collapse = "")
910 
+          ch2 <- paste(as.character(fitnessLandscape_df$Death), collapse = "")
911 
+
912 
+          if( grepl("f_", ch, fixed = TRUE) && grepl("f_", ch2, fixed = TRUE)){
913 
+            frequencyType = "rel"
914 
+          } else if (grepl("n_", ch, fixed = TRUE) && grepl("n_", ch2, fixed = TRUE)){
915 
+            frequencyType = "abs"
916 
+          } else {
917 
+            stop("Inconsistent frequencyType between Birth and Death.
918 
+                 Both must be of same frequencyType.")
919 
+          }
920 
+        }
921 
+
922 
+
923 
+        else if(frequencyDependentDeath)  {
924 
+          ch <- paste(as.character(fitnessLandscape_df$Death), collapse = "")
925 
+          if( grepl("f_", ch, fixed = TRUE)){
926 
+            frequencyType = "rel"
927 
+          } else{
928 
+            frequencyType = "abs"
929 
+          }
930 
+        }
931 
+
932 
+        else if(frequencyDependentBirth) {
933 
+          if (!is.null(frequencyDependentFitness)) {
934 
+            ch <- paste(as.character(fitnessLandscape_df$Fitness), collapse = "")
935 
+          } else {
936 
+            ch <- paste(as.character(fitnessLandscape_df$Birth), collapse = "")
937 
+          }
938 
+
939 
+          if( grepl("f_", ch, fixed = TRUE)){
940 
+            frequencyType = "rel"
941 
+          } else{
942 
+            frequencyType = "abs"
943 
+          }
741 944 
         }
742 
-      } else { frequencyType = frequencyType }
945 
+
946 
+      } else { frequencyType = frequencyType}
947 
+
743 948 
       ## Wrong: assumes all genotypes in fitness landscape
744 949 
       ## fitnessLandscapeVariables = fVariablesN(ncol(genotFitness) - 1, frequencyType)
745 
-      stopifnot(identical(genotFitness$Fitness, fitnessLandscape_df$Fitness))
746 
-      flvars_and_fitvars <- create_flvars_fitvars(genotFitness, frequencyType)
747 
-      fitnessLandscapeVariables <- flvars_and_fitvars$flvars
748 
-      Fitness_as_fvars <- flvars_and_fitvars$Fitness_as_fvars
950 
+      if(!is.null(frequencyDependentFitness)) {
951 
+        stopifnot(identical(genotFitness$Fitness, fitnessLandscape_df$Fitness))
952 
+      } else {
953 
+        stopifnot(identical(genotFitness$Birth, fitnessLandscape_df$Birth))
954 
+      }
955 
+
956 
+      if(deathSpec) {
957 
+        stopifnot(identical(genotFitness$Death, fitnessLandscape_df$Death))
958 
+      }
959 
+      flvars_and_fitvars <- create_flvars_fitvars(genotFitness,
960 
+                                                  frequencyType,
961 
+                                                  frequencyDependentBirth,
962 
+                                                  frequencyDependentDeath,
963 
+                                                  frequencyDependentFitness,
964 
+                                                  deathSpec)
965 
+
966 
+      if(frequencyDependentBirth) {
967 
+
968 
+        if (!is.null(frequencyDependentFitness)) {
969 
+          fitnessLandscapeVariables <- flvars_and_fitvars$flvarsb
970 
+          Fitness_as_fvars <- flvars_and_fitvars$Fitness_as_fvars
971 
+        } else {
972 
+          birthLandscapeVariables <- flvars_and_fitvars$flvarsb
973 
+          Birth_as_fvars <- flvars_and_fitvars$Birth_as_fvars
974 
+        }
975 
+
976 
+      }
977 
+
978 
+
979 
+      if(frequencyDependentDeath) {
980 
+        deathLandscapeVariables <- flvars_and_fitvars$flvarsd
981 
+        Death_as_fvars <- flvars_and_fitvars$Death_as_fvars
982 
+      }
749 983 
     }
750 984
751 985 
     if(!is.null(drvNames)) {
... ... 
@@ -763,17 +997,86 @@ allFitnessORMutatorEffects <- function(rT = NULL,
763 997 
       ## This is what C++ should consume
764 998
765 999 
       ## This ought to allow to pass fitness spec as letters. Preserve original
766 
-      Fitness_original_as_letters <- fitnessLandscape_df$Fitness
767 
-      fitnessLandscape_df$Fitness <- Fitness_as_fvars
768 
-
1000 
+    if(frequencyDependentBirth) {
1001 
+
1002 
+      if (!is.null(frequencyDependentFitness)) {
1003 
+        Fitness_original_as_letters <- fitnessLandscape_df$Fitness
1004 
+        fitnessLandscape_df$Fitness <- Fitness_as_fvars
1005 
+      } else {
1006 
+        Birth_original_as_letters <- fitnessLandscape_df$Birth
1007 
+        fitnessLandscape_df$Birth <- Birth_as_fvars
1008 
+      }
1009 
+    }
1010 
+
1011 
+    if(frequencyDependentDeath) {
1012 
+      Death_original_as_letters <- fitnessLandscape_df$Death
1013 
+      fitnessLandscape_df$Death <- Death_as_fvars
1014 
+    }
1015 
+    if(frequencyDependentDeath && frequencyDependentBirth) {
769 1016 
       full_FDF_spec <-
770 
-          cbind(genotFitness[, -ncol(genotFitness)]
1017 
+        cbind(genotFitness[, -c((ncol(genotFitness)-1):ncol(genotFitness))]
771 1018 
               , Genotype_as_numbers = fitnessLandscape_df$Genotype
772 
-              , Genotype_as_letters = genotype_letterslabel(genotFitness[, -ncol(genotFitness)])
773 
-              , Genotype_as_fvars = fitnessLandscapeVariables ## used in C++
774 
-              , Fitness_as_fvars = Fitness_as_fvars
775 
-              , Fitness_as_letters = Fitness_original_as_letters
1019 
+              , Genotype_as_letters = genotype_letterslabel(genotFitness[,-c((ncol(genotFitness)-1):ncol(genotFitness))])
1020 
+              , Genotype_as_fvarsb = birthLandscapeVariables ## used in C++
1021 
+              , Genotype_as_fvarsd = deathLandscapeVariables
1022 
+              , Birth_as_fvars = Birth_as_fvars
1023 
+              , Birth_as_letters = Birth_original_as_letters
1024 
+              , Death_as_fvars = Death_as_fvars
1025 
+              , Death_as_letters = Death_original_as_letters
1026 
+        )
1027 
+
1028 
+      }
1029 
+
1030 
+      else {
1031 
+
1032 
+        if(frequencyDependentDeath) {
1033 
+          full_FDF_spec <-
1034 
+            cbind(genotFitness[, -c((ncol(genotFitness)-1):ncol(genotFitness))]
1035 
+                  , Genotype_as_numbers = fitnessLandscape_df$Genotype
1036 
+                  , Genotype_as_letters = genotype_letterslabel(genotFitness[, -c((ncol(genotFitness)-1):ncol(genotFitness))])
1037 
+                  , Genotype_as_fvarsd = deathLandscapeVariables ## used in C++
1038 
+                  , Death_as_fvars = Death_as_fvars
1039 
+                  , Death_as_letters = Death_original_as_letters
1040 
+            )
1041 
+        } else {
1042 
+          if(deathSpec) {
1043 
+            full_FDF_spec <-
1044 
+              cbind(genotFitness[, -c((ncol(genotFitness)-1):ncol(genotFitness))]
1045 
+                    , Genotype_as_numbers = fitnessLandscape_df$Genotype
1046 
+                    , Genotype_as_letters = genotype_letterslabel(genotFitness[,-c((ncol(genotFitness)-1):ncol(genotFitness))])
1047 
+                    , Genotype_as_fvarsb = birthLandscapeVariables ## used in C++
1048 
+                    , Birth_as_fvars = Birth_as_fvars
1049 
+                    , Birth_as_letters = Birth_original_as_letters
1050 
+              )
1051 
+          }
1052 
+
1053 
+          else {
1054 
+
1055 
+            if (!is.null(frequencyDependentFitness)) {
1056 
+              full_FDF_spec <-
1057 
+                cbind(genotFitness[, -ncol(genotFitness)]
1058 
+                      , Genotype_as_numbers = fitnessLandscape_df$Genotype
1059 
+                      , Genotype_as_letters = genotype_letterslabel(genotFitness[, -ncol(genotFitness)])
1060 
+                      , Genotype_as_fvarsb = fitnessLandscapeVariables ## used in C++
1061 
+                      , Fitness_as_fvars = Fitness_as_fvars
1062 
+                      , Fitness_as_letters = Fitness_original_as_letters
1063 
+                )
1064 
+            } else {
1065 
+              full_FDF_spec <-
1066 
+                cbind(genotFitness[, -ncol(genotFitness)]
1067 
+                      , Genotype_as_numbers = fitnessLandscape_df$Genotype
1068 
+                      , Genotype_as_letters = genotype_letterslabel(genotFitness[, -ncol(genotFitness)])
1069 
+                      , Genotype_as_fvarsb = birthLandscapeVariables ## used in C++
1070 
+                      , Birth_as_fvars = Birth_as_fvars
1071 
+                      , Birth_as_letters = Birth_original_as_letters
776 1072 
                 )
1073 
+            }
1074 
+
1075 
+          }
1076 
+        }
1077 
+      }
1078 
+
1079 
+
777 1080 
       rownames(full_FDF_spec) <- 1:nrow(full_FDF_spec)
778 1081
779 1082 
       ## fitnessLanscape and fitnessLandscape_df are now redundant given
... ... 
@@ -781,44 +1084,124 @@ allFitnessORMutatorEffects <- function(rT = NULL,
781 1084 
       ## single canonical object used.
782 1085
783 1086 
       rm(fitnessLandscape_df)
784 
-      suppressWarnings(try(rm(fitnessLandscape), silent = TRUE))
785 
-      rm(fitnessLandscapeVariables)
786 
-      rm(Fitness_as_fvars)
787 
-      rm(Fitness_original_as_letters)
788 
-
789 
-      fitnessLandscape <- full_FDF_spec[, c(fitnessLandscape_gene_id$Gene,
790 
-                                            "Fitness_as_fvars")]
791 
-      colnames(fitnessLandscape)[ncol(fitnessLandscape)] <- "Fitness"
1087 
+      if(frequencyDependentBirth) {
1088 
+
1089 
+        if (!is.null(frequencyDependentFitness)) {
1090 
+          rm(fitnessLandscapeVariables)
1091 
+          rm(Fitness_as_fvars)
1092 
+          rm(Fitness_original_as_letters)
1093 
+        } else {
1094 
+          rm(birthLandscapeVariables)
1095 
+          rm(Birth_as_fvars)
1096 
+          rm(Birth_original_as_letters)
1097 
+        }
1098 
+
1099 
+      }
792 1100
793 
-      fitnessLandscape_df <- full_FDF_spec[, c("Genotype_as_numbers",
794 
-                                               "Fitness_as_fvars")]
795 
-      colnames(fitnessLandscape_df) <- c("Genotype", "Fitness")
1101 
+      if (frequencyDependentDeath) {
1102 
+
1103 
+        rm(deathLandscapeVariables)
1104 
+        rm(Death_as_fvars)
1105 
+        rm(Death_original_as_letters)
1106 
+
1107 
+        if (frequencyDependentBirth) {
1108 
+
1109 
+          fitnessLandscape_df <- full_FDF_spec[, c("Genotype_as_numbers",
1110 
+                                                   "Birth_as_fvars",
1111 
+                                                   "Death_as_fvars")]
1112 
+        } else {
1113 
+
1114 
+          fitnessLandscape_df <- cbind(full_FDF_spec["Genotype_as_numbers"],
1115 
+                                                   genotFitness["Birth"],
1116 
+                                       full_FDF_spec["Death_as_fvars"])
1117 
+        }
1118 
+
1119 
+        colnames(fitnessLandscape_df) <- c("Genotype", "Birth", "Death")
1120 
+
1121 
+      } else {
1122 
+
1123 
+        if(deathSpec) {
1124 
+
1125 
+          fitnessLandscape_df <- cbind(full_FDF_spec[, c("Genotype_as_numbers",
1126 
+                                                         "Birth_as_fvars")],
1127 
+                                       genotFitness[, "Death"])
1128 
+
1129 
+          colnames(fitnessLandscape_df) <- c("Genotype", "Birth", "Death")
1130 
+
1131 
+        } else {
1132 
+
1133 
+          if (!is.null(frequencyDependentFitness)) {
1134 
+            fitnessLandscape_df <- full_FDF_spec[, c("Genotype_as_numbers",
1135 
+                                                     "Fitness_as_fvars")]
1136 
+
1137 
+            colnames(fitnessLandscape_df) <- c("Genotype", "Fitness")
1138 
+          } else {
1139 
+            fitnessLandscape_df <- full_FDF_spec[, c("Genotype_as_numbers",
1140 
+                                                     "Birth_as_fvars")]
1141 
+
1142 
+            colnames(fitnessLandscape_df) <- c("Genotype", "Birth")
1143 
+          }
1144 
+
1145 
+        }
1146 
+      }
796 1147
797 1148
798 
-      out <- list(long.rt = list(),
799 
-                long.epistasis = list(),
800 
-                long.orderEffects = list(),
801 
-                long.geneNoInt = data.frame(),
802 
-                geneModule = defaultGeneModuleDF, ##Trick to pass countGenesFe>2,
803 
-                gMOneToOne = TRUE,
804 
-                geneToModule = c(Root = "Root"),
805 
-                graph = list(),
806 
-                drv = drv,
807 
-                rT = NULL,
808 
-                epistasis = NULL,
809 
-                orderEffects = NULL,
810 
-                noIntGenes = NULL,
811 
-                fitnessLandscape = genotFitness, ## redundant
812 
-                fitnessLandscape_df = fitnessLandscape_df, ## redundant
813 
-                fitnessLandscape_gene_id = fitnessLandscape_gene_id,
814 
-                ## fitnessLandscapeVariables = NULL, ## now part of full_FDF_spec
815 
-                frequencyDependentFitness = frequencyDependentFitness,
816 
-                frequencyType = frequencyType,
817 
-                full_FDF_spec = full_FDF_spec
818 
-                #spPopSizes = spPopSizes
819 
-              )
1149 
+      if(!is.null(frequencyDependentFitness)) {
1150 
+        out <- list(long.rt = list(),
1151 
+                    long.epistasis = list(),
1152 
+                    long.orderEffects = list(),
1153 
+                    long.geneNoInt = data.frame(),
1154 
+                    geneModule = defaultGeneModuleDF, ##Trick to pass countGenesFe>2,
1155 
+                    gMOneToOne = TRUE,
1156 
+                    geneToModule = c(Root = "Root"),
1157 
+                    graph = list(),
1158 
+                    drv = drv,
1159 
+                    rT = NULL,
1160 
+                    epistasis = NULL,
1161 
+                    orderEffects = NULL,
1162 
+                    noIntGenes = NULL,
1163 
+                    fitnessLandscape = genotFitness, ## redundant
1164 
+                    fitnessLandscape_df = fitnessLandscape_df, ## redundant
1165 
+                    fitnessLandscape_gene_id = fitnessLandscape_gene_id,
1166 
+                    ## fitnessLandscapeVariables = NULL, ## now part of full_FDF_spec
1167 
+                    frequencyDependentFitness = frequencyDependentFitness,
1168 
+                    frequencyType = frequencyType,
1169 
+                    full_FDF_spec = full_FDF_spec
1170 
+                    #spPopSizes = spPopSizes
1171 
+        )
1172 
+      } else {
1173 
+        out <- list(long.rt = list(),
1174 
+                    long.epistasis = list(),
1175 
+                    long.orderEffects = list(),
1176 
+                    long.geneNoInt = data.frame(),
1177 
+                    geneModule = defaultGeneModuleDF, ##Trick to pass countGenesFe>2,
1178 
+                    gMOneToOne = TRUE,
1179 
+                    geneToModule = c(Root = "Root"),
1180 
+                    graph = list(),
1181 
+                    drv = drv,
1182 
+                    rT = NULL,
1183 
+                    epistasis = NULL,
1184 
+                    orderEffects = NULL,
1185 
+                    noIntGenes = NULL,
1186 
+                    fitnessLandscape = genotFitness, ## redundant
1187 
+                    fitnessLandscape_df = fitnessLandscape_df, ## redundant
1188 
+                    fitnessLandscape_gene_id = fitnessLandscape_gene_id,
1189 
+                    ## fitnessLandscapeVariables = NULL, ## now part of full_FDF_spec
1190 
+                    frequencyDependentBirth = frequencyDependentBirth,
1191 
+                    frequencyDependentDeath = frequencyDependentDeath,
1192 
+                    frequencyType = frequencyType,
1193 
+                    deathSpec = deathSpec,
1194 
+                    full_FDF_spec = full_FDF_spec
1195 
+                    #spPopSizes = spPopSizes
1196 
+        )
1197 
+      }
1198 
+
1199 
+    if (!is.null(frequencyDependentFitness)) {
1200 
+      class(out) <- c("fitnessEffects")
1201 
+    } else {
1202 
+      class(out) <- c("fitnessEffects", "fitnessEffects_v3")
1203 
+    }
820 1204
821 
-    class(out) <- c("fitnessEffects")
822 1205 
   }
823 1206 
   return(out)
824 1207 
 }
... ... 
@@ -831,65 +1214,98 @@ allFitnessEffects <- function(rT = NULL,
831 1214 
                               drvNames = NULL,
832 1215 
                               genotFitness = NULL,
833 1216 
                               keepInput = TRUE,
834 
-                              frequencyDependentFitness = FALSE,
835 
-                              frequencyType = NA) {
1217 
+                              frequencyDependentBirth = FALSE,
1218 
+                              frequencyDependentDeath = FALSE,
1219 
+                              frequencyDependentFitness = NULL,
1220 
+                              frequencyType = NA,
1221 
+                              deathSpec = FALSE) {
836 1222 
                               #spPopSizes = NULL) {
837 
-
838 
-    if(!frequencyDependentFitness) {
839 
-
840 
-        if(!is.na(frequencyType)){
841 
-            warning("frequencyType set to NA")
842 
-        }
843 
-        ## this is a kludge, but we must pass something not NA and not NULL
844 
-        ## to the C++ code
845 
-        frequencyType = "freq_dep_not_used"
846 
-
847 
-    if(!is.null(genotFitness)) {
848 
-      if(!is.null(rT) || !is.null(epistasis) ||
849 
-         !is.null(orderEffects) || !is.null(noIntGenes) ||
850 
-         !is.null(geneToModule)) {
851 
-        stop("You have a non-null genotFitness.",
852 
-             " If you pass the complete genotype to fitness mapping",
853 
-             " you cannot pass any of rT, epistasis, orderEffects",
854 
-             " noIntGenes or geneToModule.")
1223 
+
1224 
+    # Version compatibility
1225 
+    if (!is.null(frequencyDependentFitness)) {
1226 
+      if (frequencyDependentBirth || frequencyDependentDeath || deathSpec) {
1227 
+        stop("You are mixing v2 functionality with v3 functionality.")
855 1228 
       }
856 
-
857 
-      genotFitness_std <- to_genotFitness_std(genotFitness,
858 
-                                              frequencyDependentFitness = FALSE,
859 
-                                              frequencyType = frequencyType,
860 
-                                              simplify = TRUE)
861 
-      ## epistasis <- from_genotype_fitness(genotFitness)
1229 
+      else {
1230 
+        frequencyDependentBirth = frequencyDependentFitness;
1231 
+        warning("v2 functionality detected. Adapting to v3 functionality.")
1232 
+      }
1233 
+    }
1234 
+
1235 
+    if(frequencyDependentDeath && !deathSpec) {
1236 
+      deathSpec = TRUE
1237 
+      warning("Assuming death is being specified. Setting deathSpec to TRUE.")
1238 
+    }
1239 
+
1240 
+    if(!frequencyDependentBirth && !frequencyDependentDeath) {
1241 
+      if(!is.na(frequencyType)){
1242 
+        warning("frequencyType set to NA")
1243 
+      }
1244 
+      ## this is a kludge, but we must pass something not NA and not NULL
1245 
+      ## to the C++ code
1246 
+      frequencyType <- "freq_dep_not_used"
1247 
+    }
1248 
+
1249 
+
1250 
+    if(!frequencyDependentBirth && !frequencyDependentDeath) {
1251 
+
1252 
+        if(!is.null(genotFitness)) {
1253 
+          if(!is.null(rT) || !is.null(epistasis) ||
1254 
+             !is.null(orderEffects) || !is.null(noIntGenes) ||
1255 
+             !is.null(geneToModule)) {
1256 
+            stop("You have a non-null genotFitness.",
1257 
+                 " If you pass the complete genotype to fitness mapping",
1258 
+                 " you cannot pass any of rT, epistasis, orderEffects",
1259 
+                 " noIntGenes or geneToModule.")
1260 
+          }
1261 
+
1262 
+          genotFitness_std <- to_genotFitness_std(genotFitness,
1263 
+                                                        frequencyDependentBirth = FALSE,
1264 
+                                                        frequencyDependentDeath = FALSE,
1265 
+                                                        frequencyDependentFitness = frequencyDependentFitness,
1266 
+                                                        frequencyType = frequencyType,
1267 
+                                                        deathSpec = deathSpec,
1268 
+                                                        simplify = TRUE)
1269 
+
1270 
+        } else {
1271 
+          genotFitness_std <- NULL
1272 
+        }
1273 
+
1274 
+        allFitnessORMutatorEffects(
1275 
+          rT = rT,
1276 
+          epistasis = epistasis,
1277 
+          orderEffects = orderEffects,
1278 
+          noIntGenes = noIntGenes,
1279 
+          geneToModule = geneToModule,
1280 
+          drvNames = drvNames,
1281 
+          keepInput = keepInput,
1282 
+          genotFitness = genotFitness_std,
1283 
+          calledBy = "allFitnessEffects",
1284 
+          frequencyDependentBirth = FALSE,
1285 
+          frequencyDependentDeath = FALSE,
1286 
+          frequencyDependentFitness = frequencyDependentFitness,
1287 
+          frequencyType = frequencyType,
1288 
+          deathSpec = deathSpec)
1289 
+        #spPopSizes = spPopSizes)
1290 
+
862 1291 
     } else {
863 
-      genotFitness_std <- NULL
864 
-    }
865 
-    allFitnessORMutatorEffects(
866 
-      rT = rT,
867 
-      epistasis = epistasis,
868 
-      orderEffects = orderEffects,
869 
-      noIntGenes = noIntGenes,
870 
-      geneToModule = geneToModule,
871 
-      drvNames = drvNames,
872 
-      keepInput = keepInput,
873 
-      genotFitness = genotFitness_std,
874 
-      calledBy = "allFitnessEffects",
875 
-      frequencyDependentFitness = FALSE,
876 
-      frequencyType = frequencyType)
877 
-      #spPopSizes = spPopSizes)
878 
-
879 
-  } else {
880 
-
881 
-    if(!(frequencyType %in% c('abs', 'rel', 'auto'))){
1292 
+
1293 
+    if((frequencyDependentBirth || frequencyDependentDeath) &&
1294 
+       !(frequencyType %in% c('abs', 'rel', 'auto'))){
882 1295 
       #set frequencyType = "auto" in case you did not specify 'rel' or 'abs'
883 1296 
       frequencyType = "auto"
884 1297 
       message("frequencyType set to 'auto'")
885 1298 
     }
886 
-
1299 
+
887 1300 
     if(is.null(genotFitness)) {
888 1301 
       stop("You have a null genotFitness in a frequency dependent fitness situation.")
889 1302 
     } else {
890 1303 
       genotFitness_std <- to_genotFitness_std(genotFitness,
891 
-                                              frequencyDependentFitness = TRUE,
1304 
+                                              frequencyDependentBirth= frequencyDependentBirth,
1305 
+                                              frequencyDependentDeath= frequencyDependentDeath,
1306 
+                                              frequencyDependentFitness = frequencyDependentFitness,
892 1307 
                                               frequencyType = frequencyType,
1308 
+                                              deathSpec = deathSpec,
893 1309 
                                               simplify = TRUE)
894 1310 
       allFitnessORMutatorEffects(
895 1311 
         rT = rT,
... ... 
@@ -901,9 +1317,12 @@ allFitnessEffects <- function(rT = NULL,
901 1317 
         keepInput = keepInput,
902 1318 
         genotFitness = genotFitness_std,
903 1319 
         calledBy = "allFitnessEffects",
904 
-        frequencyDependentFitness = TRUE,
905 
-        frequencyType = frequencyType)
906 
-        #spPopSizes = spPopSizes)
1320 
+        frequencyDependentBirth = frequencyDependentBirth,
1321 
+        frequencyDependentDeath = frequencyDependentDeath,
1322 
+        frequencyDependentFitness = frequencyDependentFitness,
1323 
+        frequencyType = frequencyType,
1324 
+        deathSpec = deathSpec)