Strain specific disease dynamics (#227)

Allow for all disease dynamics and severities to be strain specific.

Update both Python and R interfaces and add new tests to check transmission and disease characteristics of infected agents (in both Python and R).

Resolved #228

Details 

* Support variant specific changes to sd_infectious_period

* Move transmission time distributions for disease to strain

Preparation for strain specific distributions

* Allow mean_time_to_symptoms to be strain dependent

Add test to check the mean time to symptoms for multiple strains

* Allow all disease times to be changed for strains

Update the Python interface and add a test

* Update the R interface to allow strain specific disease dynamics

* Add disease dynamics to the meta-model R interfafe

* Fix test_multi_strain_disease_transition_times

Increase the size of the population to reduce random error

Set np.seed at start of test to make fully reproducible

* Extend strains so that all disease outcomes can be changed

Update the Python interface

Add a test to check disease outcomes for 2 strains

* Add strain specific outcomes to R interface

Repeat test_multi_strain_disease_outcome_proportions in R

* Add strain specific outcomes to R MetaModel

* Add strain specific infectious type factors

Add test with 3 strains where only one symptom type can be transmitted
in each strain

* Add strain specific infectious factors to R interface

Translate Python test for this to R

Author: roberthinch

R/MetaModel.R

@@ -875,11 +875,40 @@ MetaModel <- R6Class( classname = 'MetaModel', cloneable = FALSE,
       return()
     },
 
-    add_new_strain = function( 
-    	transmission_multiplier = 1, 
-    	hospitalised_fraction = NA, 
+    add_new_strain = function(
+    	transmission_multiplier = 1,
+    	fraction_asymptomatic = NA,
+    	fraction_asymptomatic_multiplier = 1,
+    	mild_fraction = NA,
+    	mild_fraction_multiplier = 1,
+    	hospitalised_fraction = NA,
     	hospitalised_fraction_multiplier = 1,
-    	mean_infectious_period = NA
+    	critical_fraction = NA,
+    	critical_fraction_multiplier = 1,
+    	fatality_fraction = NA,
+    	fatality_fraction_multiplier = 1,
+    	location_death_icu = NA,
+    	mean_infectious_period = NA,
+    	sd_infectious_period = NA,
+    	asymptomatic_infectious_factor = NA,
+    	mild_infectious_factor = NA,
+    	mean_time_to_symptoms = NA,
+    	sd_time_to_symptoms = NA,
+    	mean_asymptomatic_to_recovery = NA,
+    	sd_asymptomatic_to_recovery = NA,
+    	mean_time_to_recover = NA,
+    	sd_time_to_recover = NA,
+    	mean_time_hospitalised_recovery = NA,
+    	sd_time_hospitalised_recovery = NA,
+    	mean_time_critical_survive = NA,
+    	sd_time_critical_survive = NA,
+    	mean_time_to_death = NA,
+    	sd_time_to_death = NA,
+    	mean_time_to_hospital = NA,
+    	mean_time_to_critical = NA,
+    	sd_time_to_critical = NA,
+    	mean_time_to_susceptible_after_shift = NA,
+    	time_to_susceptible_shift = NA
     )
     {
         if( self$n_strains == self$base_params[[ 1 ]][[ "max_n_strains" ]] )
@@ -892,7 +921,36 @@ MetaModel <- R6Class( classname = 'MetaModel', cloneable = FALSE,
               transmission_multiplier = data$transmission_multiplier ,
               hospitalised_fraction   = data$hospitalised_fraction,
               hospitalised_fraction_multiplier = data$hospitalised_fraction_multiplier,
-              mean_infectious_period = data$mean_infectious_period
+              fraction_asymptomatic = data$fraction_asymptomatic,
+              fraction_asymptomatic_multiplier = data$fraction_asymptomatic_multiplier,
+              mild_fraction = data$mild_fraction,
+              mild_fraction_multiplier = data$mild_fraction_multiplier,
+              critical_fraction = data$critical_fraction,
+              critical_fraction_multiplier = data$critical_fraction_multiplier,
+              fatality_fraction = data$fatality_fraction,
+              fatality_fraction_multiplier = data$fatality_fraction_multiplier,
+              location_death_icu = data$location_death_icu,
+              mean_infectious_period = data$mean_infectious_period,
+              sd_infectious_period   = data$sd_infectious_period,
+              asymptomatic_infectious_factor = data$asymptomatic_infectious_factor,
+              mild_infectious_factor = data$mild_infectious_factor,
+              mean_time_to_symptoms  = data$mean_time_to_symptoms,
+              sd_time_to_symptoms = data$sd_time_to_symptoms,
+              mean_asymptomatic_to_recovery = data$mean_asymptomatic_to_recovery,
+              sd_asymptomatic_to_recovery = data$sd_asymptomatic_to_recovery,
+              mean_time_to_recover = data$mean_time_to_recover,
+              sd_time_to_recover = data$sd_time_to_recover,
+              mean_time_hospitalised_recovery = data$mean_time_hospitalised_recovery,
+              sd_time_hospitalised_recovery = data$sd_time_hospitalised_recovery,
+              mean_time_critical_survive = data$mean_time_critical_survive,
+              sd_time_critical_survive = data$sd_time_critical_survive,
+              mean_time_to_death = data$mean_time_to_death,
+              sd_time_to_death = data$sd_time_to_death,
+              mean_time_to_hospital = data$mean_time_to_hospital,
+              mean_time_to_critical = data$mean_time_to_critical,
+              sd_time_to_critical = data$sd_time_to_critical,
+              mean_time_to_susceptible_after_shift = data$mean_time_to_susceptible_after_shift,
+              time_to_susceptible_shift = data$time_to_susceptible_shift
             )
             strain_idx <- strain$idx()
             strains[[ nidx ]][[ strain_idx + 1 ]] <<- strain
@@ -905,7 +963,36 @@ MetaModel <- R6Class( classname = 'MetaModel', cloneable = FALSE,
           transmission_multiplier = transmission_multiplier ,
           hospitalised_fraction   = hospitalised_fraction,
           hospitalised_fraction_multiplier = hospitalised_fraction_multiplier,
-          mean_infectious_period = mean_infectious_period
+          fraction_asymptomatic = fraction_asymptomatic,
+          fraction_asymptomatic_multiplier = fraction_asymptomatic_multiplier,
+          mild_fraction = mild_fraction,
+          mild_fraction_multiplier = mild_fraction_multiplier,
+          critical_fraction = critical_fraction,
+          critical_fraction_multiplier = critical_fraction_multiplier,
+          fatality_fraction = fatality_fraction,
+          fatality_fraction_multiplier = fatality_fraction_multiplier,
+          location_death_icu = location_death_icu,
+          mean_infectious_period = mean_infectious_period,
+          sd_infectious_period   = sd_infectious_period,
+          asymptomatic_infectious_factor = asymptomatic_infectious_factor,
+          mild_infectious_factor = mild_infectious_factor,
+          mean_time_to_symptoms  = mean_time_to_symptoms,
+          sd_time_to_symptoms = sd_time_to_symptoms,
+          mean_asymptomatic_to_recovery = mean_asymptomatic_to_recovery,
+          sd_asymptomatic_to_recovery = sd_asymptomatic_to_recovery,
+          mean_time_to_recover = mean_time_to_recover,
+          sd_time_to_recover = sd_time_to_recover,
+          mean_time_hospitalised_recovery = mean_time_hospitalised_recovery,
+          sd_time_hospitalised_recovery = sd_time_hospitalised_recovery,
+          mean_time_critical_survive = mean_time_critical_survive,
+          sd_time_critical_survive = sd_time_critical_survive,
+          mean_time_to_death = mean_time_to_death,
+          sd_time_to_death = sd_time_to_death,
+          mean_time_to_hospital = mean_time_to_hospital,
+          mean_time_to_critical = mean_time_to_critical,
+          sd_time_to_critical = sd_time_to_critical,
+          mean_time_to_susceptible_after_shift = mean_time_to_susceptible_after_shift,
+          time_to_susceptible_shift = time_to_susceptible_shift,
         )
         node_data <- replicate( self$n_nodes, data, simplify = FALSE )
 

R/Model.R

@@ -720,33 +720,150 @@ Model <- R6Class( classname = 'Model', cloneable = FALSE,
     #' @return \code{Strain} A Strain object representing this strain
     add_new_strain = function(
     	transmission_multiplier = 1,
+    	fraction_asymptomatic = NA,
+    	fraction_asymptomatic_multiplier = 1,
+    	mild_fraction = NA,
+    	mild_fraction_multiplier = 1,
     	hospitalised_fraction = NA,
     	hospitalised_fraction_multiplier = 1,
-    	mean_infectious_period = NA
+    	critical_fraction = NA,
+    	critical_fraction_multiplier = 1,
+    	fatality_fraction = NA,
+    	fatality_fraction_multiplier = 1,
+    	location_death_icu = NA,
+    	mean_infectious_period = NA,
+    	sd_infectious_period = NA,
+    	asymptomatic_infectious_factor = NA,
+    	mild_infectious_factor = NA,
+    	mean_time_to_symptoms = NA,
+    	sd_time_to_symptoms = NA,
+      mean_asymptomatic_to_recovery = NA,
+      sd_asymptomatic_to_recovery = NA,
+      mean_time_to_recover = NA,
+      sd_time_to_recover = NA,
+      mean_time_hospitalised_recovery = NA,
+      sd_time_hospitalised_recovery = NA,
+      mean_time_critical_survive = NA,
+      sd_time_critical_survive = NA,
+      mean_time_to_death = NA,
+      sd_time_to_death = NA,
+      mean_time_to_hospital = NA,
+      mean_time_to_critical = NA,
+      sd_time_to_critical = NA,
+      mean_time_to_susceptible_after_shift = NA,
+      time_to_susceptible_shift = NA
     )
     {
-
-      max_n_strains = self$get_param( "max_n_strains" )
-      n_strains = self$c_model$n_initialised_strains;
+      max_n_strains <- self$get_param( "max_n_strains" )
+      n_strains     <- self$c_model$n_initialised_strains;
 
       if( n_strains == max_n_strains )
         stop( "cannot add any more strains - increase the parameter max_n_strains at the initialisation of the model" )
 
+      if( is.na( fraction_asymptomatic[ 1 ] ) )
+      {
+        fraction_asymptomatic <- c()
+        for( idx in 1:length( AgeGroupEnum ) )
+          fraction_asymptomatic[ idx ] = self$get_param(
+            sprintf( "fraction_asymptomatic%s", names( AgeGroupEnum[idx])) ) *
+            fraction_asymptomatic_multiplier
+      }
+
+      if( is.na( mild_fraction[ 1 ] ) )
+      {
+        mild_fraction <- c()
+        for( idx in 1:length( AgeGroupEnum ) )
+          mild_fraction[ idx ] = self$get_param(
+            sprintf( "mild_fraction%s", names( AgeGroupEnum[idx])) ) *
+            mild_fraction_multiplier
+      }
+
       if( is.na( hospitalised_fraction[ 1 ] ) )
       {
-        hospitalised_fraction = c()
+        hospitalised_fraction <- c()
         for( idx in 1:length( AgeGroupEnum ) )
           hospitalised_fraction[ idx ] = self$get_param(
             sprintf( "hospitalised_fraction%s", names( AgeGroupEnum[idx])) ) *
             hospitalised_fraction_multiplier
       }
 
+      if( is.na( critical_fraction[ 1 ] ) )
+      {
+        critical_fraction <- c()
+        for( idx in 1:length( AgeGroupEnum ) )
+          critical_fraction[ idx ] = self$get_param(
+            sprintf( "critical_fraction%s", names( AgeGroupEnum[idx])) ) *
+            critical_fraction_multiplier
+      }
+
+      if( is.na( fatality_fraction[ 1 ] ) )
+      {
+        fatality_fraction <- c()
+        for( idx in 1:length( AgeGroupEnum ) )
+          fatality_fraction[ idx ] = self$get_param(
+            sprintf( "fatality_fraction%s", names( AgeGroupEnum[idx])) ) *
+            fatality_fraction_multiplier
+      }
+
+      if( is.na( location_death_icu[ 1 ] ) )
+      {
+        location_death_icu <- c()
+        for( idx in 1:length( AgeGroupEnum ) )
+          location_death_icu[ idx ] = self$get_param(
+            sprintf( "location_death_icu%s", names( AgeGroupEnum[idx])) )
+      }
+
       if( is.na( mean_infectious_period ) )
-      	mean_infectious_period = UNKNOWN;
+      	mean_infectious_period <- UNKNOWN;
+      if( is.na( sd_infectious_period ) )
+      	sd_infectious_period <- UNKNOWN;
+      if( is.na( asymptomatic_infectious_factor ) )
+        asymptomatic_infectious_factor <- UNKNOWN
+      if( is.na( mild_infectious_factor ) )
+        mild_infectious_factor <- UNKNOWN
+      if( is.na( mean_time_to_symptoms ) )
+      	mean_time_to_symptoms <- UNKNOWN;
+      if( is.na( sd_time_to_symptoms ) )
+      	sd_time_to_symptoms <- UNKNOWN;
+	    if( is.na( mean_asymptomatic_to_recovery ) )
+      	mean_asymptomatic_to_recovery <- UNKNOWN;
+      if( is.na( sd_asymptomatic_to_recovery ) )
+      	sd_asymptomatic_to_recovery <- UNKNOWN;
+      if( is.na( mean_time_to_recover ) )
+      	mean_time_to_recover <- UNKNOWN;
+      if( is.na( sd_time_to_recover ) )
+      	sd_time_to_recover <- UNKNOWN;
+      if( is.na( mean_time_hospitalised_recovery ) )
+      	mean_time_hospitalised_recovery <- UNKNOWN;
+      if( is.na( sd_time_hospitalised_recovery ) )
+      	sd_time_hospitalised_recovery <- UNKNOWN;
+      if( is.na( mean_time_critical_survive ) )
+      	mean_time_critical_survive <- UNKNOWN;
+      if( is.na( sd_time_critical_survive ) )
+      	sd_time_critical_survive <- UNKNOWN;
+      if( is.na( mean_time_to_death ) )
+      	mean_time_to_death <- UNKNOWN;
+      if( is.na( sd_time_to_death ) )
+      	sd_time_to_death <- UNKNOWN;
+      if( is.na( mean_time_to_hospital ) )
+      	mean_time_to_hospital <- UNKNOWN;
+      if( is.na( mean_time_to_critical ) )
+      	mean_time_to_critical <- UNKNOWN;
+      if( is.na( sd_time_to_critical ) )
+      	sd_time_to_critical <- UNKNOWN;
+      if( is.na( mean_time_to_susceptible_after_shift ) )
+      	mean_time_to_susceptible_after_shift <- UNKNOWN;
+      if( is.na( time_to_susceptible_shift ) )
+      	time_to_susceptible_shift <- UNKNOWN;
 
       c_model_ptr <- private$c_model_ptr()
-      strain_idx<-.Call('R_add_new_strain',c_model_ptr,transmission_multiplier,
-                        hospitalised_fraction, mean_infectious_period, PACKAGE='OpenABMCovid19');
+      strain_idx <-.Call('R_add_new_strain',c_model_ptr,transmission_multiplier,fraction_asymptomatic, mild_fraction,
+        hospitalised_fraction, critical_fraction, fatality_fraction, location_death_icu, mean_infectious_period,sd_infectious_period,
+        asymptomatic_infectious_factor, mild_infectious_factor, mean_time_to_symptoms,  sd_time_to_symptoms, mean_asymptomatic_to_recovery,
+		    sd_asymptomatic_to_recovery, mean_time_to_recover, sd_time_to_recover, mean_time_hospitalised_recovery,
+		    sd_time_hospitalised_recovery, mean_time_critical_survive, sd_time_critical_survive, mean_time_to_death,
+		    sd_time_to_death, mean_time_to_hospital,mean_time_to_critical, sd_time_to_critical, mean_time_to_susceptible_after_shift,
+		    time_to_susceptible_shift, PACKAGE='OpenABMCovid19');
 
       private$.strains[[ strain_idx + 1 ]] <- Strain$new( self, strain_idx )
       return( private$.strains[[ strain_idx + 1 ]] )