-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathm_evolut.f90
1687 lines (1516 loc) · 92.7 KB
/
m_evolut.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
!> @file m_evolut.f90
!! THE_EVOLUTION Module implements the Genetic Algorithm for the AHA Model.
!! @author Sergey Budaev <sergey.budaev@uib.no>
!! @author Jarl Giske <jarl.giske@uib.no>
!! @date 2016-2017
!-------------------------------------------------------------------------------
! $Id$
!-------------------------------------------------------------------------------
!> @brief Implementation of the genetic algorithm.
!> @section the_evolution_module THE_EVOLUTION module
!> The Genetic Algorithm is implemented here
module THE_EVOLUTION
use COMMONDATA ! Global definitions of model objects
use THE_GENOME ! This mod defines our individual fish object
use THE_NEUROBIO
use THE_INDIVIDUAL
use THE_POPULATION
use THE_ENVIRONMENT
use BASE_UTILS ! Modelling tools
use BASE_RANDOM
use CSV_IO
use LOGGER
implicit none
private
public generations_loop_ga, & ! Only global GA loop is exposed,
preevol_steps_adaptive, & ! other objects are public for
preevol_steps_adaptive_save_csv ! external tests.
! PROCNAME is the procedure name for logging and debugging
character (len=*), parameter, private :: MODNAME = "(THE_EVOLUTION)"
!> Model-global stopwatch objects.
!! @note Use the keyword `TIMER:` (LTAG_TIMER) for logging, e.g.
!! `call LOG_MSG( LTAG_TIMER // stopwatch_op_current%show() )`
type(TIMER_CPU), public :: stopwatch_global, & !> global stopwatch
stopwatch_generation, & !> generation-wise
stopwatch_op_current !> single operation
!> We have an environment composed of two habitats, safe and a dangerous.
type(HABITAT), public :: habitat_safe, habitat_dangerous
!> Here we create instances for two populations which will then serve as
!! parents and offspring. And then we declare pointers that will point to
!! parents and offspring.
type(POPULATION), public, target :: generation_one ! new populations
type(POPULATION), public, target :: generation_two ! as objects
type(POPULATION), public, pointer :: proto_parents
type(POPULATION), public, pointer :: proto_offspring
contains ! ........ implementation of procedures for this level ................
!-----------------------------------------------------------------------------
!> Initialise the environmental objects. Most of the environmental objects,
!! such as the environment, habitats etc. are kept static throughout the
!! model running. There are, however, patterned and stochastic changes in
!! the environment, such as diurnal variation of the illumination level.
subroutine init_environment_objects()
character(len=*), parameter :: PROCNAME = "(init_environment_objects)"
integer :: i ! counter
!> ### Build the environmental objects ###
!> Build the overall environment "universe". It can be used for the
!! whole-environment placement of objects, e.g. random walks of an agent
!! crossing the borders between the habitats.
call LOG_DBG("Initialisation of the environment and the habitat(s)")
! Start stopwatch for timing the environment init process.
call stopwatch_op_current%start("Initialisation of the environment")
!> Build the habitats.
call habitat_safe%make( &
coord_min=SPATIAL( HABITAT_SAFE_MIN_COORD(1), &
HABITAT_SAFE_MIN_COORD(2), &
HABITAT_SAFE_MIN_COORD(3) ), &
coord_max=SPATIAL( HABITAT_SAFE_MAX_COORD(1), &
HABITAT_SAFE_MAX_COORD(2), &
HABITAT_SAFE_MAX_COORD(3) ), &
label="Safe", &
predators_number=PREDATORS_NUM_HABITAT_SAFE, &
otherrisks=OTHER_RISKS_HABITAT_SAFE, &
food_abundance=FOOD_ABUNDANCE_HABITAT_SAFE )
call habitat_dangerous%make( &
coord_min=SPATIAL( HABITAT_DANGER_MIN_COORD(1), &
HABITAT_DANGER_MIN_COORD(2), &
HABITAT_DANGER_MIN_COORD(3) ), &
coord_max=SPATIAL( HABITAT_DANGER_MAX_COORD(1), &
HABITAT_DANGER_MAX_COORD(2), &
HABITAT_DANGER_MAX_COORD(3) ), &
label="Dangerous", &
predators_number=PREDATORS_NUM_HABITAT_DANGER, &
otherrisks=OTHER_RISKS_HABITAT_DANGER, &
food_abundance=FOOD_ABUNDANCE_HABITAT_DANGER )
call LOG_MSG( LTAG_TIMER // stopwatch_op_current%show() )
!> Define and allocate the global array of all habitats available to the
!! agents. See the_environment::global_habitats_available for details of
!! this global array. This is now made using the the_environment::assemble()
!! procedure.
! It is analogous to such a code:
! @code
! allocate(Global_Habitats_Available(2))
! Global_Habitats_Available = [ habitat_safe, habitat_dangerous ]
! @endcode
call assemble ( habitat_safe, habitat_dangerous )
!> Allocation of the the_environment::global_habitats_available is
!! checked. If it turns out not allocated, a critical error is signalled
!! in the logger and the program calls commondata::system_halt().
if (.not. allocated(Global_Habitats_Available) ) then
call LOG_MSG( LTAG_CRIT // "Global_Habitats_Available array " // &
"cannot be allocated in " // PROCNAME // "!" )
call system_halt(is_error=.TRUE., message=ERROR_ALLOCATION_FAIL)
end if
!> ### Save initial diagnostic data ###
!> Output the number of the habitats in the global array
!! the_environment::global_habitats_available and their labels into
!! the logger.
call LOG_MSG( LTAG_INFO // "Allocated 'Global_Habitats_Available' to " // &
TOSTR(size(Global_Habitats_Available)) // " elements:" )
call LOG_MSG( LTAG_INFO // " " // TOSTR( &
[( Global_Habitats_Available(i)%get_label(), &
i=1, size(Global_Habitats_Available) )] ) )
!> Certain data are also saved. Their names start from the `init_` prefix.
!> - Save initial food data (uniform distribution as built at init). Note
!! that the distribution of the food items can change at each time step
!! due to vertical migration of the food items and their local random
!! Gaussian movements.
call LOG_MSG( LTAG_INFO // &
"Saving initial uniform food resources to CSV files.")
call habitat_safe%food%save_csv( &
csv_file_name = "init_food_safe_habitat" // csv )
call habitat_dangerous%food%save_csv( &
csv_file_name = "init_food_dangerous_habitat" // csv )
!> - Save predators' data.
call LOG_MSG(LTAG_INFO // "Saving predators from habitats into CSV files.")
call habitat_safe%save_predators_csv( &
csv_file_name = "init_predators_safe_habitat" // csv )
call habitat_dangerous%save_predators_csv( &
csv_file_name = "init_predators_dangerous_habitat" // csv )
!> - Save the basic data on the dynamics of illumination, food items and
!! visibility across the life span of the agents.
!! .
call save_dynamics( csv_file_name = "init_dynamics" // csv )
!> #### Save plots ####
!> If the plotting is enabled (see commondata::is_plotting), some plots
!! of the initialisation data are also saved.
DO_PLOT: if (IS_PLOTTING) then
!> - Save debug scatterplots of food items distribution within in
!! the habitats.
call debug_scatterplot_save(x_data=habitat_safe%food%food%x, &
y_data=habitat_safe%food%food%y, &
csv_out_file="debug_plot_food_safe_"// MMDD // "_g" // &
TOSTR(Global_Generation_Number_Current) // csv, &
delete_csv=.FALSE., enable_non_debug=.TRUE. )
call debug_scatterplot_save(x_data=habitat_dangerous%food%food%x, &
y_data=habitat_dangerous%food%food%y, &
csv_out_file="debug_plot_food_danger_" // MMDD // "_g" // &
TOSTR(Global_Generation_Number_Current) // csv, &
delete_csv=.FALSE., enable_non_debug=.TRUE. )
!> - Save debug scatterplots of predators distribution in the habitats.
call debug_scatterplot_save(x_data=habitat_safe%predators%x, &
y_data=habitat_safe%predators%y, &
csv_out_file="debug_plot_predat_safe_" // MMDD // "_g" // &
TOSTR(Global_Generation_Number_Current) // csv, &
delete_csv=.FALSE., enable_non_debug=.TRUE. )
call debug_scatterplot_save(x_data=habitat_dangerous%predators%x, &
y_data=habitat_dangerous%predators%y, &
csv_out_file="debug_plot_predat_danger_" // MMDD // "_g"// &
TOSTR(Global_Generation_Number_Current) // csv, &
delete_csv=.FALSE., enable_non_debug=.TRUE. )
!> - Save histograms of food item sizes.
!! .
call debug_histogram_save(x_data=habitat_safe%food%food%size, &
csv_out_file="debug_hist_food_safe_size_" // MMDD // "_g" //&
TOSTR(Global_Generation_Number_Current) // csv, &
delete_csv=.FALSE., enable_non_debug=.TRUE. )
call debug_histogram_save(x_data=habitat_dangerous%food%food%size, &
csv_out_file="debug_hist_food_dang_size_" // MMDD // "_g" //&
TOSTR(Global_Generation_Number_Current) // csv, &
delete_csv=.FALSE., enable_non_debug=.TRUE. )
end if DO_PLOT
end subroutine init_environment_objects
!-----------------------------------------------------------------------------
!> Calculate the adaptive number of time steps for the fixed fitness
!! preevolution stage of the genetic algorithm.
!!
!! The number of time steps in the fixed-fitness pre-evolution genetic
!! algorithm is calculated using an adaptive algorithm. Briefly, the number
!! of time steps (total lifespan) at the early stages of evolution (the first
!! generations) is very short and increases as the evolution proceeds towards
!! the maximum set by commondata::preevol_tsteps.
!! @note The time steps data generated by this function for each GA
!! generation are saved in CSV file by
!! the_evolution::preevol_steps_adaptive_save_csv().
function preevol_steps_adaptive( generation ) result(steps)
!> @param[in] generation optional current generation number, if not
!! provided, set to commondata::global_generation_number_current.
integer, optional, intent(in) :: generation
!> @return The number of lifecycle time steps at the specific generation.
integer :: steps
! Local copies of optionals
real(SRP) :: generation_number
! The duration of a single diel cycle
integer, parameter :: ONE_CYCLE = LIFESPAN / DIELCYCLES
! The number of diel cycles in the pre-evolution stage.
integer, parameter :: PREEVOL_CYCLES = PREEVOL_TSTEPS / ONE_CYCLE
!> ### Implementation notes ###
!> The number of time steps in this fixed fitness pre-evol adaptive GA
!! algorithm is calculated based on a linear interpolation from a grid
!! defined by the two arrays:
!! - `STEPS_ABSCISSA` -- grid abscissa, from the first generation to
!! the total number of generations commondata::generations.
real(SRP), dimension(*), parameter :: STEPS_ABSCISSA = &
[ real(SRP) :: 1.0_SRP, &
GENERATIONS / 2, &
GENERATIONS * 3 / 4, &
GENERATIONS + 1 ]
!> - `STEPS_ORDINATE` -- grid ordinate, ranging from the number of time
!! steps in one diel cycle to the total number of time steps in the
!! fixed fitness pre-evolution stage commondata::preevol_tsteps.
! `htintrpl.exe [1 50 75 100] [0 0.3 0.6 1] [1] [nonlinear]`
! `htintrpl.exe [1 50 75 101] [0 0.8 0.95 1] [1] [nonlinear]`
! `htintrpl.exe [1 50 75 101] [0.5 0.8 0.95 1] [1] [nonlinear]`
!> .
real(SRP), dimension(*), parameter :: STEPS_ORDINATE = &
[ real(SRP) :: ONE_CYCLE * PREEVOL_CYCLES * 0.30_SRP, &
ONE_CYCLE * PREEVOL_CYCLES * 0.80_SRP, &
ONE_CYCLE * PREEVOL_CYCLES * 0.95_SRP, &
PREEVOL_TSTEPS ]
!> However, for debugging purposes, evolution time steps can be set to a
!! specific fixed value. This value is set by
!! commondata::preevol_tsteps_force_debug integer parameter and for this
!! fixed value to be forced, commondata::preevol_tsteps_force_debug_enabled
!! must be TRUE.
if ( PREEVOL_TSTEPS_FORCE_DEBUG_ENABLED ) then
steps = PREEVOL_TSTEPS_FORCE_DEBUG
return
end if
! Check optional parameter.
if (present(generation)) then
generation_number = real( generation, SRP )
else
generation_number = real( Global_Generation_Number_Current, SRP )
end if
!> Then, the total (adaptive) number of time steps is determined by the
!! integer lower limit (floor) of the linear interpolation DDPINTERPOL()
!! procedure, with further limitation that its result value must be
!! within the range of [*t,T*], where *t* is the length of a single
!! diel cycle, *T* is the number of time steps in the pre-evolution stage.
!!
!! @note Plotting commands:
!! - `htintrpl.exe [1 50 75 101] [0 0.8 0.95 1] [1] [nonlinear]`
!! .
steps = floor( within( DDPINTERPOL( STEPS_ABSCISSA, &
STEPS_ORDINATE, &
generation_number ), &
real( ONE_CYCLE, SRP ), &
real( PREEVOL_TSTEPS, SRP ) ) )
end function preevol_steps_adaptive
!-----------------------------------------------------------------------------
!> This is a diagnostic subroutine to save the number of time steps for the
!! adaptive GA.
subroutine preevol_steps_adaptive_save_csv(csv_file_name, is_success)
!> @param[in] csv_file_name the name of the CSV file to save the arrays.
character(len=*), intent(in) :: csv_file_name
!> @param[out] is_success Flag showing that data save was successful
!! (if TRUE).
logical, optional, intent(out) :: is_success
logical :: csv_file_status
integer, dimension(GENERATIONS) :: generation ! generation
integer, dimension(GENERATIONS) :: time_steps ! n of time steps
integer :: i ! counter
generation = [( i, i=1, GENERATIONS )]
time_steps = [(preevol_steps_adaptive(i), i=1, GENERATIONS)]
call CSV_MATRIX_WRITE ( reshape( [ generation, &
time_steps ], &
[ GENERATIONS, 2 ] ), &
csv_file_name, &
[ "GENERATION","TIME_STEP " ], &
csv_file_status )
if (present(is_success)) is_success = csv_file_status
end subroutine preevol_steps_adaptive_save_csv
!-----------------------------------------------------------------------------
!> Swap generation pointers between parents and offspring.
subroutine generations_swap()
if (associated(proto_parents, target=generation_one)) then
proto_parents => generation_two
proto_offspring => generation_one
else
proto_parents => generation_one
proto_offspring => generation_two
end if
end subroutine generations_swap
!-----------------------------------------------------------------------------
!> Select reproducing agents, the best commondata::ga_reproduce_pr
!! portion of agents.
subroutine selection()
! Local counter
integer :: i
! Number of the best reproducing agents.
integer :: ga_reproduce
!> The best (sorted) parents are copied to the offspring population object.
!! Note that the number of such reproducing parents is determined by the
!! the_population::population::ga_reproduce_max() method.
ga_reproduce = proto_parents%ga_reproduce_max()
!> Old fixed proportion implementation:
!! @code
!! proto_offspring(:GA_REPRODUCE_N) = proto_parents(:GA_REPRODUCE_N)
!! @endcode
proto_offspring%individual(:ga_reproduce) = &
proto_parents%individual(:ga_reproduce)
!> The best parents (elite group) are then re-initialised from the genome
!! for the next generation using the_individual::individual_agent::init()
!! method.
do i=1, ga_reproduce
call proto_offspring%individual(i)%init(exclude_genome=.TRUE.)
end do
end subroutine selection
!-----------------------------------------------------------------------------
!> Mate, reproduce and mutate.
subroutine mate_reproduce()
integer :: i, i1, i2
! PROCNAME is the procedure name for logging and debugging (with MODNAME).
character(len=*), parameter :: PROCNAME = "(mate_reproduce)"
real(SRP) :: adapt_mut_point, adapt_mut_batch
!> Calculate adaptive mutation rate
adapt_mut_point = proto_parents%ga_mutat_adaptive(MUTATIONRATE_POINT, &
GA_MUTATIONRATE_POINT_MAX)
adapt_mut_batch = proto_parents%ga_mutat_adaptive(MUTATIONRATE_BATCH, &
GA_MUTATIONRATE_BATCH_MAX)
call LOG_MSG( LTAG_STAGE // "Mutation rates: " // &
TOSTR(adapt_mut_point) // ", " // TOSTR(adapt_mut_batch) // &
" for population size " // TOSTR(proto_parents%get_size()) )
!> Loop through all the non-elite population members. These individuals
!! are created from the genomes of the elite group. The non-elite
!! individuals are from commondata::ga_reproduce_n+1 to commondata::popsize.
do i = proto_parents%ga_reproduce_max() + 1, POPSIZE
!> - If chromosomes are not allocated, this means it is a new individual.
!! We have to initialise it -- now as random. The same is true for all
!! individuals that the_genome::individual::genome::is_dead().
if ( .not. allocated(proto_offspring%individual(i)%chromosome) ) then
call proto_offspring%individual(i)%init()
!call proto_offspring%individual(i)%sex_init()
call proto_offspring%individual(i)%place_uniform(habitat_safe)
call LOG_DBG( LTAG_INFO // "Initialised individual " // &
TOSTR(i) // " (" // &
TOSTR(proto_offspring%individual(i)%get_id()) // ")", &
PROCNAME, MODNAME )
end if
!> - Two agents are randomly chosen from the population. They become the
!! mother and the father of new `proto_offspring` agents. The mother
!! and the father exchange their genetic material using the
!! the_genome::individual_genome::recombine_random() method. Note that
!! the mother must be the_genome::individual_genome::is_female()
!! and the father, the_genome::individual_genome::is_male().
i1 = RAND_I( 1, GA_REPRODUCE_N * 2 ) ! the **mother** must be female.
do while (proto_parents%individual(i1)%is_male())
i1 = RAND_I( 1, GA_REPRODUCE_N * 2 )
end do
i2 = RAND_I( 1, GA_REPRODUCE_N * 2 ) ! the **father** must be male.
do while (proto_parents%individual(i2)%is_female())
i2 = RAND_I( 1, GA_REPRODUCE_N * 2 )
end do
call proto_offspring%individual(i)%recombine_random( &
mother = proto_parents%individual(i1), &
father = proto_parents%individual(i2) )
!> - Once the genome of the offspring is created from recombination data,
!! the offspring are subjected to random mutation using the
!! the_genome::individual_genome::mutate() backend.
call proto_offspring%individual(i)%mutate( &
p_point = adapt_mut_point, p_set = adapt_mut_batch )
!> - After this, the whole agent is initialised using he constructor
!! the_genome::individual_agent::init(), but without random
!! initialisation of the genome, the latter is based on the
!! recombination data from the parents.
!! .
call proto_offspring%individual(i)%init(exclude_genome=.TRUE.)
end do
!> Finally, loop through the elite group and introduce random mutations
!! there too with the_genome::individual_genome::mutate().
!! @note This is disabled (elitism).
!do i = 1, GA_REPRODUCE_N
! call proto_offspring%individual(i)%mutate()
!end do
end subroutine mate_reproduce
!-----------------------------------------------------------------------------
!> This procedure implements the main **Genetic Algorithm** for evolving the
!! agents.
subroutine generations_loop_ga()
use FILE_IO
! PROCNAME is the procedure name for logging and debugging (with MODNAME).
character(len=*), parameter :: PROCNAME = "(generations_loop_ga)"
!> #### Objects for the GA ####
!> - `energy_mean_gen1_birth_mort` -- average value of the birth energy
!! reserves, for forced selective birth mortality. See
!! the_population::population::mortality_birth().
real(SRP) :: energy_mean_gen1_birth_mort
!> - `energy_sd_gen1_birth_mort` -- standard deviationof the birth energy
!! reserves, for forced selective birth mortality. See
!! the_population::population::mortality_birth().
!! .
real(SRP) :: energy_sd_gen1_birth_mort
!> #### Objects for generation-wise statistics file ####
!> The definitions below are for the objects that are used to write
!! generation-wise statistics in the ::generation_stats_record_write()
!! sub-procedure.
!! - `file_stats_gener`: File handle object for generation-wise statistics.
type(FILE_HANDLE) :: file_stats_gener
!> - `file_stats_gener_record`: Record for the generation-wise statistics
!! file.
character(len=:), allocatable :: file_stats_gener_record
!> - `FILE_STATS_GENER_COLS`: an array of column names for the
!! generation-wise statistics file.
character(len=LABEL_LENGTH), dimension(*), parameter :: &
FILE_STATS_GENER_COLS = [ character(len=LABEL_LENGTH) :: &
"GENERATION", & ! 1
"PREEVOL_STEPS", & ! 2
"MUTAT_POINT", & ! 3
"MUTAT_BATCH", & ! 4
"ELITE_GROUP", & ! 5
"N_ALIVE", & ! 6
"N_GROWN", & ! 7
"N_MALES_L", & ! 8
"N_FEMALES_L", & ! 9
"N_EATEN_PRED", & ! 10
"BODY_MASS", & ! 11
"BODY_LEN", & ! 12
"BIRTH_MASS", & ! 13
"BIRTH_LENGTH", & ! 14
"BIRTH_ENERGY", & ! 15
"ENERGY", & ! 16
"STOMACH", & ! 17
"SMR", & ! 18
"CTRL_RND", & ! 19
"REPRFACT", & ! 20
"P_REPR", & ! 21
"N_REPROD", & ! 22
"N_OFFSPRING", & ! 23
"GOS_AROUSAL", & ! 24
"FOODS_TRY", & ! 25
"FOODS_EATEN", & ! 26
"FMASS_EATEN", & ! 27
"PERC_FOOD", & ! 28
"PERC_CONS", & ! 29
"PERC_PRED", & ! 30
"DEPTH", & ! 31
"N_SAFE_HABITAT", & ! 32
"N_DANG_HABITAT", & ! 33
"PERC_FOOD_SAFE", & ! 34
"PRC_FDIST_SAFE", & ! 35
"PERC_CONS_SAFE", & ! 36
"PERC_PRED_SAFE", & ! 37
"PERC_FOOD_DANG", & ! 38
"PRC_FDIST_DANG", & ! 39
"PERC_CONS_DANG", & ! 40
"PERC_PRED_DANG", & ! 41
"FDIST_SAFE", & ! 42
"FDIST_DANGER", & ! 43
"FITNESS_MIN", & ! 44
"FITNESS_MEAN", & ! 45
"N_FOODS_SAFE", & ! 46
"N_FOODS_DANG", & ! 47
"BODY_MASS_L", & ! 48
"BODY_LENGTH_L", & ! 49
"ENERGY_L", & ! 50
"SMR_L", & ! 51
"CONTROL_L", & ! 52
"REPRFACT_L", & ! 53
"P_REPROD_L", & ! 54
"FOODS_TRY_L", & ! 55
"FOODS_EATEN_L", & ! 56
"FMASS_EATEN_L", & ! 57
"N_SAFE_HAB_L", & ! 58
"N_DANG_HAB_L", & ! 59
"FITNESS_MEAN_L" ] ! 60
!> - `FILE_STATS_RECORD_LEN`: The maximum length of the CSV record assuming
!! the maximum length of a single field is commondata::label_length; the
!! number of fields is equal to the size of the columns array
!! `FILE_STATS_GENER_COLS`.
!! .
integer, parameter :: FILE_STATS_RECORD_LEN = &
size(FILE_STATS_GENER_COLS) * LABEL_LENGTH + &
size(FILE_STATS_GENER_COLS) * 3
!> #### Parameters for the GA stopping rule ####
!> Parameters determining the **stopping rule** for the fixed fitness
!! genetic algorithm. These are based on the values obtained in the first
!! generation. If in any succeeding generation, they fall below the first
!! generation values, evolution is considered unsuccessful and the main GA
!! loop stops.
!> The number of alive agents at the first random generation.
!! - Evolution should stop with unsuccessful status if the number of alive
!! agents falls below this value.
integer :: ga_alive_generation_1
!> The number of agents that have increased their body mass at the first
!! random generation.
!> - Evolution should stop with unsuccessful status if the number of alive
!! agents falls below this value.
!! .
integer :: ga_growing_generation_1
! Total N of alive and N of agents that have grown
integer :: n_alive, n_growing
!> # Preliminary steps #
!> `Global_Generation_Number_Current` is the global generation number.
!! It is first initialised to **1**.
Global_Generation_Number_Current = 1
!> commondata::Global_Rescale_Maximum_Motivation is the global maximum
!! motivation value, it is fixed at the start of the simulation to an
!! arbitrary high value but is automatically updated from the maximum
!! motivation value across all agents after each time step.
Global_Rescale_Maximum_Motivation = 6.0_SRP
!> The stopping rule parameters based on the first generation values are
!! initialised to some values allowing the first generation to occur
!! safely, i.e. with sufficiently large number of randomly created
!! pre-optimal agents.
!! - If the number of alive agents is smaller than this minimum number,
!! GA stops: some parameters must be tweaked.
ga_alive_generation_1 = ceiling( POPSIZE * 0.005_SRP )
!> - The number of agents growing is set to a large negative value
!! commondata::unknown,so initial zero is always larger, so evolution
!! is allowed to start.
!! .
ga_growing_generation_1 = UNKNOWN
call LOG_DBG( LTAG_MAJOR // "GLOBAL STARTUP " // PROCNAME )
! Start global stopwatch
call stopwatch_global%start("Global time whole simulation")
!> ## Initialise the environment ##
!> All environmental objects are initialised with
!! ::init_environment_objects().
call init_environment_objects()
!> ## Initialise base agent population objects ##
!> New populations of agents are now built and initialised:
!! (a) `generation_one`, (b) `generation_two`
!! These population objects serve as targets for two pointer objects:
!! (a) `proto_parents`, (b) `proto_offspring`.
call LOG_MSG("INFO: Initialising generation one objects.")
call stopwatch_op_current%start("Initialising agents: generations 1 and 2")
!> - Initialise the whole `generation_one` of the agents,
!! commondata::popsize is the size of the population.
call generation_one%init(POPSIZE)
!> - Also initialise the `generation_two`, that will then take parents'
!! values.
!! .
call generation_two%init(POPSIZE)
call LOG_MSG( stopwatch_op_current%log())
!> Calculate initial fitness of the agents in the `generation_one` for the
!! pre-evolution phase. At this stage fitness is equal to the maximum
!! value (note that fitness is actually a reverse of fitness) and is not
!! very interesting.
call generation_one%fitness_calc()
!> Place all the agents that have been initialised to random
!! spatial positions in the safe habitat (`habitat_safe`), they
!! have just the uniformly distributed spatial positions at
!! start.
!! @note Note that the initial vertical position and distribution of
!! the agents depends on these parameters:
!! - commondata::init_agents_depth_is_fixed
!! - commondata::init_agents_depth_is_gauss
!! .
!! See the_population::individ_posit_in_environ_uniform() for details.
call generation_one%scatter_uniform(habitat_safe)
call generation_two%scatter_uniform(habitat_safe)
call LOG_MSG(LTAG_INFO // "Initialisation of generation one completed" )
call LOG_DBG("Population with numeric ID " // &
TOSTR(generation_one%get_num_id()) // &
" and name '" // trim(generation_one%get_name()) // &
"' allocated to " // TOSTR(generation_one%get_size()) // &
" objects.", MODNAME, PROCNAME)
!> ## Transfer pointers: parents and offspring populations ##
!> Allocate the first `proto_parents` and `proto_offspring`
!! population objects, they are pointers to `generation_one` and
!! `generation_two` target objects.
proto_parents => generation_one
proto_offspring => generation_two
!> Calculate statistical parameters of the initial generation for
!! selective birth mortality. See
!! the_population::population::mortality_birth().
associate (AGENTS => proto_parents%individual )
energy_mean_gen1_birth_mort = average( AGENTS%get_energ_birth() )
energy_sd_gen1_birth_mort = std_dev( AGENTS%get_energ_birth() )
end associate
!> These values are then logged.
call LOG_MSG(LTAG_STAGE //"Birth mortality values:" )
call LOG_MSG(LTAG_STAGE //" mean: " // TOSTR(energy_mean_gen1_birth_mort))
call LOG_MSG(LTAG_STAGE //" std.dev.:" // TOSTR(energy_sd_gen1_birth_mort))
! Also, a table showing the confidence limits is logged, it is useful
! for assessing possible limit on the birth energy evolution.
call LOG_MSG(LTAG_INFO // "Limits of std.dev. for birth mortality:" )
call LOG_MSG(LTAG_INFO // " [ MEAN, 1 SD, 2 SD, 3 SD]")
! Template for aligned vals: [0.200, 0.409, 0.617, 0.825]
call LOG_MSG(LTAG_INFO // " [" // &
TOSTR(energy_mean_gen1_birth_mort,"(f5.3)") // ", " // &
TOSTR(energy_mean_gen1_birth_mort+ &
energy_sd_gen1_birth_mort*1.0_SRP,"(f5.3)") // ", " // &
TOSTR(energy_mean_gen1_birth_mort+ &
energy_sd_gen1_birth_mort*2.0_SRP,"(f5.3)") // ", " // &
TOSTR(energy_mean_gen1_birth_mort+ &
energy_sd_gen1_birth_mort*3.0_SRP,"(f5.3)") // "]" )
!> ## Save diagnostics data ##
!> Save initialisation data in the debug mode.
call LOG_DBG(LTAG_INFO // "Sizes of populations after init:: " // &
"parents: " // TOSTR(size(proto_parents%individual)) // &
", offspring: " // TOSTR( size(proto_offspring%individual) ) )
!> - Saving histograms of agents' body length.
call debug_histogram_save(x_data=proto_parents%individual%body_length, &
csv_out_file="debug_hist_agent_body_len_birth_"// MMDD // &
"_rev_" // SVN_Version // &
"_g" // TOSTR(Global_Generation_Number_Current) // csv, &
delete_csv=.FALSE., enable_non_debug=.TRUE. )
!> - Saving histograms of agents' body mass.
call debug_histogram_save(x_data=proto_parents%individual%body_mass, &
csv_out_file="debug_hist_agent_body_mass_birth_"// MMDD // &
"_rev_" // SVN_Version // &
"_g" // TOSTR(Global_Generation_Number_Current) // csv, &
delete_csv=.FALSE., enable_non_debug=.TRUE. )
!> - Saving histograms of agents' energy.
call debug_histogram_save(x_data=proto_parents%individual%energy_current, &
csv_out_file="debug_hist_agent_energy_birth_"// MMDD // &
"_rev_" // SVN_Version // &
"_g" // TOSTR(Global_Generation_Number_Current) // csv, &
delete_csv=.FALSE., enable_non_debug=.TRUE. )
!> - Saving histograms of agents' smr.
!! .
call debug_histogram_save(x_data=proto_parents%individual%smr, &
csv_out_file="debug_hist_agent_smr_birth_"// MMDD // &
"_rev_" // SVN_Version // &
"_g" // TOSTR(Global_Generation_Number_Current) // csv, &
delete_csv=.FALSE., enable_non_debug=.TRUE. )
!> **SAVE_DATA_INIT block**: The random initialisation individual data
!! for the whole parent population are saved to csv files:
SAVE_DATA_INIT: block
! A temporary variable to keep the file names at initialising files.
! @note This variable is used only to set the names of the files once,
! the names afterwards are kept internally in the file handle
! objects
character(len=:), allocatable :: output_data_file
!> - Individual agent's data, file `init_agents_`;
output_data_file = "init_agents_" // MODEL_NAME // "_" // MMDD // &
"_rev_" // SVN_Version // &
"_gen_" // TOSTR(Global_Generation_Number_Current, &
GENERATIONS) // csv
call proto_parents%save_csv(output_data_file, is_logging=.TRUE.)
!> - Initial genome data, file `init_genome_`.
output_data_file = "init_genome_" // MODEL_NAME // "_" // MMDD // &
"_rev_" // SVN_Version // &
"_gen_" // TOSTR(Global_Generation_Number_Current, &
GENERATIONS) // csv
call proto_parents%save_genomes_csv(output_data_file)
!> - The number of time steps in the adaptive GA
!! .
output_data_file = "init_tsteps_" // MODEL_NAME // "_" // MMDD // &
"_rev_" // SVN_Version // &
"_gen_" // TOSTR(Global_Generation_Number_Current, &
GENERATIONS) // csv
call preevol_steps_adaptive_save_csv(output_data_file)
!> The generation wise statistics file `generations_` is opened for
!! writing ...
output_data_file="generations_" // MODEL_NAME // "_" // MMDD // &
"_rev_" // SVN_Version // csv
call file_stats_gener%open_write( output_data_file, FORMAT_CSV )
!> ... and the first row of column names `FILE_STATS_GENER_COLS` is
!! written.
!! @note Note that the main body of the statistical data is processed
!! in the sub-procedure ::generation_stats_record_write().
file_stats_gener_record = repeat(" ", FILE_STATS_RECORD_LEN )
call CSV_RECORD_APPEND( file_stats_gener_record, FILE_STATS_GENER_COLS )
call file_stats_gener%record_write( file_stats_gener_record )
end block SAVE_DATA_INIT
!> The average distance between the food items is reported to the log.
!! The average distance between the food items is good to know, e.g. to
!! compare it with the agent's random walk step size.
call LOG_DBG(LTAG_INFO // "Average distance between food items in the " //&
habitat_dangerous%habitat_name // " habitat: "// &
TOSTR(habitat_dangerous%food%distance_average(100)), &
PROCNAME, MODNAME )
call LOG_DBG(LTAG_INFO // "Average distance between food items in the " //&
habitat_safe%habitat_name // " habitat: "// &
TOSTR(habitat_safe%food%distance_average(100)), &
PROCNAME, MODNAME )
!> # Pre-evolution stage #
!> Pre-evolution stage involves the Genetic Algorithm that is based on
!! selection of agents based on an explicit global fitness. It aims to
!! produce a population of agents that can stably sustain for the whole
!! commondata::lifespan
!> ## GENERATIONS_PREEVOL: The main loop of (pre-) evolution ##
!> At this stage the main loop of generations evolving is started.
!! The conditions for **continuing** the main evolution loop are as
!! follows:
GENERATIONS_PREEVOL: do while ( &
!> - Global generation number does not exceed the maximum
!! commondata::generations.
Global_Generation_Number_Current <= GENERATIONS &
.and. &
!> - Average (anti-) fitness still exceeds the target value.
!! .
average(proto_parents%individual%fitness) > 500 )
call LOG_DELIMITER(LOG_LEVEL_VOLUME)
call LOG_MSG( LTAG_STAGE // LTAG_MAJOR // " Starting GENERATION: " // &
TOSTR(Global_Generation_Number_Current) )
call LOG_DELIMITER(LOG_LEVEL_VOLUME)
!> #### Diagnostics ####
!> Stopwatch object for calculating time since generation start is
!! initialised.
call stopwatch_generation%start("Generation "// &
TOSTR(Global_Generation_Number_Current))
!> Initially, place all the agents in the `proto_parents` population
!! randomly uniformly in the safe habitat (`habitat_safe`).
!! However, note that the initial vertical position and distribution of
!! the agents depends on these parameters:
!! - commondata::init_agents_depth_is_fixed
!! - commondata::init_agents_depth_is_gauss
!! .
!! See the_population::individ_posit_in_environ_uniform() method for
!! details.
call proto_parents%scatter_uniform(habitat_safe)
!> Initialise the global generation-wise counter of the number of
!! agents that die as a consequence of predation
!! the_population::global_ind_n_eaten_by_predators, as opposed to
!! starvation.
Global_Ind_N_Eaten_by_Predators = 0
!> If it is **not** the first generation, replenish all food items (i.e.
!! for all habitats), they are restored to the "available" (non-eaten)
!! state. Two methods can be used here:
!! - the_environment::food_resource::make() -- re-initialise food items
!! from scratch.
!! - the_environment::food_resource::replenish() -- reuse food items as
!! initialised in ::init_environment_objects()
!! .
REPLENISH_FOOD: if ( Global_Generation_Number_Current > 1 ) then
call habitat_safe%food%replenish()
call habitat_dangerous%food%replenish()
!> The global habitat array the_environment::global_habitats_available
!! is then updated by the_environment::assemble() procedure.
call assemble( habitat_safe, habitat_dangerous )
end if REPLENISH_FOOD
!> If it is the first generation, it does not make sense doing this as
!! the environment has been already fully initialised in the
!! ::init_environment_objects() procedure.
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!> ### lifecycle_preevol for proto_parents ###
!> Start the loop of the life cycle of all agents of the `proto_parents`.
!! It includes commondata::preevol_tsteps time steps. (Note that
!! commondata::preevol_tsteps is less than commondata::lifespan).
!! This is implemented in the ::lifecycle_preevol() procedure.
call LOG_MSG( LTAG_STAGE // "Life cycle parents." )
call lifecycle_preevol( proto_parents )
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!> Calculate the number of agents alive and agents growing. These values
!! are used later, including as a criterion of GA deterioration.
n_alive = count( proto_parents%individual%is_alive() )
n_growing = count( proto_parents%individual%get_mass() > &
proto_parents%individual%get_mass_birth() )
!> Report these values in the logger.
call LOG_MSG( LTAG_INFO // "N alive: " // TOSTR(n_alive) // &
", N grown: " // TOSTR(n_growing) )
!> After the agents went through their life cycle, their fitness
!! is processed.
!> - Fitness of all `proto_parents` agents is recalculated following
!! their performance in the full lifecycle.
call LOG_MSG( LTAG_STAGE // "Fitness calculate in parents." )
call proto_parents%fitness_calc()
!> - The agents `proto_parents` are sorted by fitness.
call LOG_MSG( LTAG_STAGE // "Sort parents by fitness." )
call proto_parents%sort_by_fitness()
! Output the best parent to logger.
call LOG_MSG( LTAG_INFO // "Best parent (1), fitness: " // &
TOSTR(proto_parents%individual(1)%fitness) )
!> If this is the first generation, determine the GA deterioration
!! stopping parameters, evolution "failure"
PARAMS_GEN_1: if (Global_Generation_Number_Current == 1) then
ga_alive_generation_1 = n_alive
ga_growing_generation_1 = n_growing
!> These Generation one parameters are also reported to the logger.
call LOG_MSG( LTAG_INFO // "This is the first generation" )
call LOG_MSG( LTAG_INFO // "Survival parameters that determine " // &
"the stopping rule: N Alive=" // &
TOSTR(ga_alive_generation_1) // &
", N Growing=" // &
TOSTR(ga_growing_generation_1) )
end if PARAMS_GEN_1
!> - **SAVE_DATA_INDS_GENERATION block**: The individual statistical
!! data for the whole `proto_parents` population are saved using the
!! the_population::population class bound `save_` methods:
SAVE_DATA_INDS_GENERATION: block
character(len=:), allocatable :: output_data_file
call LOG_MSG( LTAG_STAGE // "Saving parents." )
!> - Individual agent's data, file `agents_`
output_data_file = "agents_" // MODEL_NAME // "_" // MMDD // &
"_rev_" // SVN_Version // &
"_gen_" // TOSTR(Global_Generation_Number_Current,&
GENERATIONS) // "_p1_parents" // csv
call proto_parents%save_csv(output_data_file, is_logging=.TRUE.)
!> - The genome data, file `genome_`
output_data_file = "genomes_" // MODEL_NAME // "_" // MMDD // &
"_rev_" // SVN_Version // &
"_gen_" // TOSTR(Global_Generation_Number_Current,&
GENERATIONS) // csv
call proto_parents%save_genomes_csv(output_data_file)
!> - Memory stacks data, file `memory_`.
output_data_file = "memory_" // MODEL_NAME // "_" // MMDD // &
"_rev_" // SVN_Version // &
"_gen_" // TOSTR(Global_Generation_Number_Current,&
GENERATIONS) // csv
call proto_parents%save_memory_csv(output_data_file)
!> - Movement history data, file `movements_`.
output_data_file = "movements_" // MODEL_NAME // "_" // MMDD // &
"_rev_" // SVN_Version // &
"_gen_" // TOSTR(Global_Generation_Number_Current,&
GENERATIONS) // csv
call proto_parents%save_movements_csv(output_data_file)
!> - Behaviour history data, file `behaviours_`.
output_data_file = "behaviours_" // MODEL_NAME // "_" // MMDD // &
"_rev_" // SVN_Version // &
"_gen_" // TOSTR(Global_Generation_Number_Current,&
GENERATIONS) // csv
call proto_parents%save_behaviour_csv(output_data_file)
end block SAVE_DATA_INDS_GENERATION
!> - **SAVE_DATA_FOOD_POST**: The food resources data for all the
!! habitats are saved using the
!! the_environment::food_resource::save_csv() method.
SAVE_DATA_FOOD_POST: block
character(len=:), allocatable :: output_data_file
call LOG_MSG( LTAG_STAGE // "Saving food resources." )
output_data_file = "food_habitat_safe_gen_" // &
MODEL_NAME // "_" // MMDD // &
"_rev_" // SVN_Version // &
"_gen_" // TOSTR(Global_Generation_Number_Current,&
GENERATIONS) // csv
call habitat_safe%food%save_csv( output_data_file )
output_data_file = "food_habitat_dang_gen_" // &
MODEL_NAME // "_" // MMDD // &
"_rev_" // SVN_Version // &
"_gen_" // TOSTR(Global_Generation_Number_Current,&
GENERATIONS) // csv
call habitat_dangerous%food%save_csv( output_data_file )
end block SAVE_DATA_FOOD_POST
!> - Generation-wise statistics are calculated and saved in the CSV
!! file. This is implemented in the ::generation_stats_record_write()
!! subprocedure.
call generation_stats_record_write()
!> - Check if the unsuccessful evolution criterion is met. If yes,
!! terminate the GA.
!> - The number of agents that are alive exceeds that in the
!! first generation: there must be improvement (at least in
!! debug).
!> - The number of agents that have grown exceeds that in the
!! first generation.
!! .
!! .
CHECK_DETERIORATE: if ( Global_Generation_Number_Current > 1 ) then
if ( n_alive < ga_alive_generation_1 / 10 .or. &
n_growing < ga_growing_generation_1 / 10 ) then
call LOG_MSG( LTAG_MAJOR // "GA deterioration detected! " // &
"N alive=" // TOSTR(n_alive) // &
" (<" // TOSTR(ga_alive_generation_1) // &
"); N grown=" // TOSTR(n_growing) // &
" (<" // TOSTR(ga_growing_generation_1) // ")." )
call LOG_MSG( LTAG_CRIT // &
"Exiting GA due to deterioration in CHECK_DETERIORATE.")
exit GENERATIONS_PREEVOL
end if
!> - If this is the first generation, terminate GA if the number of
!! agents alive < 1/100 of the commpndata::popsize or if no agents are
!! growing.
!! .
else CHECK_DETERIORATE
if ( n_alive < POPSIZE / 100 ) then
call LOG_MSG( LTAG_CRIT // "Insufficient number of alive agents: " &
// TOSTR(n_alive) )
call system_halt(message="INSUFFICIENT ALIVE AGENTS IN GEN. 1")
elseif ( n_growing < 1 ) then
call LOG_MSG( LTAG_WARN // "LESS THAN ONE AGENT GROWN IN GEN. 1" )
! call system_halt(message="LESS THAN ONE AGENT GROWN IN GEN. 1")
end if
end if CHECK_DETERIORATE
!> ### Selection ###
!> Select reproducing minority: the_evolution::selection()
call LOG_MSG( LTAG_STAGE // "Selection (elitism)." )
call selection()
!> ### Exchange of the genetic material ###
!> A minority of the best parents produces the proto_offspring population
!! object: the_evolution::mate_reproduce().
call LOG_MSG( LTAG_STAGE // "Mate and reproduce." )
call mate_reproduce()
!> Reset individual IDs of proto_offspring
call proto_offspring%reset_id()
!> ### Finalise the generation cycle: swap pointers ###
!> Swap populations: `proto_offspring` are now `proto_parents`:
!! the_evolution::generations_swap().
call LOG_MSG( LTAG_STAGE // "Swap generations." )
call generations_swap()
! Log generation timing
call LOG_DELIMITER(LOG_LEVEL_VOLUME)
call LOG_MSG ( LTAG_MAJOR // stopwatch_generation%show() )
call LOG_DELIMITER(LOG_LEVEL_VOLUME)
!> ### End of the generations loop ###