The AHA Model  Revision: 12809
Reference implementation 04 (HEDG02_04)
m_evolut.f90
Go to the documentation of this file.
1 !> @file m_evolut.f90
2 !! THE_EVOLUTION Module implements the Genetic Algorithm for the AHA Model.
3 !! @author Sergey Budaev <sergey.budaev@uib.no>
4 !! @author Jarl Giske <jarl.giske@uib.no>
5 !! @date 2016-2017
6 
7 !-------------------------------------------------------------------------------
8 ! $Id: m_evolut.f90 8510 2019-07-05 11:02:40Z sbu062 $
9 !-------------------------------------------------------------------------------
10 
11 !> @brief Implementation of the genetic algorithm.
12 !> @section the_evolution_module THE_EVOLUTION module
13 !> The Genetic Algorithm is implemented here
15 
16  use commondata ! Global definitions of model objects
17  use the_genome ! This mod defines our individual fish object
18  use the_neurobio
19  use the_individual
20  use the_population
21  use the_environment
22 
23  use base_utils ! Modelling tools
24  use base_random
25  use csv_io
26  use logger
27 
28  implicit none
29  private
30  public generations_loop_ga, & ! Only global GA loop is exposed,
31  preevol_steps_adaptive, & ! other objects are public for
32  preevol_steps_adaptive_save_csv ! external tests.
33 
34  ! PROCNAME is the procedure name for logging and debugging
35  character (len=*), parameter, private :: modname = "(THE_EVOLUTION)"
36 
37  !> Model-global stopwatch objects.
38  !! @note Use the keyword `TIMER:` (LTAG_TIMER) for logging, e.g.
39  !! `call LOG_MSG( LTAG_TIMER // stopwatch_op_current%show() )`
40  type(timer_cpu), public :: stopwatch_global, & !> global stopwatch
41  stopwatch_generation, & !> generation-wise
42  stopwatch_op_current !> single operation
43 
44  !> We have an environment composed of two habitats, safe and a dangerous.
46 
47  !> Here we create instances for two populations which will then serve as
48  !! parents and offspring. And then we declare pointers that will point to
49  !! parents and offspring.
50  type(population), public, target :: generation_one ! new populations
51  type(population), public, target :: generation_two ! as objects
52  type(population), public, pointer :: proto_parents
53  type(population), public, pointer :: proto_offspring
54 
55 contains ! ........ implementation of procedures for this level ................
56 
57 !-----------------------------------------------------------------------------
58  !> Initialise the environmental objects. Most of the environmental objects,
59  !! such as the environment, habitats etc. are kept static throughout the
60  !! model running. There are, however, patterned and stochastic changes in
61  !! the environment, such as diurnal variation of the illumination level.
63 
64  character(len=*), parameter :: PROCNAME = "(init_environment_objects)"
65 
66  integer :: i ! counter
67 
68  !> ### Build the environmental objects ###
69  !> Build the overall environment "universe". It can be used for the
70  !! whole-environment placement of objects, e.g. random walks of an agent
71  !! crossing the borders between the habitats.
72  call log_dbg("Initialisation of the environment and the habitat(s)")
73 
74  ! Start stopwatch for timing the environment init process.
75  call stopwatch_op_current%start("Initialisation of the environment")
76 
77  !> Build the habitats.
78  call habitat_safe%make( &
79  coord_min=spatial( habitat_safe_min_coord(1), &
82  coord_max=spatial( habitat_safe_max_coord(1), &
85  label="Safe", &
86  predators_number=predators_num_habitat_safe, &
87  otherrisks=other_risks_habitat_safe, &
88  food_abundance=food_abundance_habitat_safe )
89 
90  call habitat_dangerous%make( &
91  coord_min=spatial( habitat_danger_min_coord(1), &
94  coord_max=spatial( habitat_danger_max_coord(1), &
97  label="Dangerous", &
98  predators_number=predators_num_habitat_danger, &
99  otherrisks=other_risks_habitat_danger, &
100  food_abundance=food_abundance_habitat_danger )
101 
102  call log_msg( ltag_timer // stopwatch_op_current%show() )
103 
104  !> Define and allocate the global array of all habitats available to the
105  !! agents. See the_environment::global_habitats_available for details of
106  !! this global array. This is now made using the the_environment::assemble()
107  !! procedure.
108  ! It is analogous to such a code:
109  ! @code
110  ! allocate(Global_Habitats_Available(2))
111  ! Global_Habitats_Available = [ habitat_safe, habitat_dangerous ]
112  ! @endcode
114  !> Allocation of the the_environment::global_habitats_available is
115  !! checked. If it turns out not allocated, a critical error is signalled
116  !! in the logger and the program calls commondata::system_halt().
117  if (.not. allocated(global_habitats_available) ) then
118  call log_msg( ltag_crit // "Global_Habitats_Available array " // &
119  "cannot be allocated in " // procname // "!" )
120  call system_halt(is_error=.true., message=error_allocation_fail)
121  end if
122 
123  !> ### Save initial diagnostic data ###
124  !> Output the number of the habitats in the global array
125  !! the_environment::global_habitats_available and their labels into
126  !! the logger.
127  call log_msg( ltag_info // "Allocated 'Global_Habitats_Available' to " // &
128  tostr(size(global_habitats_available)) // " elements:" )
129  call log_msg( ltag_info // " " // tostr( &
130  [( global_habitats_available(i)%get_label(), &
131  i=1, size(global_habitats_available) )] ) )
132 
133  !> Certain data are also saved. Their names start from the `init_` prefix.
134  !> - Save initial food data (uniform distribution as built at init). Note
135  !! that the distribution of the food items can change at each time step
136  !! due to vertical migration of the food items and their local random
137  !! Gaussian movements.
138  call log_msg( ltag_info // &
139  "Saving initial uniform food resources to CSV files.")
140  call habitat_safe%food%save_csv( &
141  csv_file_name = "init_food_safe_habitat" // csv )
142  call habitat_dangerous%food%save_csv( &
143  csv_file_name = "init_food_dangerous_habitat" // csv )
144 
145  !> - Save predators' data.
146  call log_msg(ltag_info // "Saving predators from habitats into CSV files.")
147  call habitat_safe%save_predators_csv( &
148  csv_file_name = "init_predators_safe_habitat" // csv )
149  call habitat_dangerous%save_predators_csv( &
150  csv_file_name = "init_predators_dangerous_habitat" // csv )
151 
152  !> - Save the basic data on the dynamics of illumination, food items and
153  !! visibility across the life span of the agents.
154  !! .
155  call save_dynamics( csv_file_name = "init_dynamics" // csv )
156 
157  !> #### Save plots ####
158  !> If the plotting is enabled (see commondata::is_plotting), some plots
159  !! of the initialisation data are also saved.
160  do_plot: if (is_plotting) then
161  !> - Save debug scatterplots of food items distribution within in
162  !! the habitats.
163  call debug_scatterplot_save(x_data=habitat_safe%food%food%x, &
164  y_data=habitat_safe%food%food%y, &
165  csv_out_file="debug_plot_food_safe_"// mmdd // "_g" // &
167  delete_csv=.false., enable_non_debug=.true. )
168  call debug_scatterplot_save(x_data=habitat_dangerous%food%food%x, &
169  y_data=habitat_dangerous%food%food%y, &
170  csv_out_file="debug_plot_food_danger_" // mmdd // "_g" // &
172  delete_csv=.false., enable_non_debug=.true. )
173  !> - Save debug scatterplots of predators distribution in the habitats.
174  call debug_scatterplot_save(x_data=habitat_safe%predators%x, &
175  y_data=habitat_safe%predators%y, &
176  csv_out_file="debug_plot_predat_safe_" // mmdd // "_g" // &
178  delete_csv=.false., enable_non_debug=.true. )
179  call debug_scatterplot_save(x_data=habitat_dangerous%predators%x, &
180  y_data=habitat_dangerous%predators%y, &
181  csv_out_file="debug_plot_predat_danger_" // mmdd // "_g"// &
183  delete_csv=.false., enable_non_debug=.true. )
184  !> - Save histograms of food item sizes.
185  !! .
186  call debug_histogram_save(x_data=habitat_safe%food%food%size, &
187  csv_out_file="debug_hist_food_safe_size_" // mmdd // "_g" //&
189  delete_csv=.false., enable_non_debug=.true. )
190  call debug_histogram_save(x_data=habitat_dangerous%food%food%size, &
191  csv_out_file="debug_hist_food_dang_size_" // mmdd // "_g" //&
193  delete_csv=.false., enable_non_debug=.true. )
194 
195  end if do_plot
196 
197  end subroutine init_environment_objects
198 
199  !-----------------------------------------------------------------------------
200  !> Calculate the adaptive number of time steps for the fixed fitness
201  !! preevolution stage of the genetic algorithm.
202  !!
203  !! The number of time steps in the fixed-fitness pre-evolution genetic
204  !! algorithm is calculated using an adaptive algorithm. Briefly, the number
205  !! of time steps (total lifespan) at the early stages of evolution (the first
206  !! generations) is very short and increases as the evolution proceeds towards
207  !! the maximum set by commondata::preevol_tsteps.
208  !! @note The time steps data generated by this function for each GA
209  !! generation are saved in CSV file by
210  !! the_evolution::preevol_steps_adaptive_save_csv().
211  function preevol_steps_adaptive( generation ) result(steps)
212  !> @param[in] generation optional current generation number, if not
213  !! provided, set to commondata::global_generation_number_current.
214  integer, optional, intent(in) :: generation
215  !> @return The number of lifecycle time steps at the specific generation.
216  integer :: steps
217 
218  ! Local copies of optionals
219  real(srp) :: generation_number
220 
221  ! The duration of a single diel cycle
222  integer, parameter :: one_cycle = lifespan / dielcycles
223 
224  ! The number of diel cycles in the pre-evolution stage.
225  integer, parameter :: preevol_cycles = preevol_tsteps / one_cycle
226 
227  !> ### Implementation notes ###
228  !> The number of time steps in this fixed fitness pre-evol adaptive GA
229  !! algorithm is calculated based on a linear interpolation from a grid
230  !! defined by the two arrays:
231  !! - `STEPS_ABSCISSA` -- grid abscissa, from the first generation to
232  !! the total number of generations commondata::generations.
233  real(srp), dimension(*), parameter :: steps_abscissa = &
234  [ real(srp) :: 1.0_srp, &
235  generations / 2, &
236  generations * 3 / 4, &
237  generations + 1 ]
238 
239  !> - `STEPS_ORDINATE` -- grid ordinate, ranging from the number of time
240  !! steps in one diel cycle to the total number of time steps in the
241  !! fixed fitness pre-evolution stage commondata::preevol_tsteps.
242  ! `htintrpl.exe [1 50 75 100] [0 0.3 0.6 1] [1] [nonlinear]`
243  ! `htintrpl.exe [1 50 75 101] [0 0.8 0.95 1] [1] [nonlinear]`
244  ! `htintrpl.exe [1 50 75 101] [0.5 0.8 0.95 1] [1] [nonlinear]`
245  !> .
246  real(srp), dimension(*), parameter :: steps_ordinate = &
247  [ real(srp) :: one_cycle * preevol_cycles * 0.30_srp, &
248  one_cycle * preevol_cycles * 0.80_srp, &
249  one_cycle * preevol_cycles * 0.95_srp, &
251 
252  !> However, for debugging purposes, evolution time steps can be set to a
253  !! specific fixed value. This value is set by
254  !! commondata::preevol_tsteps_force_debug integer parameter and for this
255  !! fixed value to be forced, commondata::preevol_tsteps_force_debug_enabled
256  !! must be TRUE.
259  return
260  end if
261 
262  ! Check optional parameter.
263  if (present(generation)) then
264  generation_number = real( generation, srp )
265  else
266  generation_number = real( global_generation_number_current, srp )
267  end if
268 
269  !> Then, the total (adaptive) number of time steps is determined by the
270  !! integer lower limit (floor) of the linear interpolation DDPINTERPOL()
271  !! procedure, with further limitation that its result value must be
272  !! within the range of [*t,T*], where *t* is the length of a single
273  !! diel cycle, *T* is the number of time steps in the pre-evolution stage.
274  !!
275  !! @note Plotting commands:
276  !! - `htintrpl.exe [1 50 75 101] [0 0.8 0.95 1] [1] [nonlinear]`
277  !! .
278  steps = floor( within( ddpinterpol( steps_abscissa, &
279  steps_ordinate, &
280  generation_number ), &
281  real( one_cycle, srp ), &
282  real( PREEVOL_TSTEPS, SRP ) ) )
283 
284  end function preevol_steps_adaptive
285 
286  !-----------------------------------------------------------------------------
287  !> This is a diagnostic subroutine to save the number of time steps for the
288  !! adaptive GA.
289  subroutine preevol_steps_adaptive_save_csv(csv_file_name, is_success)
290  !> @param[in] csv_file_name the name of the CSV file to save the arrays.
291  character(len=*), intent(in) :: csv_file_name
292  !> @param[out] is_success Flag showing that data save was successful
293  !! (if TRUE).
294  logical, optional, intent(out) :: is_success
295 
296  logical :: csv_file_status
297 
298  integer, dimension(GENERATIONS) :: generation ! generation
299  integer, dimension(GENERATIONS) :: time_steps ! n of time steps
300  integer :: i ! counter
301 
302  generation = [( i, i=1, generations )]
303  time_steps = [(preevol_steps_adaptive(i), i=1, generations)]
304 
305  call csv_matrix_write ( reshape( [ generation, &
306  time_steps ], &
307  [ generations, 2 ] ), &
308  csv_file_name, &
309  [ "GENERATION","TIME_STEP " ], &
310  csv_file_status )
311 
312  if (present(is_success)) is_success = csv_file_status
313 
314  end subroutine preevol_steps_adaptive_save_csv
315 
316  !-----------------------------------------------------------------------------
317  !> Swap generation pointers between parents and offspring.
318  subroutine generations_swap()
319 
320  if (associated(proto_parents, target=generation_one)) then
323  else
326  end if
327 
328  end subroutine generations_swap
329 
330  !-----------------------------------------------------------------------------
331  !> Select reproducing agents, the best commondata::ga_reproduce_pr
332  !! portion of agents.
333  subroutine selection()
334 
335  ! Local counter
336  integer :: i
337 
338  ! Number of the best reproducing agents.
339  integer :: ga_reproduce
340 
341  !> The best (sorted) parents are copied to the offspring population object.
342  !! Note that the number of such reproducing parents is determined by the
343  !! the_population::population::ga_reproduce_max() method.
344  ga_reproduce = proto_parents%ga_reproduce_max()
345 
346  !> Old fixed proportion implementation:
347  !! @code
348  !! proto_offspring(:GA_REPRODUCE_N) = proto_parents(:GA_REPRODUCE_N)
349  !! @endcode
350  proto_offspring%individual(:ga_reproduce) = &
351  proto_parents%individual(:ga_reproduce)
352 
353  !> The best parents (elite group) are then re-initialised from the genome
354  !! for the next generation using the_individual::individual_agent::init()
355  !! method.
356  do i=1, ga_reproduce
357  call proto_offspring%individual(i)%init(exclude_genome=.true.)
358  end do
359 
360  end subroutine selection
361 
362  !-----------------------------------------------------------------------------
363  !> Mate, reproduce and mutate.
364  subroutine mate_reproduce()
365 
366  integer :: i, i1, i2
367 
368  ! PROCNAME is the procedure name for logging and debugging (with MODNAME).
369  character(len=*), parameter :: PROCNAME = "(mate_reproduce)"
370 
371  real(SRP) :: adapt_mut_point, adapt_mut_batch
372 
373  !> Calculate adaptive mutation rate
374  adapt_mut_point = proto_parents%ga_mutat_adaptive(mutationrate_point, &
376  adapt_mut_batch = proto_parents%ga_mutat_adaptive(mutationrate_batch, &
378  call log_msg( ltag_stage // "Mutation rates: " // &
379  tostr(adapt_mut_point) // ", " // tostr(adapt_mut_batch) // &
380  " for population size " // tostr(proto_parents%get_size()) )
381 
382  !> Loop through all the non-elite population members. These individuals
383  !! are created from the genomes of the elite group. The non-elite
384  !! individuals are from commondata::ga_reproduce_n+1 to commondata::popsize.
385  do i = proto_parents%ga_reproduce_max() + 1, popsize
386 
387  !> - If chromosomes are not allocated, this means it is a new individual.
388  !! We have to initialise it -- now as random. The same is true for all
389  !! individuals that the_genome::individual::genome::is_dead().
390  if ( .not. allocated(proto_offspring%individual(i)%chromosome) ) then
391  call proto_offspring%individual(i)%init()
392  !call proto_offspring%individual(i)%sex_init()
393  call proto_offspring%individual(i)%place_uniform(habitat_safe)
394  call log_dbg( ltag_info // "Initialised individual " // &
395  tostr(i) // " (" // &
396  tostr(proto_offspring%individual(i)%get_id()) // ")", &
397  procname, modname )
398  end if
399 
400  !> - Two agents are randomly chosen from the population. They become the
401  !! mother and the father of new `proto_offspring` agents. The mother
402  !! and the father exchange their genetic material using the
403  !! the_genome::individual_genome::recombine_random() method. Note that
404  !! the mother must be the_genome::individual_genome::is_female()
405  !! and the father, the_genome::individual_genome::is_male().
406  i1 = rand_i( 1, ga_reproduce_n * 2 ) ! the **mother** must be female.
407  do while (proto_parents%individual(i1)%is_male())
408  i1 = rand_i( 1, ga_reproduce_n * 2 )
409  end do
410  i2 = rand_i( 1, ga_reproduce_n * 2 ) ! the **father** must be male.
411  do while (proto_parents%individual(i2)%is_female())
412  i2 = rand_i( 1, ga_reproduce_n * 2 )
413  end do
414  call proto_offspring%individual(i)%recombine_random( &
415  mother = proto_parents%individual(i1), &
416  father = proto_parents%individual(i2) )
417 
418  !> - Once the genome of the offspring is created from recombination data,
419  !! the offspring are subjected to random mutation using the
420  !! the_genome::individual_genome::mutate() backend.
421  call proto_offspring%individual(i)%mutate( &
422  p_point = adapt_mut_point, p_set = adapt_mut_batch )
423 
424  !> - After this, the whole agent is initialised using he constructor
425  !! the_genome::individual_agent::init(), but without random
426  !! initialisation of the genome, the latter is based on the
427  !! recombination data from the parents.
428  !! .
429  call proto_offspring%individual(i)%init(exclude_genome=.true.)
430 
431  end do
432 
433  !> Finally, loop through the elite group and introduce random mutations
434  !! there too with the_genome::individual_genome::mutate().
435  !! @note This is disabled (elitism).
436  !do i = 1, GA_REPRODUCE_N
437  ! call proto_offspring%individual(i)%mutate()
438  !end do
439 
440  end subroutine mate_reproduce
441 
442  !-----------------------------------------------------------------------------
443  !> This procedure implements the main **Genetic Algorithm** for evolving the
444  !! agents.
445  subroutine generations_loop_ga()
446  use file_io
447  ! PROCNAME is the procedure name for logging and debugging (with MODNAME).
448  character(len=*), parameter :: procname = "(generations_loop_ga)"
449 
450  !> #### Objects for the GA ####
451  !> - `energy_mean_gen1_birth_mort` -- average value of the birth energy
452  !! reserves, for forced selective birth mortality. See
453  !! the_population::population::mortality_birth().
454  real(srp) :: energy_mean_gen1_birth_mort
455  !> - `energy_sd_gen1_birth_mort` -- standard deviationof the birth energy
456  !! reserves, for forced selective birth mortality. See
457  !! the_population::population::mortality_birth().
458  !! .
459  real(srp) :: energy_sd_gen1_birth_mort
460 
461  !> #### Objects for generation-wise statistics file ####
462  !> The definitions below are for the objects that are used to write
463  !! generation-wise statistics in the ::generation_stats_record_write()
464  !! sub-procedure.
465  !! - `csv_file_generstats`: `CSV_IO` File handle object for generation-wise
466  !! statistics. See `CSV_IO` module for details.
467  !! @note Note that file_io::file_handle object is not used here
468  !! because it breaks Intel Fortran compiler: as the file unit
469  !! somehow gets lost in ::generation_stats_record_write().
470  !! GNU gfortran has no issues here.
471  type(csv_file) :: csv_file_generstats
472 
473  !> - `file_stats_gener_record`: Record for the generation-wise statistics
474  !! file.
475  character(len=:), allocatable :: file_stats_gener_record
476  !> - `FILE_STATS_GENER_COLS`: an array of column names for the
477  !! generation-wise statistics file.
478  character(len=LABEL_LENGTH), dimension(*), parameter :: &
479  file_stats_gener_cols = [ character(len=label_length) :: &
480  "GENERATION", & ! 1
481  "PREEVOL_STEPS", & ! 2
482  "MUTAT_POINT", & ! 3
483  "MUTAT_BATCH", & ! 4
484  "ELITE_GROUP", & ! 5
485  "N_ALIVE", & ! 6
486  "N_GROWN", & ! 7
487  "N_MALES_L", & ! 8
488  "N_FEMALES_L", & ! 9
489  "N_EATEN_PRED", & ! 10
490  "BODY_MASS", & ! 11
491  "BODY_LEN", & ! 12
492  "BIRTH_MASS", & ! 13
493  "BIRTH_LENGTH", & ! 14
494  "BIRTH_ENERGY", & ! 15
495  "ENERGY", & ! 16
496  "STOMACH", & ! 17
497  "SMR", & ! 18
498  "CTRL_RND", & ! 19
499  "REPRFACT", & ! 20
500  "P_REPR", & ! 21
501  "N_REPROD", & ! 22
502  "N_OFFSPRING", & ! 23
503  "GOS_AROUSAL", & ! 24
504  "FOODS_TRY", & ! 25
505  "FOODS_EATEN", & ! 26
506  "FMASS_EATEN", & ! 27
507  "PERC_FOOD", & ! 28
508  "PERC_CONS", & ! 29
509  "PERC_PRED", & ! 30
510  "DEPTH", & ! 31
511  "N_SAFE_HABITAT", & ! 32
512  "N_DANG_HABITAT", & ! 33
513  "PERC_FOOD_SAFE", & ! 34
514  "PRC_FDIST_SAFE", & ! 35
515  "PERC_CONS_SAFE", & ! 36
516  "PERC_PRED_SAFE", & ! 37
517  "PERC_FOOD_DANG", & ! 38
518  "PRC_FDIST_DANG", & ! 39
519  "PERC_CONS_DANG", & ! 40
520  "PERC_PRED_DANG", & ! 41
521  "FDIST_SAFE", & ! 42
522  "FDIST_DANGER", & ! 43
523  "FITNESS_MIN", & ! 44
524  "FITNESS_MEAN", & ! 45
525  "N_FOODS_SAFE", & ! 46
526  "N_FOODS_DANG", & ! 47
527  "BODY_MASS_L", & ! 48
528  "BODY_LENGTH_L", & ! 49
529  "ENERGY_L", & ! 50
530  "SMR_L", & ! 51
531  "CONTROL_L", & ! 52
532  "REPRFACT_L", & ! 53
533  "P_REPROD_L", & ! 54
534  "FOODS_TRY_L", & ! 55
535  "FOODS_EATEN_L", & ! 56
536  "FMASS_EATEN_L", & ! 57
537  "N_SAFE_HAB_L", & ! 58
538  "N_DANG_HAB_L", & ! 59
539  "FITNESS_MEAN_L" ] ! 60
540 
541  !> - `FILE_STATS_RECORD_LEN`: The maximum length of the CSV record assuming
542  !! the maximum length of a single field is commondata::label_length; the
543  !! number of fields is equal to the size of the columns array
544  !! `FILE_STATS_GENER_COLS`.
545  !! .
546  integer, parameter :: file_stats_record_len = &
547  size(file_stats_gener_cols) * label_length + &
548  size(file_stats_gener_cols) * 3
549 
550  !> #### Parameters for the GA stopping rule ####
551  !> Parameters determining the **stopping rule** for the fixed fitness
552  !! genetic algorithm. These are based on the values obtained in the first
553  !! generation. If in any succeeding generation, they fall below the first
554  !! generation values, evolution is considered unsuccessful and the main GA
555  !! loop stops.
556  !> The number of alive agents at the first random generation.
557  !! - Evolution should stop with unsuccessful status if the number of alive
558  !! agents falls below this value.
559  integer :: ga_alive_generation_1
560  !> The number of agents that have increased their body mass at the first
561  !! random generation.
562  !> - Evolution should stop with unsuccessful status if the number of alive
563  !! agents falls below this value.
564  !! .
565  integer :: ga_growing_generation_1
566 
567  ! Total N of alive and N of agents that have grown
568  integer :: n_alive, n_growing
569 
570  !> # Preliminary steps #
571  !> `Global_Generation_Number_Current` is the global generation number.
572  !! It is first initialised to **1**.
574 
575  !> commondata::Global_Rescale_Maximum_Motivation is the global maximum
576  !! motivation value, it is fixed at the start of the simulation to an
577  !! arbitrary high value but is automatically updated from the maximum
578  !! motivation value across all agents after each time step.
580 
581  !> The stopping rule parameters based on the first generation values are
582  !! initialised to some values allowing the first generation to occur
583  !! safely, i.e. with sufficiently large number of randomly created
584  !! pre-optimal agents.
585  !! - If the number of alive agents is smaller than this minimum number,
586  !! GA stops: some parameters must be tweaked.
587  ga_alive_generation_1 = ceiling( popsize * 0.005_srp )
588  !> - The number of agents growing is set to a large negative value
589  !! commondata::unknown,so initial zero is always larger, so evolution
590  !! is allowed to start.
591  !! .
592  ga_growing_generation_1 = unknown
593 
594  call log_dbg( ltag_major // "GLOBAL STARTUP " // procname )
595 
596  ! Start global stopwatch
597  call stopwatch_global%start("Global time whole simulation")
598 
599  !> ## Initialise the environment ##
600  !> All environmental objects are initialised with
601  !! ::init_environment_objects().
603 
604  !> ## Initialise base agent population objects ##
605  !> New populations of agents are now built and initialised:
606  !! (a) `generation_one`, (b) `generation_two`
607  !! These population objects serve as targets for two pointer objects:
608  !! (a) `proto_parents`, (b) `proto_offspring`.
609  call log_msg("INFO: Initialising generation one objects.")
610 
611  call stopwatch_op_current%start("Initialising agents: generations 1 and 2")
612 
613  !> - Initialise the whole `generation_one` of the agents,
614  !! commondata::popsize is the size of the population.
615  call generation_one%init(popsize)
616 
617  !> - Also initialise the `generation_two`, that will then take parents'
618  !! values.
619  !! .
620  call generation_two%init(popsize)
621 
622  call log_msg( stopwatch_op_current%log())
623 
624  !> Calculate initial fitness of the agents in the `generation_one` for the
625  !! pre-evolution phase. At this stage fitness is equal to the maximum
626  !! value (note that fitness is actually a reverse of fitness) and is not
627  !! very interesting.
628  call generation_one%fitness_calc()
629 
630  !> Place all the agents that have been initialised to random
631  !! spatial positions in the safe habitat (`habitat_safe`), they
632  !! have just the uniformly distributed spatial positions at
633  !! start.
634  !! @note Note that the initial vertical position and distribution of
635  !! the agents depends on these parameters:
636  !! - commondata::init_agents_depth_is_fixed
637  !! - commondata::init_agents_depth_is_gauss
638  !! .
639  !! See the_population::individ_posit_in_environ_uniform() for details.
640  call generation_one%scatter_uniform(habitat_safe)
641  call generation_two%scatter_uniform(habitat_safe)
642 
643  call log_msg(ltag_info // "Initialisation of generation one completed" )
644  call log_dbg("Population with numeric ID " // &
645  tostr(generation_one%get_num_id()) // &
646  " and name '" // trim(generation_one%get_name()) // &
647  "' allocated to " // tostr(generation_one%get_size()) // &
648  " objects.", modname, procname)
649 
650  !> ## Transfer pointers: parents and offspring populations ##
651  !> Allocate the first `proto_parents` and `proto_offspring`
652  !! population objects, they are pointers to `generation_one` and
653  !! `generation_two` target objects.
656 
657  !> Calculate statistical parameters of the initial generation for
658  !! selective birth mortality. See
659  !! the_population::population::mortality_birth().
660  energy_mean_gen1_birth_mort = average(proto_parents%individual%energy_birth)
661  energy_sd_gen1_birth_mort = std_dev(proto_parents%individual%energy_birth)
662 
663  !> These values are then logged.
664  call log_msg(ltag_stage //"Birth energy values:" )
665  call log_msg(ltag_stage //" mean: " // tostr(energy_mean_gen1_birth_mort))
666  call log_msg(ltag_stage //" std.dev.:" // tostr(energy_sd_gen1_birth_mort))
667  ! Also, a table showing the confidence limits is logged, it is useful
668  ! for assessing possible limit on the birth energy evolution.
669  call log_msg(ltag_info // "Limits of std.dev. for birth mortality:" )
670  call log_msg(ltag_info // " [ MEAN, 1 SD, 2 SD, 3 SD]")
671  ! Template for aligned vals: [0.200, 0.409, 0.617, 0.825]
672  call log_msg(ltag_info // " [" // &
673  tostr(energy_mean_gen1_birth_mort,"(f5.3)") // ", " // &
674  tostr(energy_mean_gen1_birth_mort+ &
675  energy_sd_gen1_birth_mort*1.0_srp,"(f5.3)") // ", " // &
676  tostr(energy_mean_gen1_birth_mort+ &
677  energy_sd_gen1_birth_mort*2.0_srp,"(f5.3)") // ", " // &
678  tostr(energy_mean_gen1_birth_mort+ &
679  energy_sd_gen1_birth_mort*3.0_srp,"(f5.3)") // "]" )
680 
681  !> ## Save diagnostics data ##
682  !> Save initialisation data in the debug mode.
683  call log_dbg(ltag_info // "Sizes of populations after init:: " // &
684  "parents: " // tostr(size(proto_parents%individual)) // &
685  ", offspring: " // tostr( size(proto_offspring%individual) ) )
686 
687  !> - Saving histograms of agents' body length.
688  call debug_histogram_save(x_data=proto_parents%individual%body_length, &
689  csv_out_file="debug_hist_agent_body_len_birth_"// mmdd // &
690  "_rev_" // svn_version // &
691  "_g" // tostr(global_generation_number_current) // csv, &
692  delete_csv=.false., enable_non_debug=.true. )
693  !> - Saving histograms of agents' body mass.
694  call debug_histogram_save(x_data=proto_parents%individual%body_mass, &
695  csv_out_file="debug_hist_agent_body_mass_birth_"// mmdd // &
696  "_rev_" // svn_version // &
697  "_g" // tostr(global_generation_number_current) // csv, &
698  delete_csv=.false., enable_non_debug=.true. )
699  !> - Saving histograms of agents' energy.
700  call debug_histogram_save(x_data=proto_parents%individual%energy_current, &
701  csv_out_file="debug_hist_agent_energy_birth_"// mmdd // &
702  "_rev_" // svn_version // &
703  "_g" // tostr(global_generation_number_current) // csv, &
704  delete_csv=.false., enable_non_debug=.true. )
705  !> - Saving histograms of agents' smr.
706  !! .
707  call debug_histogram_save(x_data=proto_parents%individual%smr, &
708  csv_out_file="debug_hist_agent_smr_birth_"// mmdd // &
709  "_rev_" // svn_version // &
710  "_g" // tostr(global_generation_number_current) // csv, &
711  delete_csv=.false., enable_non_debug=.true. )
712 
713  !> **SAVE_DATA_INIT block**: The random initialisation individual data
714  !! for the whole parent population are saved to csv files:
715  save_data_init: block
716  ! A temporary variable to keep the file names at initialising files.
717  ! @note This variable is used only to set the names of the files once,
718  ! the names afterwards are kept internally in the file handle
719  ! objects
720  character(len=:), allocatable :: output_data_file
721  !> - Individual agent's data, file `init_agents_`;
722  output_data_file = "init_agents_" // model_name // "_" // mmdd // &
723  "_rev_" // svn_version // &
724  "_gen_" // tostr(global_generation_number_current, &
725  generations) // csv
726  call proto_parents%save_csv(output_data_file, is_logging=.true.)
727  !> - Initial genome data, file `init_genome_`.
728  output_data_file = "init_genome_" // model_name // "_" // mmdd // &
729  "_rev_" // svn_version // &
730  "_gen_" // tostr(global_generation_number_current, &
731  generations) // csv
732  call proto_parents%save_genomes_csv(output_data_file)
733  !> - The number of time steps in the adaptive GA
734  !! .
735  output_data_file = "init_tsteps_" // model_name // "_" // mmdd // &
736  "_rev_" // svn_version // &
737  "_gen_" // tostr(global_generation_number_current, &
738  generations) // csv
739  call preevol_steps_adaptive_save_csv(output_data_file)
740  !> The generation wise statistics file `generations_` is opened for
741  !! writing ...
742  output_data_file="generations_" // model_name // "_" // mmdd // &
743  "_rev_" // svn_version // csv
744  csv_file_generstats%name = output_data_file ! unit is automatic in CSV_IO
745  call csv_open_write( csv_file_generstats )
746  !> ... and the first row of column names `FILE_STATS_GENER_COLS` is
747  !! written.
748  !! @note Note that the main body of the statistical data is processed
749  !! in the sub-procedure ::generation_stats_record_write().
750  file_stats_gener_record = repeat(" ", file_stats_record_len )
751  call csv_record_append( file_stats_gener_record, file_stats_gener_cols )
752  call csv_record_write ( file_stats_gener_record, csv_file_generstats )
753  end block save_data_init
754 
755  !> The average distance between the food items is reported to the log.
756  !! The average distance between the food items is good to know, e.g. to
757  !! compare it with the agent's random walk step size.
758  call log_dbg(ltag_info // "Average distance between food items in the " //&
759  habitat_dangerous%habitat_name // " habitat: "// &
760  tostr(habitat_dangerous%food%distance_average(100)), &
761  procname, modname )
762  call log_dbg(ltag_info // "Average distance between food items in the " //&
763  habitat_safe%habitat_name // " habitat: "// &
764  tostr(habitat_safe%food%distance_average(100)), &
765  procname, modname )
766 
767  !> # Pre-evolution stage #
768  !> Pre-evolution stage involves the Genetic Algorithm that is based on
769  !! selection of agents based on an explicit global fitness. It aims to
770  !! produce a population of agents that can stably sustain for the whole
771  !! commondata::lifespan
772  !> ## GENERATIONS_PREEVOL: The main loop of (pre-) evolution ##
773  !> At this stage the main loop of generations evolving is started.
774  !! The conditions for **continuing** the main evolution loop are as
775  !! follows:
776  generations_preevol: do while ( &
777  !> - Global generation number does not exceed the maximum
778  !! commondata::generations.
780  .and. &
781  !> - Average (anti-) fitness still exceeds the target value.
782  !! .
783  average(proto_parents%individual%fitness) > 500 )
784 
785  call log_delimiter(log_level_volume)
786  call log_msg( ltag_stage // ltag_major // " Starting GENERATION: " // &
788  call log_delimiter(log_level_volume)
789 
790  !> #### Check stop file ####
791  !> The commondata::stop_file file is checked upon each generation. If this
792  !! stop file exists, the simulation cycle is terminated at this stage and
793  !! the program then exits from the generation loop.
794  check_stop_file: block
795  logical :: stop_signalled
796  inquire( file=stop_file, exist=stop_signalled )
797  if ( stop_signalled ) then
798  call log_msg( ltag_crit // "Stop file " // stop_file // " found" // &
799  ", exiting GA.")
800  exit generations_preevol
801  end if
802  end block check_stop_file
803 
804  !> #### Diagnostics ####
805  !> Stopwatch object for calculating time since generation start is
806  !! initialised.
807  call stopwatch_generation%start("Generation "// &
808  tostr(global_generation_number_current))
809 
810  !> Initially, place all the agents in the `proto_parents` population
811  !! randomly uniformly in the safe habitat (`habitat_safe`).
812  !! However, note that the initial vertical position and distribution of
813  !! the agents depends on these parameters:
814  !! - commondata::init_agents_depth_is_fixed
815  !! - commondata::init_agents_depth_is_gauss
816  !! .
817  !! See the_population::individ_posit_in_environ_uniform() method for
818  !! details.
819  call proto_parents%scatter_uniform(habitat_safe)
820 
821  !> Initialise the global generation-wise counter of the number of
822  !! agents that die as a consequence of predation
823  !! the_population::global_ind_n_eaten_by_predators, as opposed to
824  !! starvation.
825  global_ind_n_eaten_by_predators = 0
826 
827  !> If it is **not** the first generation, replenish all food items (i.e.
828  !! for all habitats), they are restored to the "available" (non-eaten)
829  !! state. Two methods can be used here:
830  !! - the_environment::food_resource::make() -- re-initialise food items
831  !! from scratch.
832  !! - the_environment::food_resource::replenish() -- reuse food items as
833  !! initialised in ::init_environment_objects()
834  !! .
835  replenish_food: if ( global_generation_number_current > 1 ) then
836  call habitat_safe%food%replenish()
837  call habitat_dangerous%food%replenish()
838  !> The global habitat array the_environment::global_habitats_available
839  !! is then updated by the_environment::assemble() procedure.
840  call assemble( habitat_safe, habitat_dangerous )
841  end if replenish_food
842  !> If it is the first generation, it does not make sense doing this as
843  !! the environment has been already fully initialised in the
844  !! ::init_environment_objects() procedure.
845 
846  !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
847  !> ### lifecycle_preevol for proto_parents ###
848  !> Start the loop of the life cycle of all agents of the `proto_parents`.
849  !! It includes commondata::preevol_tsteps time steps. (Note that
850  !! commondata::preevol_tsteps is less than commondata::lifespan).
851  !! This is implemented in the ::lifecycle_preevol() procedure.
852  call log_msg( ltag_stage // "Life cycle parents." )
854  !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
855 
856  !> Calculate the number of agents alive and agents growing. These values
857  !! are used later, including as a criterion of GA deterioration.
858  n_alive = count( proto_parents%individual%is_alive() )
859  n_growing = count( proto_parents%individual%get_mass() > &
860  proto_parents%individual%get_mass_birth() )
861 
862  !> Report these values in the logger.
863  call log_msg( ltag_info // "N alive: " // tostr(n_alive) // &
864  ", N grown: " // tostr(n_growing) )
865 
866  !> After the agents went through their life cycle, their fitness
867  !! is processed.
868  !> - Fitness of all `proto_parents` agents is recalculated following
869  !! their performance in the full lifecycle.
870  call log_msg( ltag_stage // "Fitness calculate in parents." )
871  call proto_parents%fitness_calc()
872 
873  !> - The agents `proto_parents` are sorted by fitness.
874  call log_msg( ltag_stage // "Sort parents by fitness." )
875  call proto_parents%sort_by_fitness()
876 
877  ! Output the best parent to logger.
878  call log_msg( ltag_info // "Best parent (1), fitness: " // &
879  tostr(proto_parents%individual(1)%fitness) )
880 
881  !> If this is the first generation, determine the GA deterioration
882  !! stopping parameters, evolution "failure"
883  params_gen_1: if (global_generation_number_current == 1) then
884  ga_alive_generation_1 = n_alive
885  ga_growing_generation_1 = n_growing
886  !> These Generation one parameters are also reported to the logger.
887  call log_msg( ltag_info // "This is the first generation" )
888  call log_msg( ltag_info // "Survival parameters that determine " // &
889  "the stopping rule: N Alive=" // &
890  tostr(ga_alive_generation_1) // &
891  ", N Growing=" // &
892  tostr(ga_growing_generation_1) )
893  end if params_gen_1
894 
895  !> - **SAVE_DATA_INDS_GENERATION block**: The individual statistical
896  !! data for the whole `proto_parents` population are saved using the
897  !! the_population::population class bound `save_` methods:
898  save_data_inds_generation: block
899  character(len=:), allocatable :: output_data_file
900  call log_msg( ltag_stage // "Saving parents." )
901  !> - Individual agent's data, file `agents_`
902  output_data_file = "agents_" // model_name // "_" // mmdd // &
903  "_rev_" // svn_version // &
904  "_gen_" // tostr(global_generation_number_current,&
905  generations) // "_p1_parents" // csv
906  call proto_parents%save_csv(output_data_file, is_logging=.true.)
907  !> - The genome data, file `genome_`
908  output_data_file = "genomes_" // model_name // "_" // mmdd // &
909  "_rev_" // svn_version // &
910  "_gen_" // tostr(global_generation_number_current,&
911  generations) // csv
912  call proto_parents%save_genomes_csv(output_data_file)
913  !> - Memory stacks data, file `memory_`.
914  output_data_file = "memory_" // model_name // "_" // mmdd // &
915  "_rev_" // svn_version // &
916  "_gen_" // tostr(global_generation_number_current,&
917  generations) // csv
918  call proto_parents%save_memory_csv(output_data_file)
919  !> - Movement history data, file `movements_`.
920  output_data_file = "movements_" // model_name // "_" // mmdd // &
921  "_rev_" // svn_version // &
922  "_gen_" // tostr(global_generation_number_current,&
923  generations) // csv
924  call proto_parents%save_movements_csv(output_data_file)
925  !> - Behaviour history data, file `behaviours_`.
926  output_data_file = "behaviours_" // model_name // "_" // mmdd // &
927  "_rev_" // svn_version // &
928  "_gen_" // tostr(global_generation_number_current,&
929  generations) // csv
930  call proto_parents%save_behaviour_csv(output_data_file)
931  end block save_data_inds_generation
932 
933  !> - **SAVE_DATA_FOOD_POST**: The food resources data for all the
934  !! habitats are saved using the
935  !! the_environment::food_resource::save_csv() method.
936  save_data_food_post: block
937  character(len=:), allocatable :: output_data_file
938  call log_msg( ltag_stage // "Saving food resources." )
939  output_data_file = "food_habitat_safe_gen_" // &
940  model_name // "_" // mmdd // &
941  "_rev_" // svn_version // &
942  "_gen_" // tostr(global_generation_number_current,&
943  generations) // csv
944  call habitat_safe%food%save_csv( output_data_file )
945  output_data_file = "food_habitat_dang_gen_" // &
946  model_name // "_" // mmdd // &
947  "_rev_" // svn_version // &
948  "_gen_" // tostr(global_generation_number_current,&
949  generations) // csv
950  call habitat_dangerous%food%save_csv( output_data_file )
951  end block save_data_food_post
952 
953  !> - Generation-wise statistics are calculated and saved in the CSV
954  !! file. This is implemented in the ::generation_stats_record_write()
955  !! subprocedure.
957 
958  !> - Check if the unsuccessful evolution criterion is met. If yes,
959  !! terminate the GA.
960  !> - The number of agents that are alive exceeds that in the
961  !! first generation: there must be improvement (at least in
962  !! debug).
963  !> - The number of agents that have grown exceeds that in the
964  !! first generation.
965  !! .
966  !! .
967  check_deteriorate: if ( global_generation_number_current > 1 ) then
968  if ( n_alive < ga_alive_generation_1 / 10 .or. &
969  n_growing < ga_growing_generation_1 / 10 ) then
970  call log_msg( ltag_major // "GA deterioration detected! " // &
971  "N alive=" // tostr(n_alive) // &
972  " (<" // tostr(ga_alive_generation_1) // &
973  "); N grown=" // tostr(n_growing) // &
974  " (<" // tostr(ga_growing_generation_1) // ")." )
975  call log_msg( ltag_crit // &
976  "Exiting GA due to deterioration in CHECK_DETERIORATE.")
977  exit generations_preevol
978  end if
979  !> - If this is the first generation, terminate GA if the number of
980  !! agents alive < 1/100 of the commpndata::popsize or if no agents are
981  !! growing.
982  !! .
983  else check_deteriorate
984  if ( n_alive < popsize / 100 ) then
985  call log_msg( ltag_crit // "Insufficient number of alive agents: " &
986  // tostr(n_alive) )
987  call system_halt(message="INSUFFICIENT ALIVE AGENTS IN GEN. 1")
988  elseif ( n_growing < 1 ) then
989  call log_msg( ltag_warn // "LESS THAN ONE AGENT GROWN IN GEN. 1" )
990  ! call system_halt(message="LESS THAN ONE AGENT GROWN IN GEN. 1")
991  end if
992  end if check_deteriorate
993 
994  !> ### Selection ###
995  !> Select reproducing minority: the_evolution::selection()
996  call log_msg( ltag_stage // "Selection (elitism)." )
997  call selection()
998 
999  !> ### Exchange of the genetic material ###
1000  !> A minority of the best parents produces the proto_offspring population
1001  !! object: the_evolution::mate_reproduce().
1002  call log_msg( ltag_stage // "Mate and reproduce." )
1003  call mate_reproduce()
1004 
1005  !> Reset individual IDs of proto_offspring
1006  call proto_offspring%reset_id()
1007 
1008  !> ### Finalise the generation cycle: swap pointers ###
1009  !> Swap populations: `proto_offspring` are now `proto_parents`:
1010  !! the_evolution::generations_swap().
1011  call log_msg( ltag_stage // "Swap generations." )
1012  call generations_swap()
1013 
1014  ! Log generation timing
1015  call log_delimiter(log_level_volume)
1016  call log_msg ( ltag_major // stopwatch_generation%show() )
1017  call log_delimiter(log_level_volume)
1018 
1019  !> ### End of the generations loop ###
1020  !> Finally, the global generation counter
1021  !! commondata::global_generation_number_current is incremented by one.
1022  global_generation_number_current = global_generation_number_current + 1
1023 
1024  end do generations_preevol
1025 
1026  !> After all generations were done, the CSV file `csv_file_generstats` that
1027  !! saves generation-wise statistics is closed.
1028  call csv_close( csv_file_generstats )
1029 
1030  ! > # Evolution stage #
1031  ! > This version of the model stops at the pre-evolution stage. Therefore,
1032  ! ! The evolution (GA) mechanism based on "elitism" is simplistic and not
1033  ! ! fairly realistic.
1034  call log_msg( ltag_info // "Best fitness evolved: " // &
1035  tostr( proto_parents%individual(1)%fitness ) )
1036 
1037  call log_delimiter(log_level_volume)
1038  call log_msg( ltag_major // "Simulation completed." )
1039  call log_msg( ltag_major // ltag_timer // stopwatch_global%show() )
1040  call log_delimiter(log_level_volume)
1041 
1042  !> # System terminates #
1043  !> Finally, the concluding procedure commondata::system_halt() is called
1044  !! for the normal termination of the model.
1045  call system_halt( is_error = .false., &
1046  message = "Normal termination of the pre-evolution" )
1047 
1048  contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1049 
1050  !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1051  !> This subroutine implements the full life cycle in a whole population of
1052  !! agents. It is built around the main loop `LIFECYCLE_PREEVOL_LOOP`.
1053  subroutine lifecycle_preevol( active_population )
1054  class(population), intent(inout) :: active_population
1055 
1056  ! PROCNAME is the procedure name for logging and debugging (with MODNAME).
1057  character(len=*), parameter :: PROCNAME = "(lifecycle_preevol)"
1058 
1059  ! This is a counter for time steps of the model in the second loop of
1060  ! pre-evolution stage. It is separate from the
1061  ! commondata::global_time_step_model_current.
1062  integer :: time_step
1063 
1064  ! Counters
1065  integer :: i
1066 
1067  ! Adaptive number of time steps for the GA.
1068  integer :: steps_gen_current
1069 
1070  ! ### Notable variables ###
1071  ! #### Time-step-wise statistics data ####
1072  ! Objects for producing time-steps statistics for each generation
1073  ! - `filename_time_steps` -- the name of the csv data file;
1074  character(len=FILENAME_LENGTH) :: filename_time_steps
1075 
1076  ! - `dpos_mean_agents`, `dpos_mean_foods_hab_safe` ... - arrays to save
1077  ! mean depth and std.dev. of depth of agents and food items at each
1078  ! time step.
1079  real(SRP), allocatable, dimension(:) :: dpos_mean_agents, &
1080  dpos_min_agents, &
1081  dpos_max_agents, &
1082  dpos_mean_foods_hab_safe, &
1083  dpos_min_foods_hab_safe, &
1084  dpos_max_foods_hab_safe, &
1085  dpos_mean_foods_hab_dang, &
1086  dpos_min_foods_hab_dang, &
1087  dpos_max_foods_hab_dang, &
1088  dpos_sd_agents, &
1089  dpos_sd_foods_hab_safe, &
1090  dpos_sd_foods_hab_dang
1091  ! - `n_agents_alive` ... - integer arrays to save the counts of alive
1092  ! agents and available (not eaten) food items in each habitat;
1093  integer, allocatable, dimension(:) :: n_agents_alive, &
1094  n_agents_eaten, &
1095  n_foods_available_safe, &
1096  n_foods_available_dang
1097 
1098  ! - `temp_val_select_alive` -- temporary array to keep the agent (depth)
1099  ! data for only 'alive' agents;
1100  real(SRP), dimension(POPSIZE) :: temp_val_select_alive ! select 'alive'
1101 
1102  ! - `temp_val_select_avail_safe` -- temporary arrays to keep the food
1103  ! item's (depth) data for only those food items that are 'available'.
1104  real(SRP), dimension(FOOD_ABUNDANCE_HABITAT_SAFE) :: &
1105  temp_val_select_avail_safe
1106  real(SRP), dimension(FOOD_ABUNDANCE_HABITAT_DANGER) :: &
1107  temp_val_select_avail_dang
1108 
1109  ! - `filename_alldata_time_steps` -- the name of the csv data file for
1110  ! saving all agent data each time step;
1111  ! .
1112  character(len=FILENAME_LENGTH) :: filename_alldata_time_steps
1113 
1114  !> ### Implementation details ###
1115  !> First, the ages of all agents are reset to 0 before the cycle of their
1116  !! life (time steps of the model).
1117  call active_population%individual%age_reset()
1118 
1119  !> Second, each generation is subjected to selective birth mortality
1120  !! by the_population::population::mortality_birth() at birth, before
1121  !! the first time step.
1122  !! @note Forced mean and sd values from generation 1 data. Normally
1123  !! must be obtained from the first generation data, with global
1124  !! parameters added.
1125  call active_population%mortality_birth( &
1126  energy_mean = energy_mean_gen1_birth_mort, &
1127  energy_sd = energy_sd_gen1_birth_mort )
1128 
1129  !> Then, calculate the number of time steps for the current generation.
1130  !! The number of time steps is based on the adaptive algorithm
1131  !! implemented in the the_evolution::preevol_steps_adaptive() function.
1132  steps_gen_current = preevol_steps_adaptive()
1133 
1134  !> The arrays that keep time-step wise statistics for the current
1135  !! generation are allocated with the above number of time steps.
1136  allocate( dpos_mean_agents( steps_gen_current) )
1137  allocate( dpos_min_agents( steps_gen_current) )
1138  allocate( dpos_max_agents( steps_gen_current) )
1139  allocate( dpos_mean_foods_hab_safe( steps_gen_current ) )
1140  allocate( dpos_min_foods_hab_safe( steps_gen_current ) )
1141  allocate( dpos_max_foods_hab_safe( steps_gen_current ) )
1142  allocate( dpos_mean_foods_hab_dang( steps_gen_current ) )
1143  allocate( dpos_min_foods_hab_dang( steps_gen_current ) )
1144  allocate( dpos_max_foods_hab_dang( steps_gen_current ) )
1145  allocate( dpos_sd_agents( steps_gen_current ) )
1146  allocate( dpos_sd_foods_hab_safe( steps_gen_current ) )
1147  allocate( dpos_sd_foods_hab_dang( steps_gen_current ) )
1148  !> Some of these arrays are integer counts.
1149  allocate( n_agents_alive( steps_gen_current ) )
1150  allocate( n_agents_eaten( steps_gen_current ) )
1151  allocate( n_foods_available_safe( steps_gen_current ) )
1152  allocate( n_foods_available_dang( steps_gen_current ) )
1153 
1154  !> ... and they also initialised to commondata::missing value
1155  !! (integer arrays to commondata::unknown).
1156  dpos_mean_agents = missing
1157  dpos_min_agents = missing
1158  dpos_max_agents = missing
1159  dpos_mean_foods_hab_safe = missing
1160  dpos_min_foods_hab_safe = missing
1161  dpos_max_foods_hab_safe = missing
1162  dpos_mean_foods_hab_dang = missing
1163  dpos_min_foods_hab_dang = missing
1164  dpos_max_foods_hab_dang = missing
1165  dpos_sd_agents = missing
1166  dpos_sd_foods_hab_safe = missing
1167  dpos_sd_foods_hab_dang = missing
1168  n_agents_alive = unknown
1169  n_agents_eaten = unknown
1170  n_foods_available_safe = unknown
1171  n_foods_available_dang = unknown
1172 
1173  !> Start the main life cycle loop `LIFECYCLE_PREEVOL_LOOP` over all the
1174  !! time steps (limited by the adaptive algorithm).
1175  lifecycle_preevol_loop: do time_step = 1, steps_gen_current
1176 
1177  !> Reset/update the global commondata::global_time_step_model_current.
1178  global_time_step_model_current = time_step
1179 
1180  if (is_debug) call log_delimiter(log_level_chapter)
1181  call log_msg( ltag_stage // "Time step: " // &
1182  tostr(global_time_step_model_current) // &
1183  " of Generation " // &
1184  tostr(global_generation_number_current) // &
1185  " (max: " // tostr(steps_gen_current) &
1186  // ")." )
1187 
1188  !> #### Prepare the environment ####
1189  !> Perform the sinusoidal vertical migration of the food items,
1190  !! they are relocating to the depth appropriate for specific
1191  !! time step of the model. Food migration is done here with the
1192  !! the_environment::migrate_food_vertical() directly on the global
1193  !! array of habitats the_environment::global_habitats_available to
1194  !! avoid the need to synchronise the array with the habitat objects.
1195  call migrate_food_vertical( global_habitats_available )
1196 
1197  !> The average distance between the food items is reported to the log.
1198  !! The average distance between the food items is good to know, e.g. to
1199  !! compare it with the agent's random walk step size.
1200  call log_dbg("Average distance between food items in the " // &
1201  habitat_dangerous%habitat_name // " habitat: "// &
1202  tostr(habitat_dangerous%food%distance_average(100)))
1203  call log_dbg("Average distance between food items in the " // &
1204  habitat_safe%habitat_name // " habitat: "// &
1205  tostr(habitat_safe%food%distance_average(100)))
1206 
1207  !> #### Habitat-specific mortality ####
1208  !> Agents are subjected to random habitat-specific mortality by
1209  !! calling the_population::population::mortality_habitat().
1210  !! @warning Mortality is so far disabled.
1211  !call active_population%mortality_habitat()
1212 
1213  !> #### Agents do a single time step of life ####
1214  !> Perform a single step of the life cycle of the whole population of
1215  !! agents. The agents do this step of their life cycle in a random
1216  !! (or non-random) order.
1217  !! See the_population::population::lifecycle_step() for details.
1218  call active_population%lifecycle_step()
1219  ! Eat only lifecycle step, for debugging and testing.
1220  !call active_population%lifecycle_eatonly()
1221 
1222  !> Immediately after the time step is done, time step-wise statistics
1223  !! are calculated.
1224  where ( active_population%individual%is_alive() )
1225  temp_val_select_alive = active_population%individual%dpos()
1226  elsewhere
1227  temp_val_select_alive = missing
1228  end where
1229  dpos_mean_agents(time_step) = average( temp_val_select_alive )
1230  dpos_min_agents(time_step) = minval( temp_val_select_alive, &
1231  temp_val_select_alive/=missing )
1232  dpos_max_agents(time_step) = maxval( temp_val_select_alive, &
1233  temp_val_select_alive/=missing )
1234  dpos_sd_agents(time_step) = std_dev( temp_val_select_alive )
1235  n_agents_alive(time_step) = count( &
1236  active_population%individual%is_alive() )
1237  n_agents_eaten(time_step) = global_ind_n_eaten_by_predators
1238 
1239  !> The habitat and food resource data are disassembled back into the
1240  !! original static habitat objects out of the global array
1241  !! the_environment::global_habitats_available. This transfers the
1242  !! changes in the food resources (e.g. the agents consume the food)
1243  !! from the global array back to the original static habitat objects.
1244  !! See the_environment::disassemble() procedure.
1245  call disassemble( habitat_safe, habitat_dangerous )
1246 
1247  !> Now, the time-step-wise habitat statistics can be computed for the
1248  !! current time step.
1249  ! @note: Intel Fortran BUG ::food_item::is_available() accessor
1250  ! function is not used here because it results in crashes
1251  ! with ifort 19 when build in non-debug mode (O3 etc).
1252  where ( habitat_safe%food%food%eaten .eqv. .false. )
1253  temp_val_select_avail_safe = habitat_safe%food%food%depth
1254  elsewhere
1255  temp_val_select_avail_safe = missing
1256  end where
1257  call do_sanitise(temp_val_select_avail_safe,tnote=procname//"[food_d]")
1258  dpos_mean_foods_hab_safe(time_step)=average(temp_val_select_avail_safe)
1259  dpos_min_foods_hab_safe(time_step)=minval(temp_val_select_avail_safe, &
1260  temp_val_select_avail_safe/=missing)
1261  dpos_max_foods_hab_safe(time_step)=maxval(temp_val_select_avail_safe, &
1262  temp_val_select_avail_safe/=missing)
1263  dpos_sd_foods_hab_safe(time_step)=std_dev(temp_val_select_avail_safe)
1264  n_foods_available_safe(time_step)=count( &
1265  habitat_safe%food%food%eaten .eqv. .false. )
1266 
1267  where ( habitat_dangerous%food%food%is_available() )
1268  temp_val_select_avail_dang = habitat_dangerous%food%food%depth
1269  elsewhere
1270  temp_val_select_avail_dang = missing
1271  end where
1272  call do_sanitise(temp_val_select_avail_dang, tnote=procname//"[depth]")
1273  dpos_mean_foods_hab_dang(time_step)=average(temp_val_select_avail_dang)
1274  dpos_min_foods_hab_dang(time_step)=minval(temp_val_select_avail_dang, &
1275  temp_val_select_avail_dang/=missing)
1276  dpos_max_foods_hab_dang(time_step)=maxval(temp_val_select_avail_dang, &
1277  temp_val_select_avail_dang/=missing)
1278  dpos_sd_foods_hab_dang(time_step)=std_dev(temp_val_select_avail_dang)
1279  n_foods_available_dang(time_step)=count( &
1280  habitat_dangerous%food%food%is_available())
1281 
1282  !> #### Maximum rescale motivation updated ####
1283  !> The population-wise maximum motivation parameter
1284  !! commondata::global_rescale_maximum_motivation is updated based on
1285  !! the global maximum value.
1286  global_rescale_maximum_motivation = &
1287  maxval( active_population%individual%motivations%max_perception() )
1288 
1289  !> #### The agents are subjected to predation ####
1290  !> It is implemented by cycling over all predators within the safe
1291  !! and dangerous habitat and calling the
1292  !! the_population::population::attacked() method for each predator.
1293  !> - Safe habitat: `PREDATION_HAB_SAFE` block;
1294  if (lifecycle_predation_disabled_debug .eqv. .false.) then
1295  predation_hab_safe: do i = 1, habitat_safe%predators_number
1296  call active_population%attacked( habitat_safe%predators(i) )
1297  end do predation_hab_safe
1298  !> - Dangerous habitat: `PREDATION_HAB_DANGER` block.
1299  !! .
1300  predation_hab_danger: do i = 1, habitat_dangerous%predators_number
1301  call active_population%attacked( habitat_dangerous%predators(i) )
1302  end do predation_hab_danger
1303  end if
1304 
1305  ! > Recalculate fitness in the debug mode: Fitness of all agents in the
1306  ! ! population is recalculated at each step of the life cycle.
1307  if (is_debug) then
1308  call active_population%fitness_calc()
1309  ! > The minimum fitness is reported to the logger for each time step
1310  ! ! in the debug mode.
1311  call log_dbg( ltag_info // "Best fitness is " // &
1312  tostr(minval(active_population%individual%fitness)), &
1313  procname, modname )
1314  call log_dbg( ltag_info // "Global maximum motivation: " // &
1315  tostr(global_rescale_maximum_motivation), &
1316  procname, modname )
1317  end if
1318 
1319  !> #### Save all agent data ####
1320  !! All agents data are saved to CSV file using
1321  !! the_population::population::save_csv() method.
1322  !! However, this is done only if the parameter
1323  !! commondata::enable_save_agents_each_timestep is set to TRUE.
1324  !! This is implemented in the `SAVE_ALL_AGENTS`block.
1325  save_all_agents: if ( enable_save_agents_each_timestep ) then
1326  filename_alldata_time_steps = "xyz_all_"// model_name // "_" // &
1327  mmdd // "_rev_" // svn_version // &
1328  "_gen_" // tostr(global_generation_number_current, &
1329  generations) // "_step_" // &
1330  tostr(time_step, steps_gen_current) // csv
1331  call active_population%save_csv( filename_alldata_time_steps )
1332  !> Additionally, the previous and the latest behaviour of the agent
1333  !! is also saved for each time step.
1334  filename_alldata_time_steps = "xyz_behav_"// model_name // "_" // &
1335  mmdd // "_rev_" // svn_version // &
1336  "_gen_" // tostr(global_generation_number_current, &
1337  generations) // "_step_" // &
1338  tostr(time_step, steps_gen_current) // csv
1339 
1340  call csv_matrix_write ( &
1341  reshape( [ active_population%individual%genome_label, &! 1
1342  active_population%individual%history_behave( &
1343  history_size_behaviours ) ], &! 2
1344  [ size(active_population%individual), 2 ] ), &
1345  filename_alldata_time_steps, &
1346  [ character(len=LABEL_LENGTH) :: &
1347  "PERS_NAME", &! 12
1348  "BEHAV_" // TOSTR(time_step, steps_gen_current) ] )
1349  !> If commondata::is_zip_outputs is TRUE, CSV output data file is
1350  !! compressed using commondata::cmd_zip_output.
1351  if ( is_zip_outputs ) then
1352  call call_external( command=cmd_zip_output // " " // &
1353  filename_alldata_time_steps, &
1354  suppress_output=.true., &
1355  is_background_task=zip_outputs_background )
1356  end if
1357  end if save_all_agents
1358 
1359  end do lifecycle_preevol_loop
1360 
1361  !> #### Save time-step-wise data ####
1362  !> After the life cycle loop is completed, time-step-wise statistics are
1363  !! saved into CSV data file for the current generation.
1364  filename_time_steps="timesteps_" // model_name // "_" // mmdd // &
1365  "_rev_" // svn_version // &
1366  "_gen_" // tostr(global_generation_number_current, &
1367  generations) // csv
1368 
1369  call csv_matrix_write ( &
1370  reshape( [ dpos_mean_agents, & ! 1
1371  dpos_min_agents, & ! 2
1372  dpos_max_agents, & ! 3
1373  dpos_sd_agents, & ! 4
1374  real(n_agents_alive,SRP), & ! 5
1375  real(n_agents_eaten,SRP), & ! 6
1376  dpos_mean_foods_hab_safe, & ! 7
1377  dpos_min_foods_hab_safe, & ! 8
1378  dpos_max_foods_hab_safe, & ! 9
1379  dpos_sd_foods_hab_safe, & ! 10
1380  real(n_foods_available_safe,SRP), & ! 11
1381  dpos_mean_foods_hab_dang, & ! 12
1382  dpos_min_foods_hab_dang, & ! 13
1383  dpos_max_foods_hab_dang, & ! 14
1384  dpos_sd_foods_hab_dang, & ! 15
1385  real(n_foods_available_dang,SRP) ], & ! 16
1386  [ steps_gen_current, 16 ] ), &
1387  filename_time_steps, &
1388  [ "DEP_AGENTS_MEAN", & ! 1
1389  "DEP_AGENTS_MIN ", & ! 2
1390  "DEP_AGENTS_MAX ", & ! 3
1391  "DEP_AGENTS_SD ", & ! 4
1392  "AGENTS_ALIVE ", & ! 5
1393  "N_EATEN_PRED ", & ! 6
1394  "DEP_F_MEAN_SAFE", & ! 7
1395  "DEP_F_MIN_SAFE ", & ! 8
1396  "DEP_F_MAX_SAFE ", & ! 9
1397  "DEP_F_SD_SAFE ", & ! 10
1398  "FOOD_AVAIL_SAFE", & ! 11
1399  "DEP_F_MEAN_DANG", & ! 12
1400  "DEP_F_MIN_DANG ", & ! 13
1401  "DEP_F_MAX_DANG ", & ! 14
1402  "DEP_F_SD_DANG ", & ! 15
1403  "FOOD_AVAIL_DANG" ] ) ! 16
1404 
1405  !> The CSV output data file can be optionally compressed with the
1406  !! commondata::cmd_zip_output command if commondata::is_zip_outputs is set
1407  !! to TRUE.
1408  if ( is_zip_outputs ) then
1409  call call_external(command=cmd_zip_output//" "//filename_time_steps, &
1410  suppress_output=.true., &
1411  is_background_task=zip_outputs_background )
1412  end if
1413 
1414  end subroutine lifecycle_preevol
1415 
1416  !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1417  !> Save generation-wise statistics. This procedure only writes a single
1418  !! record of data after each generation. Opening the file, definition of
1419  !! the file handling objects that are used here etc. are done in the
1420  !! upstream procedure the_evolution::generations_loop_ga().
1421  !! @warning This subroutine neither opens nor closes the output CSV file,
1422  !! only writes a single record of statistical data from the
1423  !! current generation commondata::global_generation_number_current
1424  !! into it.
1426 
1427  ! PROCNAME is the procedure name for logging and debugging (with MODNAME).
1428  character(len=*), parameter :: &
1429  PROCNAME = "(generation_stats_record_write)"
1430 
1431  integer :: i
1432  real(SRP), dimension(proto_parents%population_size) :: perc_food
1433  real(SRP), dimension(proto_parents%population_size) :: perc_f_dist
1434  real(SRP), dimension(proto_parents%population_size) :: perc_consp
1435  real(SRP), dimension(proto_parents%population_size) :: perc_pred
1436 
1437  ! - Arrays to calculate means for alive agents
1438  real(SRP), dimension(proto_parents%population_size) :: body_mass_l
1439  real(SRP), dimension(proto_parents%population_size) :: body_leng_l
1440  real(SRP), dimension(proto_parents%population_size) :: energy_l
1441  real(SRP), dimension(proto_parents%population_size) :: stomach_l
1442  real(SRP), dimension(proto_parents%population_size) :: smr_l
1443  real(SRP), dimension(proto_parents%population_size) :: control_l
1444  real(SRP), dimension(proto_parents%population_size) :: reprfac_l
1445  real(SRP), dimension(proto_parents%population_size) :: p_repr_l
1446  integer, dimension(proto_parents%population_size) :: foods_try_l
1447  integer, dimension(proto_parents%population_size) :: foods_eaten_l
1448  real(SRP), dimension(proto_parents%population_size) :: fmass_eaten_l
1449  integer, dimension(proto_parents%population_size) :: fitness_l
1450 
1451  !> ### Implementation notes ###
1452  !! First, initialise an empty record for CSV data.
1453  file_stats_gener_record = repeat(" ", file_stats_record_len )
1454 
1455  !> Then calculate and append each of the statistical data fields to
1456  !! build the complete record of the CSV output file. Note that the
1457  !! fields must agree with the columns defined by the
1458  !! `FILE_STATS_GENER_COLS` parameter array.
1459  !! - "GENERATION" -- generation number;
1460  call csv_record_append( file_stats_gener_record, & ! 1
1461  global_generation_number_current )
1462  !> - "PREEVOL_STEPS" -- lifespan, number of time steps;
1463  call csv_record_append( file_stats_gener_record, & ! 2
1464  preevol_steps_adaptive(global_generation_number_current) )
1465  !> - "MUTAT_POINT" -- adaptive rate of point mutations;
1466  call csv_record_append( file_stats_gener_record, & ! 3
1467  proto_parents%ga_mutat_adaptive(mutationrate_point, &
1468  ga_mutationrate_point_max))
1469  !> - "MUTAT_BATCH" -- adaptive rate of batch mutations;
1470  call csv_record_append( file_stats_gener_record, & ! 4
1471  proto_parents%ga_mutat_adaptive(mutationrate_batch, &
1472  ga_mutationrate_batch_max))
1473  !> - "ELITE_GROUP" -- the number of reproducing agents;
1474  call csv_record_append( file_stats_gener_record, & ! 5
1475  proto_parents%ga_reproduce_max() )
1476  !> - "N_ALIVE" -- number of agents alive at the end;
1477  call csv_record_append( file_stats_gener_record, & ! 6
1478  count( proto_parents%individual%is_alive() ) )
1479  !> - "N_GROWN" -- number of agents that had grown;
1480  call csv_record_append( file_stats_gener_record, & ! 7
1481  count( proto_parents%individual%get_mass() > &
1482  proto_parents%individual%get_mass_birth() ) )
1483  !> - "N_MALES_L" -- number of males alive;
1484  call csv_record_append( file_stats_gener_record, & ! 8
1485  count( proto_parents%individual%is_male() .and. &
1486  proto_parents%individual%is_alive() ) )
1487  !> - "N_FEMALES_L" number of females alive;
1488  call csv_record_append( file_stats_gener_record, & ! 9
1489  count( proto_parents%individual%is_female() .and. &
1490  proto_parents%individual%is_alive() ) )
1491  !> - "N_EATEN_PRED" number of agents that are eaten by predators;
1492  call csv_record_append( file_stats_gener_record, & ! 10
1493  global_ind_n_eaten_by_predators )
1494  !> - "BODY_MASS" -- average body mass;
1495  call csv_record_append( file_stats_gener_record, & ! 11
1496  average(proto_parents%individual%body_mass, &
1497  missing, .false.) )
1498  !> - "BODY_LEN" -- average body length;
1499  call csv_record_append( file_stats_gener_record, & ! 12
1500  average(proto_parents%individual%body_length, &
1501  missing, .false.) )
1502  !> - "BIRTH_MASS" -- body mass at birth;
1503  call csv_record_append( file_stats_gener_record, & ! 13
1504  average(proto_parents%individual%body_mass_birth, &
1505  missing, .false.) )
1506  !> - "BIRTH_LENGTH" -- body length at birth;
1507  call csv_record_append( file_stats_gener_record, & ! 14
1508  average(proto_parents%individual%body_length_birth, &
1509  missing, .false.) )
1510  !> - "BIRTH_ENERGY" -- energy reserves at birth;
1511  call csv_record_append( file_stats_gener_record, & ! 15
1512  average(proto_parents%individual%energy_birth, &
1513  missing, .false.) )
1514  !> - "ENERGY" -- energy reserve;
1515  call csv_record_append( file_stats_gener_record, & ! 16
1516  average(proto_parents%individual%energy_current, &
1517  missing, .false.) )
1518  !> - "STOMACH" -- stomach contents, mass;
1519  call csv_record_append( file_stats_gener_record, & ! 17
1520  average(proto_parents%individual%stomach_content_mass, &
1521  missing, .false.) )
1522  !> - "SMR" -- average SMR;
1523  call csv_record_append( file_stats_gener_record, & ! 18
1524  average(proto_parents%individual%smr, &
1525  missing, .false.) )
1526  !> - "CTRL_RND" -- average control trait;
1527  call csv_record_append( file_stats_gener_record, & ! 19
1528  average(proto_parents%individual%control_unselected, &
1529  missing, .false.) )
1530  !> - "REPRFACT" -- average reproductive factor;
1531  !call CSV_RECORD_APPEND( file_stats_gener_record, & ! 20
1532  ! average(proto_parents%individual%reproductive_factor(), &
1533  ! MISSING, .FALSE.) )
1534  ! FUCK_IFORT_WA1 block is a workaround for Intel Fortran 19 compiler bug.
1535  ! Here reproductive_factor() function object is not accessible when
1536  ! build is done by ifort with optimization O3 and -parallel options,
1537  ! which results in segmentation crashing of the program. Funny enough,
1538  ! the `print *,` instruction like this:
1539  ! `print *, "R", proto_parents%individual%reproductive_factor()`
1540  ! works and shows the actual data. But the same instruction in average
1541  ! or even plain assignment:
1542  ! `repefact_fi = proto_parents%individual%reproductive_factor()`
1543  ! crashes the program. Nothing bad occurs in GNU gfortran.
1544  fuck_ifort_wa1: block
1545  real(SRP), dimension(proto_parents%population_size) :: repefact_fi
1546  !repefact_fi = proto_parents%individual%reproductive_factor()
1547  where ( proto_parents%individual%sex_is_male )
1548  repefact_fi = proto_parents%individual%testosterone_level
1549  elsewhere
1550  repefact_fi = proto_parents%individual%estrogen_level
1551  end where
1552  call do_sanitise(repefact_fi, tnote=procname//"[repfact]")
1553  call csv_record_append( file_stats_gener_record, & ! 20
1554  average( repefact_fi, missing, .false.) )
1555  end block fuck_ifort_wa1
1556  !> - "P_REPR" -- probability of reproduction;
1557  call csv_record_append( file_stats_gener_record, & ! 21
1558  average( [( proto_parents%individual(i)%probability_reproduction(), &
1559  i=1, proto_parents%population_size )] ) )
1560  !> - "N_REPROD" -- total nuber or reproductions;
1561  call csv_record_append( file_stats_gener_record, & ! 22
1562  average(proto_parents%individual%n_reproductions, &
1563  unknown, .false.) )
1564  !> - "N_OFFSPRING" -- number of offspring;
1565  call csv_record_append( file_stats_gener_record, & ! 23
1566  average(proto_parents%individual%n_offspring , &
1567  unknown, .false.) )
1568  !> - "GOS_AROUSAL" -- GOS arousal;
1569  call csv_record_append( file_stats_gener_record, & ! 24
1570  average(proto_parents%individual%gos_arousal, &
1571  missing, .false.) )
1572  !> - "FOODS_TRY" -- average number of attempts to catch food items;
1573  call csv_record_append( file_stats_gener_record, & ! 25
1574  average(proto_parents%individual%n_eats_all_indicator, &
1575  unknown, .false.) )
1576  !> - "FOODS_EATEN" -- average number of food items eaten;
1577  call csv_record_append( file_stats_gener_record, & ! 26
1578  average(proto_parents%individual%n_eaten_indicator, &
1579  unknown, .false.) )
1580  !> - "FMASS_EATEN" -- average number of food items eaten;
1581  call csv_record_append( file_stats_gener_record, & ! 27
1582  average(proto_parents%individual%mass_eaten_indicator, &
1583  missing, .false.) )
1584  !> - "PERC_FOOD" -- food perception, average;
1585  call csv_record_append( file_stats_gener_record, & ! 28
1586  average(proto_parents%individual%memory_stack%get_food_mean_n(), &
1587  missing, .false.) )
1588  !> - "PERC_CONS" -- conspecific perception, average;
1589  call csv_record_append( file_stats_gener_record, & ! 29
1590  average(proto_parents%individual%memory_stack%get_consp_mean_n(), &
1591  missing, .false.) )
1592  !> - "PERC_PRED" -- predator perception, average;
1593  call csv_record_append( file_stats_gener_record, & !30
1594  average(proto_parents%individual%memory_stack%get_pred_mean(), &
1595  missing, .false.) )
1596  !> - "DEPTH" -- location depth at the end,
1597  call csv_record_append( file_stats_gener_record, & ! 31
1598  average(proto_parents%individual%depth, missing, .false.) )
1599  !> - "N_SAFE_HABITAT" -- number of agents in the "safe" habitat;
1600  call csv_record_append( file_stats_gener_record, & ! 32
1601  count( proto_parents%individual%is_within( habitat_safe ) ) )
1602  !> - "N_DANG_HABITAT" -- number of agents in the "dangerous" habitat.
1603  call csv_record_append( file_stats_gener_record, & ! 33
1604  count(proto_parents%individual%is_within( habitat_dangerous )))
1605  !> - Calculate perception averages in the safe habitat:
1606  perc_food = missing; perc_consp = missing; perc_pred = missing
1607  ! - `IN_SAFE` block calculates statistics arrays in the safe
1608  ! habitat.
1609  in_safe: where( proto_parents%individual%is_within( habitat_safe ) )
1610  perc_food = proto_parents%individual%memory_stack%get_food_mean_n()
1611  perc_f_dist = proto_parents%individual%memory_stack% &
1612  get_food_mean_dist(undef_ret_null=.false.)
1613  perc_consp = proto_parents%individual%memory_stack%get_consp_mean_n()
1614  perc_pred = proto_parents%individual%memory_stack%get_pred_mean()
1615  end where in_safe
1616  call do_sanitise( perc_f_dist, tnote=procname//"[food_perc_safe]" )
1617  !> - "PERC_FOOD_SAFE" -- food perception in "safe" habitat;
1618  call csv_record_append( file_stats_gener_record, & ! 34
1619  average(perc_food, missing, .false.) )
1620  !> - "PRC_FDIST_SAFE" -- food perception in "safe" habitat;
1621  call csv_record_append( file_stats_gener_record, & ! 35
1622  average(perc_f_dist, missing, .false.) )
1623  !> - "PERC_CONS_SAFE" -- conspecific perception in "dangerous" habitat;
1624  call csv_record_append( file_stats_gener_record, & ! 36
1625  average(perc_consp, missing, .false.) )
1626  !> - "PERC_PRED_SAFE" -- predator perception in "safe" habitat;
1627  !! .
1628  call csv_record_append( file_stats_gener_record, & ! 37
1629  average(perc_pred, missing, .false.) )
1630  !> - Calculate perception averages in the dangerous habitat:
1631  perc_food = missing; perc_consp = missing; perc_pred = missing
1632  ! - `IN_DANG` block calculates statistics arrays in the dangerous
1633  ! habitat.
1634  in_dang: where( proto_parents%individual%is_within( habitat_dangerous ) )
1635  perc_food = proto_parents%individual%memory_stack%get_food_mean_n()
1636  perc_f_dist = proto_parents%individual%memory_stack% &
1637  get_food_mean_dist(undef_ret_null=.false.)
1638  perc_consp = proto_parents%individual%memory_stack%get_consp_mean_n()
1639  perc_pred = proto_parents%individual%memory_stack%get_pred_mean()
1640  end where in_dang
1641  call do_sanitise( perc_f_dist, tnote=procname//"[food_perc_dang]" )
1642  !> - "PERC_FOOD_DANG" -- food perception in "dangerous" habitat;
1643  call csv_record_append( file_stats_gener_record, & ! 38
1644  average(perc_food, missing, .false.) )
1645  !> - "PRC_FDIST_DANG" -- food perception in "dangerous" habitat;
1646  call csv_record_append( file_stats_gener_record, & ! 39
1647  average(perc_f_dist, missing, .false.) )
1648  !> - "PERC_CONS_DANG" -- conspecific perception in "dangerous" habitat;
1649  call csv_record_append( file_stats_gener_record, & ! 40
1650  average(perc_consp, missing, .false.) )
1651  !> - "PERC_PRED_DANG" -- predator perception in "dangerous" habitat;
1652  !! .
1653  call csv_record_append( file_stats_gener_record, & ! 41
1654  average(perc_pred, missing, .false.) )
1655  !> - "FDIST_SAFE" -- average distance between food items in the
1656  !! safe habitat;
1657  call csv_record_append( file_stats_gener_record, & ! 42
1658  habitat_safe%food%distance_average(100) )
1659  !> - "FDIST_DANGER" - average distance between food items in the
1660  !! dangerous habitat;
1661  call csv_record_append( file_stats_gener_record, & ! 43
1662  habitat_dangerous%food%distance_average(100) )
1663  !> - "FITNESS_MIN" -- minimum fitness value.
1664  call csv_record_append( file_stats_gener_record, & ! 44
1665  minval(proto_parents%individual%fitness) )
1666  !> - "FITNESS_MEAN" -- average fitness.
1667  call csv_record_append( file_stats_gener_record, & ! 45
1668  average(proto_parents%individual%fitness, unknown, .false.) )
1669  !> - "N_FOODS_SAFE" -- number of food items available in "safe" habitat;
1670  call csv_record_append( file_stats_gener_record, & ! 46
1671  count( habitat_safe%food%food%eaten .eqv. .false. ) )
1672  !> - "N_FOODS_DANG" -- number of food items available in "dangerous"
1673  !! habitat.
1674  !! .
1675  call csv_record_append( file_stats_gener_record, & ! 47
1676  count( habitat_dangerous%food%food%eaten .eqv. .false. ) )
1677 
1678  !> The following characteristics are calculated for **alive** agents.
1679  body_mass_l = missing
1680  body_leng_l = missing
1681  energy_l = missing
1682  stomach_l = missing
1683  smr_l = missing
1684  control_l = missing
1685  reprfac_l = missing
1686  p_repr_l = missing
1687  foods_try_l = unknown
1688  foods_eaten_l = unknown
1689  fmass_eaten_l = missing
1690  fitness_l = unknown
1691 
1692  !> Here the `ALIVE` block implements sorting out the individuals that are
1693  !! the_genome:individual_genome::is_alive().
1694  alive: where( proto_parents%individual%is_alive() )
1695  body_mass_l = proto_parents%individual%body_mass
1696  body_leng_l = proto_parents%individual%body_length
1697  energy_l = proto_parents%individual%energy_current
1698  smr_l = proto_parents%individual%smr
1699  control_l = proto_parents%individual%control_unselected
1700  ! reprfac_l and p_repr_l calculated separately
1701  foods_try_l = proto_parents%individual%n_eats_all_indicator
1702  foods_eaten_l = proto_parents%individual%n_eaten_indicator
1703  fmass_eaten_l = proto_parents%individual%mass_eaten_indicator
1704  fitness_l = proto_parents%individual%fitness
1705  end where alive
1706 
1707  alive_males: where( proto_parents%individual%is_alive() .and. &
1708  proto_parents%individual%is_male() )
1709  reprfac_l = proto_parents%individual%testosterone_level
1710  end where alive_males
1711 
1712  alive_females: where( proto_parents%individual%is_alive() .and. &
1713  proto_parents%individual%is_female() )
1714  reprfac_l = proto_parents%individual%estrogen_level
1715  end where alive_females
1716 
1717  ! Probability of reproduction is computed in explicit loop because
1718  ! it is not elemental function.
1719  do i = 1, proto_parents%population_size
1720  if ( proto_parents%individual(i)%is_alive() ) then
1721  p_repr_l = proto_parents%individual(i)%probability_reproduction()
1722  else
1723  p_repr_l = missing
1724  end if
1725  end do
1726 
1727  !> - "BODY_MASS_L" -- average body mass of alive agents;
1728  call csv_record_append( file_stats_gener_record, & ! 48
1729  average(body_mass_l, missing, .false.) )
1730  !> - "BODY_LENGTH_L" -- average body length of alive agents;
1731  call csv_record_append( file_stats_gener_record, & ! 49
1732  average(body_leng_l, missing, .false.) )
1733  !> - "ENERGY_L" -- average energy reserves of alive agents;
1734  call csv_record_append( file_stats_gener_record, & ! 50
1735  average(energy_l, missing, .false.) )
1736  !> - "SMR_L" -- average SMR of alive agents;
1737  call csv_record_append( file_stats_gener_record, & ! 51
1738  average(smr_l, missing, .false.) )
1739  !> - "CONTROL_L" -- control trait of alive agents;
1740  call csv_record_append( file_stats_gener_record, & ! 52
1741  average(control_l, missing, .false.) )
1742  !> - "REPRFACT_L" -- reproductive factor of alive agents;
1743  call csv_record_append( file_stats_gener_record, & ! 53
1744  average(reprfac_l, missing, .false.) )
1745  !> - "P_REPROD_L" -- probability of reproduction of alive agents;
1746  call csv_record_append( file_stats_gener_record, & ! 54
1747  average(p_repr_l, missing, .false.) )
1748  !> - "FOODS_TRY_L" -- average rate of attempts to catch food items by
1749  !! alive agents;
1750  call csv_record_append( file_stats_gener_record, & ! 55
1751  average( foods_try_l, unknown, .false.) )
1752  !> - "FOODS_EATEN_L" -- average rate of successful food captures;
1753  call csv_record_append( file_stats_gener_record, & ! 56
1754  average( foods_eaten_l, unknown, .false.) )
1755  !> - "FMASS_EATEN_L" -- average rate of successful food captures;
1756  call csv_record_append( file_stats_gener_record, & ! 57
1757  average( fmass_eaten_l, missing, .false.) )
1758  !> - "N_SAFE_HAB_L" -- number of alive agents in "safe" habitats;
1759  call csv_record_append( file_stats_gener_record, & ! 58
1760  count( proto_parents%individual%is_alive() .and. &
1761  proto_parents%individual%is_within( habitat_safe ) ) )
1762  !> - "N_DANG_HAB_L" -- number of alive agents in "dangerous" habitat;
1763  call csv_record_append( file_stats_gener_record, & ! 59
1764  count( proto_parents%individual%is_alive() .and. &
1765  proto_parents%individual%is_within( habitat_dangerous )))
1766  !> - "FITNESS_MEAN_L" -- mean fitness of alive agents.
1767  !! .
1768  call csv_record_append( file_stats_gener_record, & ! 60
1769  average(fitness_l, unknown, .false.) )
1770 
1771  !> Once the record is fully built, it is written to the file using the
1772  !! `CSV_RECORD_WRITE` procedure (see `CSV_IO`).
1773  call csv_record_write( file_stats_gener_record, csv_file_generstats )
1774 
1775  end subroutine generation_stats_record_write
1776 
1777  end subroutine generations_loop_ga
1778 
1779 end module the_evolution
Calculate an average of an array excluding missing code values.
Definition: m_common.f90:5491
Force a value within the range set by the vmin and vmax dummy parameter values.
Definition: m_common.f90:5350
Interface to the procedure to assemble the global array of habitat objects the_environment::global_ha...
Definition: m_env.f90:797
subroutine lifecycle_preevol(active_population)
This subroutine implements the full life cycle in a whole population of agents. It is built around th...
Definition: m_evolut.f90:1054
subroutine generation_stats_record_write()
Save generation-wise statistics. This procedure only writes a single record of data after each genera...
Definition: m_evolut.f90:1426
COMMONDATA – definitions of global constants and procedures.
Definition: m_common.f90:1497
integer, parameter, public preevol_tsteps
Number of time steps in the agent's life at the pre-evolution stage.
Definition: m_common.f90:2069
character(len= *), parameter, private modname
MODNAME always refers to the name of the current module for use by the LOGGER function LOG_DBG....
Definition: m_common.f90:1591
integer, public global_generation_number_current
The current global generation number. This is a global non fixed-parameter variable that is updated i...
Definition: m_common.f90:2063
character(len= *), parameter, public model_name
Model name for tags, file names etc. Must be very short. See Model descriptors.
Definition: m_common.f90:1938
subroutine debug_histogram_save(x_data, delete_csv, csv_out_file, enable_non_debug)
Produce a debug plot of histogram using an external program hthist from HEDTOOLS tools.
Definition: m_common.f90:7967
integer, parameter, public srp
Definition of the standard real type precision (SRP).
Definition: m_common.f90:1551
integer, parameter, public unknown
Numerical code for invalid or missing integer counts.
Definition: m_common.f90:1704
integer, parameter, public generations
Maximum number of generations in GA.
Definition: m_common.f90:2058
character(len= *), parameter, public ltag_major
Tag prefixes for the logger system. The log may use tags for some common information pieces,...
Definition: m_common.f90:1819
character(len= *), parameter, public ltag_crit
Definition: m_common.f90:1824
subroutine debug_scatterplot_save(x_data, y_data, delete_csv, csv_out_file, enable_non_debug)
Produce a debug plot of 2-d scatterplot using an external program htscatter from HEDTOOLS tools.
Definition: m_common.f90:8097
character(len= *), parameter stop_file
The name of the stop file. The stop file is checked before each new generation of the Genetic Algorit...
Definition: m_common.f90:1777
integer, parameter, public label_length
The length of standard character string labels. We use labels for various objects,...
Definition: m_common.f90:1736
integer, parameter, public food_abundance_habitat_danger
The food abundance in the dangerous habitat.
Definition: m_common.f90:2318
integer, parameter, public ga_reproduce_n
Upper limit on the number of reproducing individuals in the fixed-fitness pre-evolution phase.
Definition: m_common.f90:5189
real(srp), parameter, public other_risks_habitat_safe
Habitat-specific mortality risk (not linked with predation) in the safe habitat.
Definition: m_common.f90:2328
integer, parameter, public predators_num_habitat_safe
The number of predators in the safe habitat.
Definition: m_common.f90:2309
real(srp), dimension(3), parameter, public habitat_danger_min_coord
Definition: m_common.f90:2301
real(srp), parameter, public other_risks_habitat_danger
Habitat-specific mortality risk (not linked with predation) in the dangerous habitat.
Definition: m_common.f90:2332
integer, parameter, public popsize
Maximum population size.
Definition: m_common.f90:2055
subroutine log_dbg(message_string, procname, modname)
LOG_DBG: debug message to the log. The message goes to the logger only when running in the DEBUG mode...
Definition: m_common.f90:9171
real(srp), parameter, public ga_mutationrate_batch_max
Maximum batch mutation rate in the adaptive Fixed Fitness Genetic Algorithm.
Definition: m_common.f90:2607
real(srp), dimension(3), parameter, public habitat_safe_max_coord
Definition: m_common.f90:2297
integer, parameter, public food_abundance_habitat_safe
The food abundance in the safe habitat.
Definition: m_common.f90:2315
real(srp), parameter, public mutationrate_point
Mutation rate for point allele mutations.
Definition: m_common.f90:2595
logical, parameter, public true
Safety parameter avoid errors in logical values, so we can now refer to standard Fortran ....
Definition: m_common.f90:1632
subroutine system_halt(is_error, message, ignore_lockfile)
Halt execution of the system with a specific message and exit code. The exit code is normally passed ...
Definition: m_common.f90:8868
real(srp), public global_rescale_maximum_motivation
Global maximum sensory information that is updated for the whole population of agents.
Definition: m_common.f90:4888
character(len=:), allocatable, public, protected mmdd
MMDD tag, year, month and day, used in file names and outputs. The value of the tag should be obtaine...
Definition: m_common.f90:2052
character(len= *), parameter, public error_allocation_fail
Error message **"Cannot allocate array or object"** is issued if an array or an object is checked and...
Definition: m_common.f90:1855
integer, parameter, public dielcycles
Number of days and nights in a lifespan, DIELCYCLES=500.
Definition: m_common.f90:2260
integer, parameter, public lifespan
Number of time steps in the agent's maximum life length.
Definition: m_common.f90:2066
real(srp), parameter, public mutationrate_batch
Mutation rate for point allele mutations, a whole batch of allele components.
Definition: m_common.f90:2603
real(srp) function std_dev(array_in, missing_code, undef_ret_null)
Calculate standard deviation using trivial formula:
Definition: m_common.f90:6089
logical, public, protected is_plotting
This parameter controls if the debug plots are produced. They can be huge number that takes lots of s...
Definition: m_common.f90:1992
real(srp), dimension(3), parameter, public habitat_safe_min_coord
Definition of the habitat spatial limits.
Definition: m_common.f90:2295
real(srp), dimension(3), parameter, public habitat_danger_max_coord
Definition: m_common.f90:2303
logical, parameter, public preevol_tsteps_force_debug_enabled
This parameter enables the forced smaller fixed number of time steps set by the commondata::preevol_t...
Definition: m_common.f90:2085
character(len=:), allocatable, public, protected svn_version
Subversion or Mercurial revision number that is parsed by commondata::parse_svn_version()....
Definition: m_common.f90:1627
character(len= *), parameter, private procname
PROCNAME is the procedure name for logging and debugging (with commondata::modname).
Definition: m_common.f90:1605
integer, parameter, public preevol_tsteps_force_debug
Number of time steps in the agent's life at the fixed fitness pre-evolution stage....
Definition: m_common.f90:2079
real(srp), parameter, public ga_mutationrate_point_max
Maximum point mutation rate in the adaptive Fixed Fitness Genetic Algorithm.
Definition: m_common.f90:2599
character(len= *), parameter, public csv
Standard data file extension for data output is now .csv.
Definition: m_common.f90:1713
integer, parameter, public predators_num_habitat_danger
The number of predators in the dangerous habitat.
Definition: m_common.f90:2312
character(len= *), parameter, public ltag_timer
Definition: m_common.f90:1825
logical, parameter, public false
Definition: m_common.f90:1632
character(len= *), parameter, public ltag_stage
Definition: m_common.f90:1820
character(len= *), parameter, public ltag_info
Definition: m_common.f90:1821
Definition of high level file objects.
Definition: m_fileio.f90:110
Definition of environmental objects.
Definition: m_env.f90:19
type(habitat), dimension(:), allocatable, public global_habitats_available
A list (array) of all the the_environment::habitat objects available to the agents....
Definition: m_env.f90:680
subroutine save_dynamics(maxdepth, csv_file_name, is_success)
Save diagnostics data that shows the dynamics of the light and the average depth of the food items,...
Definition: m_env.f90:4461
Implementation of the genetic algorithm.
Definition: m_evolut.f90:14
subroutine, public generations_loop_ga()
This procedure implements the main Genetic Algorithm for evolving the agents.
Definition: m_evolut.f90:446
subroutine mate_reproduce()
Mate, reproduce and mutate.
Definition: m_evolut.f90:365
character(len= *), parameter, private modname
Definition: m_evolut.f90:35
type(population), pointer, public proto_parents
Definition: m_evolut.f90:52
integer function, public preevol_steps_adaptive(generation)
Calculate the adaptive number of time steps for the fixed fitness preevolution stage of the genetic a...
Definition: m_evolut.f90:212
type(timer_cpu), public stopwatch_generation
Definition: m_evolut.f90:40
type(timer_cpu), public stopwatch_op_current
Definition: m_evolut.f90:40
type(habitat), public habitat_dangerous
Definition: m_evolut.f90:45
type(timer_cpu), public stopwatch_global
Model-global stopwatch objects.
Definition: m_evolut.f90:40
subroutine, public preevol_steps_adaptive_save_csv(csv_file_name, is_success)
This is a diagnostic subroutine to save the number of time steps for the adaptive GA.
Definition: m_evolut.f90:290
type(population), target, public generation_two
Definition: m_evolut.f90:51
type(population), target, public generation_one
Here we create instances for two populations which will then serve as parents and offspring....
Definition: m_evolut.f90:50
subroutine selection()
Select reproducing agents, the best commondata::ga_reproduce_pr portion of agents.
Definition: m_evolut.f90:334
subroutine init_environment_objects()
Initialise the environmental objects. Most of the environmental objects, such as the environment,...
Definition: m_evolut.f90:63
type(population), pointer, public proto_offspring
Definition: m_evolut.f90:53
type(habitat), public habitat_safe
We have an environment composed of two habitats, safe and a dangerous.
Definition: m_evolut.f90:45
subroutine generations_swap()
Swap generation pointers between parents and offspring.
Definition: m_evolut.f90:319
Definition the genetic architecture of the agent.
Definition: m_genome.f90:16
An umbrella module that collects all the components of the individual agent.
Definition: m_indiv.f90:16
Definition of the decision making and behavioural the architecture.
Definition: m_neuro.f90:17
Define the population of agents object, its properties and functions.
Definition: m_popul.f90:18
CPU timer container object for debugging and speed/performance control. Arbitrary timers can be insta...
Definition: m_common.f90:1883
Definition of the environment habitat HABITAT object. There can potentially be of several types of ha...
Definition: m_env.f90:555
Definition of a spatial object. Spatial object determines the position of the agent,...
Definition: m_env.f90:50
Definition of the population object.
Definition: m_popul.f90:58