update onecolonist

R/DAISIE_ONEcolonist.R

@@ -167,3 +167,153 @@ DAISIE_ONEcolonist <- function(time,
   }
   return(descendants)
 }
+
+
+DAISIE_ONEcolonist_trait <- function(time,
+                                     island_spec,
+                                     stt_table) {
+  ### number of independent colonisations
+  uniquecolonisation <- as.numeric(unique(
+    island_spec[, "Colonisation time (BP)"]))
+  number_colonisations <- length(uniquecolonisation)
+  ### if there is only one independent colonisation - anagenetic and
+  ### cladogenetic species are classed as stac=2; immigrant classed as stac=4:
+  if (number_colonisations == 1) {
+    if (island_spec[1, "Species type"] == "I") {
+      descendants <- list(stt_table = stt_table,
+                          branching_times = c(
+                            time,
+                            as.numeric(island_spec[1, "Colonisation time (BP)"])
+                          ),
+                          stac = 4,
+                          missing_species = 0,
+                          num_state1 = sum(island_spec[,"trait_state"] == 1),
+                          num_state2 = sum(island_spec[,"trait_state"] == 2),
+                          clade = island_spec)
+    }
+    if (island_spec[1, "Species type"] == "A") {
+      descendants <- list(stt_table = stt_table,
+                          branching_times = c(
+                            time,
+                            as.numeric(island_spec[1, "Colonisation time (BP)"])
+                          ),
+                          stac = 2,
+                          missing_species = 0,
+                          num_state1 = sum(island_spec[,"trait_state"] == 1),
+                          num_state2 = sum(island_spec[,"trait_state"] == 2),
+                          clade = island_spec)
+    }
+    if (island_spec[1, "Species type"] == "C") {
+      descendants <- list(stt_table = stt_table,
+                          branching_times = c(
+                            time,
+                            sort(
+                              as.numeric(island_spec[, "branching time (BP)"]),
+                              decreasing = TRUE
+                            )
+                          ),
+                          stac = 2,
+                          missing_species = 0,
+                          num_state1 = sum(island_spec[,"trait_state"] == 1),
+                          num_state2 = sum(island_spec[,"trait_state"] == 2),
+                          clade = island_spec)
+    }
+  }
+
+  ### if there are two or more independent colonisations, all species are
+  ### classed as stac=3 and put within same list item:
+  if (number_colonisations > 1) {
+    descendants <- list(stt_table = stt_table,
+                        branching_times = NA,
+                        stac = 3,
+                        missing_species = 0,
+                        all_colonisations = list(),
+                        num_state1 = c(),
+                        num_state2 = c(),
+                        clade = list())
+
+    # Get branching and colonisation times
+    btimes_all_clado_desc <- rev(
+      sort(as.numeric(island_spec[, "branching time (BP)"]))
+    )
+    col_times <- sort(
+      unique(as.numeric(island_spec[, "Colonisation time (BP)"])),
+      decreasing = TRUE
+    )
+
+    # If there are endemic descendants find youngest col time
+    if (length(btimes_all_clado_desc) != 0) {
+      # Ensure all col_times are in b_times at this point.
+      # Covers cases of one recolonization followed by cladogenesis and
+      # potential extinction
+      if (any(!(col_times %in% btimes_all_clado_desc))) {
+        miss_col_time <- which(!(col_times %in% btimes_all_clado_desc))
+        btimes_all_clado_desc <- sort(
+          c(btimes_all_clado_desc, col_times[miss_col_time]),
+          decreasing = TRUE
+        )
+      }
+      youngest_col_time <- min(col_times)
+      i_youngest_col_btimes <- which(btimes_all_clado_desc == youngest_col_time)
+
+      # Remove youngest col time in branching times
+      testit::assert(youngest_col_time %in% btimes_all_clado_desc)
+      btimes_all_clado_desc <- btimes_all_clado_desc[-i_youngest_col_btimes]
+
+      descendants$branching_times <- c(time, btimes_all_clado_desc)
+      testit::assert(!(youngest_col_time %in% btimes_all_clado_desc))
+      clade <- island_spec[-i_youngest_col_btimes,]
+
+      # If no cladogenetic species is present, remove the youngest col time
+    } else if (length(btimes_all_clado_desc) == 0) {
+      youngest_col_time <- min(col_times)
+      i_youngest_col_time <- which(col_times == youngest_col_time)
+      col_times <- col_times[-i_youngest_col_time]
+
+      descendants$branching_times <- c(time, col_times)
+      clade <- island_spec[-i_youngest_col_btimes,]
+    }
+
+    descendants$num_state1 <- sum(clade[,"trait_state"] == 1)
+    descendants$num_state2 <- sum(clade[,"trait_state"] == 2)
+    descendants$clade <- clade
+
+    # all_colonisations section
+    uniquecol <- sort(as.numeric(
+      unique(island_spec[, "Colonisation time (BP)"])), decreasing = TRUE
+    )
+    for (i in seq_along(uniquecol)) {
+      descendants$all_colonisations[[i]] <- list(
+        event_times = NA,
+        species_type = NA
+      )
+
+      samecolonisation <- which(as.numeric(
+        island_spec[, "Colonisation time (BP)"]) == uniquecol[i]
+      )
+
+      if (island_spec[samecolonisation[1], "Species type"] == "I") {
+        descendants$all_colonisations[[i]]$event_times <- as.numeric(
+          c(time,island_spec[samecolonisation, "Colonisation time (BP)"])
+        )
+        descendants$all_colonisations[[i]]$species_type <- "I"
+      }
+
+      if (island_spec[samecolonisation[1], "Species type"] == "A") {
+        descendants$all_colonisations[[i]]$event_times <- as.numeric(
+          c(time, island_spec[samecolonisation, "Colonisation time (BP)"])
+        )
+        descendants$all_colonisations[[i]]$species_type <- "A"
+      }
+
+      if (island_spec[samecolonisation[1], "Species type"] == "C") {
+        descendants$all_colonisations[[i]]$event_times <-
+          sort(c(time, as.numeric(
+            island_spec[samecolonisation, "branching time (BP)"]
+          )), decreasing = TRUE)
+        descendants$all_colonisations[[i]]$species_type <- "C"
+      }
+    }
+  }
+  return(descendants)
+}

R/DAISIE_create_island.R

@@ -106,11 +106,9 @@ DAISIE_create_island_trait <- function(stt_table,
     mainland_ntotal = mainland_n + trait_pars$M2
 
     if (mainland_ntotal == 1) {
-      island <- DAISIE_ONEcolonist(total_time,
+      island <- DAISIE_ONEcolonist_trait(total_time,
                                    island_spec,
                                    stt_table)
-      island$num_state1 <- sum(island_spec[,"trait_state"] == 1)
-      island$num_state2 <- sum(island_spec[,"trait_state"] == 2)
     } else if (mainland_ntotal > 1) {
 
       ### number of colonists present
@@ -125,14 +123,11 @@ DAISIE_create_island_trait <- function(stt_table,
           subset_island <- rbind(subset_island[1:8])
           colnames(subset_island) <- cnames
         }
-        island_clades_info[[i]] <- DAISIE_ONEcolonist(
+        island_clades_info[[i]] <- DAISIE_ONEcolonist_trait(
           total_time,
           island_spec = subset_island,
           stt_table = NULL)
         island_clades_info[[i]]$stt_table <- NULL
-        island_clades_info[[i]]$num_state1 <- sum(subset_island[,"trait_state"] == 1)
-        island_clades_info[[i]]$num_state2 <- sum(subset_island[,"trait_state"] == 2)
-        island_clades_info[[i]]$subset_island <- subset_island
       }
       island <- list(stt_table = stt_table,
                      taxon_list = island_clades_info)

R/RcppExports.R

@@ -9,6 +9,9 @@ NULL
 #' @name daisie_odeint_cs
 NULL
 
+#' @export daisie_odeint_iw
+NULL
+
 #' Driver for the boost::odeint solver
 #'
 #' @name daisie_odeint_iw