-
Notifications
You must be signed in to change notification settings - Fork 0
/
hoogteschatting_afgeleid.R
74 lines (70 loc) · 2.43 KB
/
hoogteschatting_afgeleid.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
#' @title Hoogteschatting op basis van opgegeven afgeleid model
#'
#' @description
#' Functie die de gemiddelde hoogte per omtrekklasse schat voor de domeincurves
#' en Vlaamse curves van het opgegeven afgeleid model. De teruggegeven
#' dataframe kan gebruikt worden om grafieken te maken of afwijkende metingen
#' te bestuderen. Opgelet! In tegenstelling tot de meeste functies van dit
#' package werkt deze functie op basis van 1 model en de bijhorende
#' meetgegevens. Zie voorbeeld voor een methode om deze functie te kunnen
#' toepassen op de volledige dataset `Afgeleidmodel`.
#'
#' @param Domeinsoortmodel verschoven Vlaams model voor 1
#' boomsoort-domeincombinatie
#' @param Domeinsoortdata de gegevens die hierbij horen: meetresultaten voor 1
#' boomsoort-domeincombinatie
#'
#' @return dataframe met de meetresultaten en de schattingen van de hoogtes
#' voor het domeinmodel en de Vlaamse model
#'
#' @examples
#' library(dplyr)
#'
#' #Datasets inladen en het basismodel en afgeleid model berekenen
#' Data <- testdataset()
#' Datalijst <- initiatie(Data)
#' Data.basis <- Datalijst[["Basis"]]
#' Basismodel <- fit.basis(Data.basis)
#' Data.afgeleid <- Datalijst[["Afgeleid"]]
#' Afgeleidmodel <- fit.afgeleid(Data.afgeleid, Basismodel)
#'
#' #De hoogteschatting voor een afgeleid model
#' Afgeleidmodel[[1]] %>%
#' inner_join(
#' Afgeleidmodel[[2]],
#' by = c("BMS", "DOMEIN_ID")
#' ) %>%
#' group_by(
#' .data$BMS,
#' .data$DOMEIN_ID
#' ) %>%
#' do(
#' hoogteschatting.afgeleid(.$Model[[1]],
#' select(., -Model))
#' ) %>%
#' ungroup()
#'
#' @export
#'
#' @importFrom dplyr %>% mutate
#' @importFrom plyr .
#' @importFrom rlang .data
#' @importFrom stats predict
#' @importFrom assertthat assert_that
#'
hoogteschatting.afgeleid <- function(Domeinsoortmodel, Domeinsoortdata) {
#controle invoer
assert_that(inherits(Domeinsoortmodel, "lm"),
msg = "Domeinsoortmodel moet een lineair model zijn (zie
documentatie)")
invoercontrole(Domeinsoortdata, "afgeleidedata")
assert_that(length(unique(Domeinsoortdata$BMS)) == 1,
msg = "De dataset Domeinsoortdata mag maar 1 boomsoort bevatten")
assert_that(length(unique(Domeinsoortdata$DOMEIN_ID)) == 1,
msg = "De dataset Domeinsoortdata maar 1 domein bevatten")
Schatting <- Domeinsoortdata %>%
mutate(
H_D_finaal = predict(Domeinsoortmodel, newdata = .)
)
return(Schatting)
}