-
Notifications
You must be signed in to change notification settings - Fork 0
/
local_stopping_condition.R
84 lines (79 loc) · 2.66 KB
/
local_stopping_condition.R
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
#' Factory function for a local stopping condition that stops a deme
#' after given number of consecutive metaeopochs without an improvement
#' of the best solution found in that deme.
#'
#' @param max_metaepochs_without_improvement - numeric
#'
#' @return Function that can be used as a local stopping condition for hms.
#'
#' @export
#'
#' @examples
#' local_stopping_condition <- lsc_metaepochs_without_improvement(5)
lsc_metaepochs_without_improvement <- function(max_metaepochs_without_improvement) {
function(deme, previous_metaepoch_snapshots) {
best_fitness_metaepoch <- match(deme@best_fitness, deme@best_fitnesses_per_metaepoch)
metaepoch_count <- length(deme@best_fitnesses_per_metaepoch)
!is_root(deme) & best_fitness_metaepoch <= metaepoch_count - max_metaepochs_without_improvement
}
}
#' Factory function for a local stopping condition that stops a deme
#' after given number of fitness function evaluations has been made
#' in that deme.
#'
#' @param max_evaluations - numeric
#'
#' @return Function that can be used as a local stopping condition for hms.
#'
#' @export
#'
#' @examples
#' local_stopping_condition <- lsc_max_fitness_evaluations(500)
lsc_max_fitness_evaluations <- function(max_evaluations) {
function(deme, previous_metaepoch_snapshots) {
!is_root(deme) & deme@evaluations_count > max_evaluations
}
}
#' Factory function for a local stopping condition that stops a deme
#' after given number of metaepochs have past since last metaepoch during
#' which this deme had an active child.
#'
#' @param metaepochs_limit - number of metaepochs that a deme can be active
#' without any active child
#'
#' @return Function that can be used as a local stopping condition for hms.
#'
#' @export
#'
#' @examples
#' local_stopping_condition <- lsc_metaepochs_without_active_child(3)
lsc_metaepochs_without_active_child <- function(metaepochs_limit) {
function(deme, previous_metaepoch_snapshots) {
has_active_child <- function(snapshot) {
any(mapply(function(d) {
identical(d@parent_id, deme@id) && d@is_active
}, snapshot@demes))
}
!any(mapply(
has_active_child,
utils::tail(previous_metaepoch_snapshots, n = metaepochs_limit)
))
}
}
#' Factory function for a trivial local stopping condition that
#' lets a deme be active forever. It is usually used in the root of
#' a hms tree.
#'
#' @return Function that always returns \code{FALSE}, which can be
#' used as a local stopping condition for hms.
#'
#' @export
#'
#' @examples
#' local_stopping_condition <- lsc_trivial()
lsc_trivial <- function() {
function(deme, previous_metaepoch_snapshots) {
FALSE
}
}
lsc_default <- lsc_metaepochs_without_improvement(6)