-
Notifications
You must be signed in to change notification settings - Fork 0
/
modelparameters.R
99 lines (93 loc) · 2.9 KB
/
modelparameters.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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
#' @title Berekent modelparameters voor opgegeven model
#'
#' @description
#' Functie die de modelparameters berekent op basis van een opgegeven
#' basismodel, lokaal model of afgeleid model. Ze berekent de parameters voor
#' het domeinmodel en ingeval van het basismodel ook voor het Vlaams model, en
#' geeft ook de grenzen van het bruikbaar interval.
#'
#' (Deze functie verwijst naar de interne functies `modelparameters.basis()`,
#' `modelparameters.lokaal()` of `modelparameters.afgeleid()`, afhankelijk van
#' de situatie)
#'
#' @param Basismodel model per boomsoort (basismodel) of model per
#' boomsoort-domeincombinatie (lokaalmodel)
#' @param Data meetgegevens (enkel nodig voor lokaal model)
#' @param Afgeleidmodel voor de berekening van de modelparameters van het
#' afgeleid model moeten zowel het basismodel als het afgeleid model gegeven
#' worden, dus in dit geval wordt hier het afgeleid model meegegeven. Voor de
#' andere modellen mag dit argument niet toegevoegd worden.
#'
#' @return Dataframe met parameters voor domeinmodel (`Ad`, `Bd` en `Cd`) en
#' ingeval van het basismodel de parameters voor Vlaams model (`Avl`, `Bvl` en
#' `Cvl`).
#' Ingeval van een afgeleid model worden de parameters voor het Vlaams model
#' gegeven (`Avl`, `Bvl` en `Cvl`), en een parameter `Ad` die de verschuiving
#' van het Vlaams model naar het afgeleide domeinmodel weergeeft (dus een extra
#' intercept)
#'
#' @export
#'
#' @importFrom assertthat has_name
#' @importFrom dplyr %>% rowwise do inner_join group_by ungroup select
#' distinct
#' @importFrom plyr .
#' @importFrom rlang .data
#'
modelparameters <- function(Basismodel, Data = NULL, Afgeleidmodel = NULL) {
invoercontrole(Basismodel, "basismodel")
if (!is.null(Data)) {
invoercontrole(Data, "fit")
}
if (!is.null(Afgeleidmodel)) {
invoercontrole(Afgeleidmodel, "afgeleidmodel")
}
if (!is.null(Afgeleidmodel)) {
Parameters <- Afgeleidmodel[[1]] %>%
inner_join(
x = Afgeleidmodel[[2]],
by = c("BMS", "DOMEIN_ID")
) %>%
group_by(
.data$BMS,
.data$DOMEIN_ID,
.data$Q5k,
.data$Q95k
) %>%
do(
modelparameters.afgeleid(.$Model[[1]])
) %>%
ungroup() %>%
inner_join(
modelparameters(Basismodel) %>%
select("BMS", "Avl", "Bvl", "Cvl") %>%
distinct(),
by = c("BMS")
)
} else {
if (has_name(Basismodel, "DOMEIN_ID")) {
Parameters <- Basismodel %>%
inner_join(
x = Data,
by = c("BMS", "DOMEIN_ID")
) %>%
group_by(
.data$BMS,
.data$DOMEIN_ID,
.data$Q5k,
.data$Q95k
) %>%
do(
modelparameters.lokaal(.$Model[[1]])
) %>%
ungroup()
} else {
Parameters <- Basismodel %>%
rowwise() %>%
do(
modelparameters.basis(.$Model, .$BMS)
)
}
}
return(Parameters)
}