Website update

Split vignettes to keep Rcpp/R wrappers separate.

DESCRIPTION

@@ -26,9 +26,9 @@ Imports:
     cli,
     crayon,
     RColorBrewer,
-    tibble
+    tibble,
+    knitr
 RoxygenNote: 7.2.3
 Suggests: 
-    knitr,
     rmarkdown
 VignetteBuilder: knitr

R/add_timed_transition.R

@@ -42,7 +42,7 @@ add_genotype_evolution = function(x,
       ancestor = ifelse(
         genotype == genotype_to,
         genotype_from,
-        genotype_to
+        ancestor
       ),
       time = ifelse(
         genotype == genotype_to,
@@ -51,6 +51,24 @@ add_genotype_evolution = function(x,
       )
     )
 
+  df = x$species %>% 
+    select(ancestor, genotype, time) %>% 
+    distinct %>% 
+    rename(from = ancestor, to = genotype)
+
+  which_roots = df %>% dplyr::filter(is.na(from)) %>% pull(to)
+
+  df = rbind(df,
+                 data.frame(
+                   from = 'GL',
+                   to = which_roots,
+                   time = 0,
+                   stringsAsFactors = FALSE
+                 )) %>% 
+    dplyr::filter(!is.na(from))
+
+  x$clone_tree = tidygraph::as_tbl_graph(df)
+
   x$has_species = TRUE
 
   cli::cli_alert_info(

R/plot_simulation_statistics.R

@@ -17,37 +17,27 @@ plot_firings = function(x)
   # counts = x$get_simulated_counts()
   # info = x$get_info()
 
-  # Until the getters are fake
-  firings = tibble::tibble(
-    event = c("growth", "death", "switch+-", "switch-+", "growth", "death", "switch+-", "switch-+"),
-    species = c("A", "A", "A", "A", "C", "C", "C", "C"),
-    epistate = c("+", "+", "+", "-", "+", "+", "+", "-"),
-    n = c(1000, 400, 3224, 334, 4223,2322, 2243,4224)
-  )
+  firings = x$simulation$get_firings() %>% dplyr::mutate(species = paste0(genotype, epistate))
 
-  info = tibble::tibble(
-    field = c("name", "tissue", "tissue_size"),
-    value = c("My Simulation", "Liver", "100x100")
-  )
-
-  sim_title = info %>% filter(field == 'name') %>% pull(value)
-  tissue_title = info %>% filter(field == 'tissue') %>% pull(value)
-  tissue_size = info %>% filter(field == 'tissue_size') %>% pull(value)
+  sim_title = x$name
+  tissue_title = x$simulation$get_tissue_name()
+  tissue_size = paste(x$simulation$get_tissue_size(), collapse = ' x ')
 
   ggplot2::ggplot(firings) +
     ggplot2::geom_bar(stat = 'identity', 
-                      ggplot2::aes(x = "", y = n, fill = event, alpha = epistate)) +
-    ggplot2::facet_wrap(~species) +
+                      ggplot2::aes(x = "", y = fired, fill = event)) +
+    ggplot2::facet_grid(genotype~epistate) +
     ggplot2::coord_polar(theta = "y") +
     ggplot2::labs(
       fill = "Event", 
-      alpha = 'Epigenetic', 
+      x = "",
+      y = "",
       title = paste0(sim_title, ' (t = 44)'),
       subtitle = paste(tissue_title, 'of size', tissue_size),
-      caption = paste("Total number of events", firings$n %>% sum())
+      caption = paste("Total number of events", firings$fired %>% sum())
     ) +
     # ggplot2::theme_void(base_size = 10) +
+    my_theme() +
     ggplot2::scale_fill_brewer(palette = 'Dark2') +
-    ggplot2::scale_alpha_manual(values = c(`+` = 1, `-` = .5))  +
     ggplot2::theme(legend.position = 'bottom')
 }

R/plot_state.R

@@ -26,7 +26,7 @@ plot_state = function(x)
       alpha = 'Epistate', 
       title = paste0(sim_title, ' (t = ', time, ')'),
       subtitle = paste("Tissue:", tissue_title, '[', tissue_size, ']'),
-      caption = paste("Total number of cells", counts$n %>% sum())
+      caption = paste("Total number of cells", counts$counts %>% sum())
     ) +
     ggplot2::theme_void(base_size = 10) +
     ggplot2::scale_fill_manual(values = get_species_colors(counts$genotype %>% unique)) +

R/print_S3.R

@@ -6,71 +6,182 @@
 #' @exportS3Method print.rraces
 print.rraces <- function(x, ...) {
 
-
-  # cli::cli_rule(
-  #   left = paste(crayon::bold("rRACES:"), x$name),
-  #   righ = paste0(
-  #     "▣ ",  x$simulation$get_tissue_name(), 
-  #       " [", paste(x$simulation$get_tissue_size(), collapse = 'x'), "]",
-  #     "\t⏱ ", x$simulation$get_clock())
-  # )
+  SIM_status = (x$has_species & x$has_initial_cell)
+  SAM_status = FALSE
+  MUT_status = FALSE
+
+  SIM_status = ifelse(
+    SIM_status,
+    crayon::bgGreen(crayon::white(' D ')),
+    crayon::bgRed(crayon::white(' D '))
+  )  
+
+  SAM_status = ifelse(
+    SAM_status,
+    crayon::bgGreen(crayon::white(' S ')),
+    crayon::bgRed(crayon::white(' S '))
+  )  
+
+  MUT_status = ifelse(
+    MUT_status,
+    crayon::bgGreen(crayon::white(' M ')),
+    crayon::bgRed(crayon::white(' M '))
+  )  
+
+  cli::cli_rule(
+    left = paste(
+      crayon::bgYellow(" rRACES "), 
+      SIM_status, SAM_status, MUT_status,
+      x$name
+      ),
+    righ = paste0(
+      crayon::red("▣ "),
+      x$simulation$get_tissue_name(),
+      " [",
+      paste(x$simulation$get_tissue_size(), collapse = 'x'),
+      "]",
+      crayon::red("\t⏱ "),
+      x$simulation$get_clock()
+    )
+  )
   # cat('\n')
-  # 
-  # # Tissue
-  # # 
-  # # x$simulation$get_clock()
-  # 
-  # # cli::cli_alert_warning("TODO -- print the tissue with get_info")
-  # 
-  # # Species
-  # sp_name = x$species$species %>% unique()
-  # if(!x$has_species)
-  #   cli::cli_alert_danger("The simulation has no species yet!")
+
+  # Species
+  sp_name = x$species$species %>% unique()
+
+  if (!x$has_species)
+  {
+    cat('\n')
+    cli::cli_alert_danger("The simulation has no species yet!")
+  }
+  else
+  {
+    # Pretty print
+    # max_pad = 1 + (nchar(x$species$genotype) %>% max)
+    # max_pad = ifelse(max_pad <=2, 3, max_pad)
+    # max_pad = paste0('%', max_pad, 's')
+    #
+    # for(s in sp_name)
+    # {
+    #   cnt = x$simulation$get_counts() %>% filter(genotype == s)
+    #
+    #   sname = paste('', s, '')
+    #   sname = sprintf(max_pad, s)
+    #   sname = crayon::bgYellow(crayon::black( sname ))
+    #
+    #   ancestor = AncestorOf(x, s)
+    #   ancestor = ifelse(is.na(ancestor), 'wt', ancestor)
+    #   ancestor = sprintf(max_pad, ancestor)
+    #   ancestor = crayon::bgBlue(crayon::white( ancestor ))
+    #   ancestor = paste0('\u21AA ', ancestor)
+    #
+    #   grate = paste0(
+    #     '  \u03BB =', sprintf("%6s", GRateOf(x, s, '+')), ' (+) ', sprintf("%6s", GRateOf(x, s, '-')), ' (-)'
+    #   )
+    #
+    #   drate = paste0(
+    #     '  \u03B4 =', sprintf("%6s", DRateOf(x, s, '+')), ' (+) ', sprintf("%6s", DRateOf(x, s, '-')), ' (-)'
+    #   )
+    #
+    #   erate = paste0(
+    #     '  \u03B5 =', sprintf("%6s", ERateOf(x, s, '+')), ' (+) ', sprintf("%6s", ERateOf(x, s, '-')), ' (-)'
+    #   )
+    #
+    #   cat('\n\t\u2022', sname, ancestor, "|", grate, "|", drate, "|", erate)
+    # }
+    #
+    # library(knitr)
+    #
+
+    # Call the function with your tibble 'x$species'
+    counts_tab = x$simulation$get_counts()
+
+    my_tab = x$species %>% 
+      left_join(counts_tab, by = c('genotype', 'epistate')) %>% 
+      select(species, ancestor, time, rgrowth, rdeath, repigenetic, counts)
+    colnames(my_tab)[4:6] = c(" \u03BB ", " \u03B4 ", " \u03B5 ")
+
+    cat("   ",
+        knitr::kable(my_tab, format = "rst", align = "rcrccc"),
+        sep = "\n   ")
+  }
+
+  if(x$has_initial_cell)
+  {
+    cat(
+      "\n  Initial cell:",
+      crayon::blue(x$initial_cell[1]),
+      '→',
+      paste0(
+        '(',
+        crayon::blue(x$initial_cell[2]),
+        'x',
+        crayon::blue(x$initial_cell[3]),
+        ')'
+      ),
+      '\n'
+    )
+  }
+
+
+  # cat("\n")
+  # if (x$has_species & x$has_initial_cell)
+  #   cat(crayon::bgGreen(crayon::white(' RACES can simulate ')))
   # else
-  # {
-  #   # Pretty print
-  #   max_pad = 1 + (nchar(x$species$species) %>% max)
-  #   max_pad = ifelse(max_pad <=2, 3, max_pad)
-  #   max_pad = paste0('%', max_pad, 's')
-  #   
-  #   for(s in sp_name)
-  #   {
-  #     cnt = x$simulation$get_counts() %>% filter(species == s)
-  #     
-  #     sname = paste('', s, '')
-  #     sname = sprintf(max_pad, s)
-  #     sname = crayon::bgYellow(crayon::black( sname ))
-  #     
-  #     ancestor = AncestorOf(x, s)
-  #     ancestor = ifelse(is.na(ancestor), 'wt', ancestor)
-  #     ancestor = sprintf(max_pad, ancestor)
-  #     ancestor = crayon::bgBlue(crayon::white( ancestor ))
-  #     ancestor = paste0('\u21AA ', ancestor)
-  #     
-  #     grate = paste0(
-  #       '  \u03BB =', sprintf("%6s", GRateOf(x, s, '+')), ' (+) ', sprintf("%6s", GRateOf(x, s, '-')), ' (-)'
-  #     )
-  # 
-  #     drate = paste0(
-  #       '  \u03B4 =', sprintf("%6s", DRateOf(x, s, '+')), ' (+) ', sprintf("%6s", DRateOf(x, s, '-')), ' (-)'
-  #     )
-  # 
-  #     erate = paste0(
-  #       '  \u03B5 =', sprintf("%6s", ERateOf(x, s, '+')), ' (+) ', sprintf("%6s", ERateOf(x, s, '-')), ' (-)'
-  #     )
-  #     
-  #     cat('\n\t\u2022', sname, ancestor, "|", grate, "|", drate, "|", erate)   
-  #   }
-  # }
-  # 
-  # can_simulate = FALSE
-  # can_generate_data = FALSE
+  #   cat(crayon::bgRed(crayon::white(' RACES cannot simulate ')))
 
   invisible(x)
 }
 
 
+# printPretty = function(node, indent, last)
+# {
+#   cat(indent)
+#   if (last) {
+#     cat("\\-")
+#     indent = paste(indent, " ", sep = '')
+#   }
+#   else {
+#     cat("|-")
+#     indent = paste(indent, "| ", sep = '')
+#   }
+#   cat(node)
+#   
+#   A = x$clone_tree %>%
+#     tidygraph::activate(nodes) %>%
+#     dplyr::filter(name == !!node) %>%
+#     pull(time)
+# 
+#   
+#   cat('\n')
+#   
+#   cl = children(M, node)
+#   
+#   for (c in cl)
+#     printPretty(c, indent, c == cl[length(cl)])
+# }
 
 
-
+# Plot call
+# layout <- ggraph::create_layout(x$clone_tree, layout = 'tree')
+# 
+# ggraph(layout) +
+#   geom_edge_link(
+#     arrow = arrow(length = unit(2, 'mm')),
+#     end_cap = circle(5, 'mm'),
+#     start_cap  = circle(5, 'mm')
+#   ) +
+#   geom_node_point(aes(colour = name,
+#                       size = time),
+#                   na.rm = TRUE) +
+#   geom_node_text(aes(label = name),
+#                  colour = 'black',
+#                  vjust = 0.4) +
+#   coord_cartesian(clip = 'off') +
+#   # theme_graph(base_size = 8, base_family = '') +
+#   theme_void(base_size = 10) +
+#   theme(legend.position = 'bottom') +
+#   scale_color_manual(values = get_species_colors(x$species$genotype %>% unique)) +
+#   guides(color = FALSE,
+#          size = guide_legend("Clone size", nrow = 1)) 
 

R/rRACES-package.R

@@ -18,6 +18,7 @@ loadModule("Drivers", TRUE)
 #' @importFrom ggplot2 scale_color_manual
 #' @importFrom ggplot2 scale_fill_brewer
 #' @importFrom ggplot2 scale_fill_manual
+#' @importFrom knitr kable
 #' @importFrom RColorBrewer brewer.pal
 ## usethis namespace: end
 NULL

R/set_initial_cell.R

@@ -45,6 +45,9 @@ set_initial_cell = function(
   )
 
   x$has_initial_cell = TRUE
+  x$initial_cell = list(species_name, 
+                        position[1], 
+                        position[2])
 
   return(x)
 }