\tableofcontents \listoftables \listoffigures
\clearpage
knitr::opts_chunk$set(echo = FALSE, message=FALSE, warning=FALSE, collapse = TRUE, comment = "#>") library(novaInventories) library(knitr) library(magrittr) library(tidyverse) library(VGAM) library(scales) library(kableExtra) load("~/Anglo/System/RDAs/indicators.Rda") source('~/novaInventories/R/tibble.indicator.R') load("~/Anglo/System/RDAs/CHS.Rda") load("../data/wood_prepped.Rda") saveplotvar <- FALSE
Population estimates for each town is shown in Table \ref{tab:pop}. The uncertainty in the estimate is modelled by a uniform distribution ranging from the best estimate minus 10% to the best estimate plus 10%.
kable(N_HHS2020 %>% mutate(distribution = map_chr(N_HHS2020, ~.@dist), min = map_dbl(N_HHS2020, ~.@params[[1]]), max = map_dbl(N_HHS2020, ~.@params[[2]]), site = Hmisc::capitalize(site), town = Hmisc::capitalize(town) ) %>% dplyr::select(-N_HHS2020) , booktabs = TRUE, align = "c", caption = "\\label{tab:pop}Population estimates per town" )
Figure \ref{fig:tabpropdist} shows the distributions used to model the proportion of households in each town who use wood. The normal distribution was chosen because the binomial distribution can be modelled by the normal distribution if the sample size is large.
```r"} PERC_HHS_WOOD_SUMMR_CHS2020 %>% mutate(distribution = map_chr(PERC, ~.@dist), mean = map_dbl(PERC, ~.@params[[1]]), sd = map_dbl(PERC, ~.@params[[2]]) ) %>% dplyr::select(-PERC) %>% kable(digits = 5, booktabs = TRUE, align = "c", caption = "\label{tab:tabpropdist} Parameters for the estimation of the proportion of wood users per town")
## Estimate of the number if wood users per town The number of wood users per town can be calculated as the product of the proportion of households who use wood and the total number of households in the population. The proportion of households who indicated that they use wood in the sample is used as estimator for the population proportion of households who use wood. ```r Estimated number of wood users per town", fig.width=16, out.width="100%"} dfWoodUsers <- N_HHS2020 %>% left_join(PERC_HHS_WOOD_SUMMR_CHS2020) %>% mutate(ll = pmap(., ~list(N = ..3, p = ..4)), res = map2(ll, town, ~monticarleer(..1, "N_HHS2020 * PERC_HHS_WOOD_SUMMR_CHS2020", tbl_out = FALSE, plot = FALSE, saveplot = saveplotvar, fn = paste0("../man/figures/WoodUsers", ..2, ".pdf")))) %>% unnest(res)
mr = dfWoodUsers %>% select(town, res) %>% unnest(res) %>% group_by(town) %>% pivot_longer(values_to = "Value", names_to = "Variable", cols = c(N_HHS2020, PERC_HHS_WOOD_SUMMR_CHS2020, Result)) ggplot2::ggplot(data = mr, aes(x = Value, group = Variable, fill = Variable, alpha = I(1/3))) + geom_histogram(aes(y = ..density..), bins = 50) + geom_density(aes(y = ..density.., fill = NULL)) + facet_wrap(town~Variable, scales = "free", ncol = 3) + theme_bw() + theme(legend.position = "bottom") + ggtitle(label = "Calculation of number of users")
The result
specs <- map(dfWoodUsers$res, ~maak_distlist( nm = "N_Whh", dist = "unif", params = fitdistrplus::fitdist(.$Result, "unif")$estimate %>% round()) )
dfWoodUsers %<>% dplyr::select(-res, -ll, -N_HHS2020, -PERC) dfWoodUsers$N <- specs
The result of the estimation of the number of households. Table \ref{tab:popminmax}
kable(dfWoodUsers %>% mutate(distribution = map_chr(N, ~.@dist), min = map_dbl(N, ~.@params[[1]]), max = map_dbl(N, ~.@params[[2]]) ) %>% dplyr::select(-N), booktabs = TRUE, align = "c", caption = "\\label{tab:popminmax} Estimated number of wood users per town") %>% kableExtra::kable_styling(latex_options = c("HOLD_position"))
sef_log_tab <- indicators$mortimer$sefikile_p2$PERC_FIRES_PPURPOSE_PCOMM_SUMMR_FLB2020@val mf_log_tab <- indicators$waterval$mfidikoe_sp$PERC_FIRES_PPURPOSE_PCOMM_SUMMR_FLB2020@val
Fire logs were keps by 20 households each in Sefikile and Mfidikwe. A total of r sum(sef_log_tab$n)
fires were logged in Sefikile and r sum(mf_log_tab$n)
in Mfidikwe.
A breakdown of the reasons for making fire is shown in Figure \ref{fig:logpurposet} for Sefikile and Mfidikwe. Cooking and heating water for bathing seems to be more or less equally important.
```r", out.width="100%", fig.width=12} p1 <- indicators$mortimer$sefikile_p2$PERC_FIRES_PPURPOSE_PCOMM_SUMMR_FLB2020@plots[[2]] p2 <- indicators$waterval$mfidikoe_sp$PERC_FIRES_PPURPOSE_PCOMM_SUMMR_FLB2020@plots[[2]] gridExtra::grid.arrange(p1, p2, ncol = 2)
## Timing of fires Figure \ref{fig:diurnal} shows the number of fires logged per hour of the day. In Sefikile, the period with the mose fires are 06:00 and 07:00 in the morning. The number of fires decline after 07:00 (with small sub-peaks at 11:00 and 14:00) to each a day-time low at 15:00. Starting from 15:00 the number of fires increase to reach a afternoon peak at 17:00 that rapidly decline to 0 at 22:00. In Mfidikwe, the highest number of fires occur in the morning around 08:00. The early morning peak starts slowly between 04:00 and 04:00 and then increases rapidly around 06:00 to finally peak at 08:00. A smaller peak occurs around mid-day and a somewhat larger peak occurs at 16:00. The afternoon peak already starts at 14:00. By 20:00, new fire activity stops. ```r dfTimeFrameM <- expand_grid(site = c("mortimer"), town = c("ga_ramosidi_sp_sefikile_p1", "sefikile_p2", "northam_ext_5_ext_7", "mantserre_sp"), response = 0:23) dfTimeFrameW <- expand_grid(site = c("waterval"), town = c("bokamoso_sp", "mfidikoe_sp", "waterkloof_sp"), response = 0:23) dfTimeFrame <- bind_rows(dfTimeFrameM, dfTimeFrameW) %>% group_by(site, town)
```r", out.width="100%", fig.width=8} ggplot(data = dfplot, aes(x = hod, y = perc_fires, group = (id), fill = id)) + geom_col() + facet_wrap(~town, nrow = 1) + theme(legend.position = "none")
# Estimate of wood consumption from Comprehensive Household Survey ## Summer results The comprehensive household survey contains questions of wood use in summer and winter. Respondents were asked if they used wood at all. Those who did use wood were asked in what format they buy their wood and how made units of each format they use in atypical winter and summer month. Estimated weights for each format was then used to calculate monthly wood consumption in each season. Figure \ref{tab:CHSSUMM} shows the results of this estimation per summer month. ```r"} KG_WOOD_PWOODHH_PMONTH_SUMMR_CHS2020 %>% unnest(val) %>% dplyr::select(-name, -description) %>% dplyr::select(site, town, everything()) %>% kable(booktabs = TRUE, align = "c", caption = "\\label{tab:CHSSUMM} Monthly wood use per summer month from CHS" ) %>% kableExtra::kable_styling(latex_options = c("HOLD_position", "scale_down"))
KG_WOOD_PWOODHH_PMONTH_SUMMR_CHS2020 %<>% unnest(val) %>% mutate(KG_WOOD_PWOODHH_PMONTH_SUMMR_CHS2020 = map(Mean, ~maak_distlist( nm = "KG_WOOD_PWOODHH_PMONTH_SUMMR_CHS2020", dist = "zipois" , params = c(lambda = ., pstr0 = 0.1) ))) %>% dplyr::select(site, town, KG_WOOD_PWOODHH_PMONTH_SUMMR_CHS2020)
The mass of wood consumed by a wood using household per summer month is modelled by a zero-inflated poison distribution. The parameters were given in Table \ref{tab:kgwoodchssummer}.
```r"} kable(KG_WOOD_PWOODHH_PMONTH_SUMMR_CHS2020 %>% mutate(distribution = map_chr(KG_WOOD_PWOODHH_PMONTH_SUMMR_CHS2020, ~.@dist), lamdba = map_dbl(KG_WOOD_PWOODHH_PMONTH_SUMMR_CHS2020, ~.@params[[1]]), p = map_dbl(KG_WOOD_PWOODHH_PMONTH_SUMMR_CHS2020, ~.@params[[2]]) ) %>% dplyr::select(-KG_WOOD_PWOODHH_PMONTH_SUMMR_CHS2020), booktabs = TRUE, align = "c", caption = "\label{tab:kgwoodchssummer}Mass of wood consumed by a wood using household per summer month is modelled by a zero-inflated poison distribution") %>% kableExtra::kable_styling(latex_options = c("HOLD_position"))
The inputs and results of an estimation of the monthly wood consumption per town using Monte Carlo simulation is show in Figure \ref{fig:summerchs} with details of the results in Table \ref{tab:tabsummerchs}. ```r", fig.width=16, out.width="100%"} dfSummerCHS <- dfWoodUsers %>% left_join(KG_WOOD_PWOODHH_PMONTH_SUMMR_CHS2020 ) %>% mutate(ll = pmap(., ~list(N = ..3, KG = ..4)), res = map2(ll, town, ~monticarleer(..1, "N_Whh * KG_WOOD_PWOODHH_PMONTH_SUMMR_CHS2020", tbl_out = FALSE, plot = FALSE, saveplot = saveplotvar, fn = paste0("../man/figures/Wood_Summer_Month_CHS_", ..2, ".pdf")) ) ) %>% unnest(res)%>% mutate(ss = map(res, ~broom::tidy(summary(.$Result))))
```r"} dfSummerCHS %>% dplyr::select(site, town, ss) %>% unnest(ss) %>% group_by(site, town) %>% kable(digit = 0, caption = "\label{tab:tabsummerchs}Estimated Wood consumption per town per summer month", booktabs = TRUE, align = "c") %>% kableExtra::kable_styling(latex_options = c("HOLD_position", "scale_down"))
```r Comparison of wood consumption per town per summer month", out.width="80%", fig.width=12} ggplot(data = dfSummerCHS %>% dplyr::select(site, town, res) %>% unnest(res) %>% arrange(site), aes(x = town, y = Result,fill = site)) + geom_boxplot() + facet_wrap(site~., scales = "free_x") + theme(legend.position = "none") + theme(axis.text.x = element_text(angle = 35)) + scale_y_continuous(labels = scales::comma)
\clearpage
The mass of wood per fire made as calculated from the wood weighing survey is given in Table \ref{tab:masswoodfire}. The mean wood use per fire in Sefikile was calculated at r KG_WOOD_PWOODHH_PFIRE_SUMMR_M1_WWS2020$Mean[[1]]
kg and at r KG_WOOD_PWOODHH_PFIRE_SUMMR_M1_WWS2020$Mean[[2]]
kg for Mfidikwe.
```r"} kable(KG_WOOD_PWOODHH_PFIRE_SUMMR_M1_WWS2020 %>% dplyr::select(-name, -description) %>% dplyr::select(site, town, everything()) , booktabs = TRUE, align = "c", caption = "\label{tab:masswoodfire}") %>% kableExtra::kable_styling(latex_options = c("HOLD_position", "scale_down"))
The distribution of the mass of wood per fire is modelled as a Gamma Distribution. The parameters used is shown in Table \ref{tab:masswooddistparams}. ```r KG_WOOD_PWOODHH_PFIRE_SUMMR_M1_WWS2020 %<>% mutate(KG = purrr::map2(Mean, `Std. Dev`, ~maak_distlist( nm = "KG_WOOD_PWOODHH_PFIRE_SUMMR_M1_WWS2020", dist = "gamma", params = deriveGammaParams(Mean = ..1, Sd = ..2)))) %>% dplyr::select(site, town, KG)
```r Distribution parameters for mass of wood used per day"} kable(KG_WOOD_PWOODHH_PFIRE_SUMMR_M1_WWS2020 %>% mutate(distribution = map_chr(KG, ~.@dist), shape = map_dbl(KG, ~.@params[[1]]), scale = map_dbl(KG, ~.@params[[2]]) ) %>% dplyr::select(-KG), booktabs = TRUE, align = "c", caption = "\label{tab:masswooddistparams} Distribution parameters for mass of wood used per day") %>% kableExtra::kable_styling(latex_options = c("HOLD_position"))
## Number of fires made per month The number of fires made ```r kable(N_FIRES_PWOODHH_PMONTH_SUMMR_FLB20201 %>% dplyr::select(-name, -description) %>% dplyr::select(site, town, everything()) , booktabs = TRUE, align = "c", caption = "\\label{tab:fpd1}Number of fires per day" ) %>% kableExtra::kable_styling(latex_options = c("HOLD_position", "scale_down"))
The number of fires is modelled by a poison distribution since a count in modelled and the mean and standard deviation is of more or less equal magnitude. The parameters used are shown in Table \ref{fig:fpd}. We used the median as estimate for the first moment.
N_FIRES_PWOODHH_PMONTH_SUMMR_FLB2020 %>% mutate(distribution = map(N_fpd, ~.@dist), lambda = map_dbl(N_fpd, ~.@params[[1]]) ) %>% dplyr::select(-N_fpd) %>% kable(digits = 4 , booktabs = TRUE, align = "c",caption = "\\label{tab:fpd} Count of fire per month modelled by a poison distribution") %>% kableExtra::kable_styling(latex_options = c("HOLD_position"))
dfSummerWWS <- dfWoodUsers %>% left_join(KG_WOOD_PWOODHH_PFIRE_SUMMR_M1_WWS2020) %>% left_join(N_FIRES_PWOODHH_PMONTH_SUMMR_FLB2020) %>% filter(town == "Sefikile_p2" | town == "Mfidikoe_sp") %>% mutate(ll = pmap(., ~list( N_Whh=..3, KG = ..4, N_fpd = ..5 )), res = map2(ll, town, ~monticarleer(..1, "N_Whh * (KG_WOOD_PWOODHH_PFIRE_SUMMR_M1_WWS2020 * N_fpd)", tbl_out = FALSE, saveplot = saveplotvar, fn = paste0("../man/figures/Wood_Summer_Month_WWS_", ..2, ".pdf")) ) ) %>% unnest(res)%>% mutate(ss = map(res, ~broom::tidy(summary(.$Result))))
dfSummerWWS %>% dplyr::select(site, town, ss) %>% unnest(ss) %>% group_by(site, town) %>% kable(digit = 0, booktabs = TRUE) %>% kableExtra::kable_styling(latex_options = c("HOLD_position", "scale_down"))
ggplot(data = dfSummerWWS %>% dplyr::select(site, town, res) %>% unnest(res) %>% arrange(site), aes(x = town, y = Result,fill = site)) + geom_boxplot() + facet_wrap(site~., scales = "free_x") + theme(legend.position = "none") + theme(axis.text.x = element_text(angle = 35)) + scale_y_continuous(labels = scales::comma)
The wood consumption per summer month per town calculated according to Method 2 is shown in \ref{fig:summermeth2}.
```r Mass of wood per summer month per town by Method 2"} dfSummerWWS_M2 <-dfWoodUsers %>% left_join(KG_WOOD_PWOODHH_PMONTH_SUMMR_M2_WWS2020 ) %>% filter(town == "Sefikile_p2" | town == "Mfidikoe_sp") %>% mutate(ll = pmap(., ~list(N = ..3, KG = ..4)), res = map2(ll, town, ~monticarleer(..1, "N_Whh * KG_WOOD_PWOODHH_PMONTH_SUMMR_M2_WWS2020", tbl_out = FALSE, saveplot = saveplotvar, fn =paste0("../man/figures/Wood_Summer_Month_WWS_M2_", ..2, ".pdf"))) ) %>% unnest(res)
```r dfSummerWWS_M2 %>% dplyr::select(site, town, res) %>% group_by(site, town) %>% mutate(ss = map(res, ~broom::tidy(summary(.$Result)))) %>% dplyr::select(-res) %>% unnest(ss) %>% kable(booktabs = TRUE) %>% kableExtra::kable_styling(latex_options = c("HOLD_position", "scale_down"))
The mass of ...
KG_WOOD_PWOODHH_PFIRE_SUMMR_M2_WWS2020 %>% mutate(distribution = map_chr(KG_WOOD_PWOODHH_PFIRE_SUMMR_M2_WWS2020, ~.@dist), lambda = map_dbl(KG_WOOD_PWOODHH_PFIRE_SUMMR_M2_WWS2020, ~.@params) ) %>% dplyr::select(-KG_WOOD_PWOODHH_PFIRE_SUMMR_M2_WWS2020) %>% kable(booktabs = TRUE, align = "c", caption = "\\label{tab:summerm2} Parameters for Summer M2 ") %>% kableExtra::kable_styling(latex_options = c("HOLD_position"))
N_FIRES_PWOODHH_PMONTH_SUMMR_FLB2020 %>% mutate(distribution = map_chr(N_fpd, ~.@dist), lambda = map_dbl(N_fpd, ~.@params)) %>% dplyr::select(-N_fpd) %>% kable(booktabs = TRUE, align = "c", caption = "\\label{tab:M2summerpois}") %>% kableExtra::kable_styling(latex_options = c("HOLD_position"))
dfSummerFLB <- dfWoodUsers %>% left_join(N_FIRES_PWOODHH_PMONTH_SUMMR_FLB2020 ) %>% left_join(KG_WOOD_PWOODHH_PFIRE_SUMMR_M1_WWS2020) %>% filter(town == "sefikile_p2" | town == "mfidikoe_sp") %>% mutate(ll = pmap(., ~list(N = ..3, p = ..4, KG = ..5)), res = map2(ll, town, ~monticarleer(..1, "N_HHS2020 * KG_WOOD_PWOODHH_PFIRE_SUMMR_M2_WWS2020 * N_FIRES_PWOODHH_PMONTH_SUMMR_FLB2020", tbl_out = FALSE, saveplot = saveplotvar, fn = paste0("../man/figures/Wood_Summer_Month_FLB_M2_", ..2, ".pdf"), nbin = 20) ) ) %>% unnest(res)
dfSummerFLB %>% dplyr::select(site, town, res) %>% group_by(site, town) %>% mutate(ss = map(res, ~broom::tidy(summary(.$Result)))) %>% dplyr::select(-res) %>% unnest(ss)
KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020 <- bind_rows( tibble.indicator.plek(indicators$mortimer$ga_ramosidi_sp_sefikile_p1$KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020), tibble.indicator.plek(indicators$mortimer$sefikile_p2$KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020), tibble.indicator.plek(indicators$mortimer$northam_ext_5_ext_7$KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020), tibble.indicator.plek(indicators$mortimer$mantserre_sp$KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020), tibble.indicator.plek(indicators$waterval$bokamoso_sp$KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020), tibble.indicator.plek(indicators$waterval$mfidikoe_sp$KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020), tibble.indicator.plek(indicators$waterval$waterkloof_sp$KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020)) %>% unnest(cols = c(val))
KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020 %<>% mutate(KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020 = map(Mean, ~novaInventories::maak_distlist( nm = "KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020", dist = "pois", params = c(lambda = as.numeric(.))))) %>% dplyr::select(site, town, KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020)
PERC_HHS_WOOD_WINTR_CHS2020 <- bind_rows( tibble.indicator.plek(indicators$mortimer$ga_ramosidi_sp_sefikile_p1$PERC_HHS_WOOD_WINTR_CHS2020), tibble.indicator.plek(indicators$mortimer$sefikile_p2$PERC_HHS_WOOD_WINTR_CHS2020), tibble.indicator.plek(indicators$mortimer$northam_ext_5_ext_7$PERC_HHS_WOOD_WINTR_CHS2020), tibble.indicator.plek(indicators$mortimer$mantserre_sp$PERC_HHS_WOOD_WINTR_CHS2020), tibble.indicator.plek(indicators$waterval$bokamoso_sp$PERC_HHS_WOOD_WINTR_CHS2020), tibble.indicator.plek(indicators$waterval$mfidikoe_sp$PERC_HHS_WOOD_WINTR_CHS2020), tibble.indicator.plek(indicators$waterval$waterkloof_sp$PERC_HHS_WOOD_WINTR_CHS2020) ) %>% unnest(val) %>% mutate(p = map2(n, PointEst, ~maak_distlist( nm = "PERC_HHS_WOOD_WINTR_CHS2020", dist = "norm" , params = c(mean = ..2/100, sd = (..2/100 * (1 -..2/100))/..1 ) ))) %>% dplyr::select(site, town, p)
dfWinterCHS <- left_join(N_HHS2020 %>% mutate(site = tolower(site), town = tolower(town)), PERC_HHS_WOOD_WINTR_CHS2020) %>% left_join(KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020 ) %>% mutate(ll = pmap(., ~list(N = ..3, p = ..4, KG = ..5)), res = map2(ll, town, ~monticarleer(..1, "N_HHS2020 * PERC_HHS_WOOD_WINTR_CHS2020 * KG_WOOD_PWOODHH_PMONTH_WINTR_CHS2020", n = 3000, tbl_out = FALSE, saveplot = saveplotvar, fn = paste0("man/figures/Wood_Winter_Month_CHS_", ..2, ".pdf")) ) ) %>% unnest(res) %>% mutate(ss = map(res, ~broom::tidy(summary(.$Result))))
dfWinterCHSlong <- dfWinterCHS %>% select(town, res) %>% unnest(cols = c(res)) %>% pivot_longer(cols = -town, names_to = "Variable") %>% mutate( town = case_when( town == "ga_ramosidi_sp_sefikile_p1" ~ "Ga-Ramosidi & Sefikile", town == "sefikile_p2" ~ "Sefikile P2", town == "northam_ext_5_ext_7" ~ "Northam", town == "mantserre_sp" ~ "Mantserre", town == "bokamoso_sp" ~ "Bokamoso", town == "mfidikoe_sp" ~ "Mfidikoe", town == "waterkloof_sp" ~ "Waterkloof", TRUE ~ town) )
ggplot2::ggplot(data = dfWinterCHSlong %>% filter(town %in% c ("Mantserre", "Ga-Ramosidi & Sefikile", "Sefikile P2","Northam")), aes(x = value, group = Variable, fill = Variable, alpha = I(1/3))) + geom_histogram(aes(y = ..density..), bins = 50) + geom_density(aes(y = ..density.., fill = NULL)) + facet_wrap(town~Variable, scales = "free", ncol = 4, strip.position = c("left") ) + theme_bw() + theme(legend.position = "bottom" , #strip.text = element_blank() ) + ggtitle(label = "Calculation of total winter household wood burning per town") #ggsave("~/novaInventories/man/figures/WoodSummaryMortimer.pdf", width = 14, height = 7)
ggplot2::ggplot(data = dfWinterCHSlong %>% filter(!town %in% c ("Mantserre", "Ga-Ramosidi & Sefikile", "Sefikile P2","Northam")), aes(x = value, group = Variable, fill = Variable, alpha = I(1/3))) + geom_histogram(aes(y = ..density..), bins = 50) + geom_density(aes(y = ..density.., fill = NULL)) + facet_wrap(town~Variable, scales = "free", ncol = 4, strip.position = c("left") ) + theme_bw() + theme(legend.position = "bottom" , #strip.text = element_blank() ) + ggtitle(label = "Calculation of total winter household wood burning per town") #ggsave("~/novaInventories/man/figures/WoodSummaryWaterval.pdf", width = 14, height = 7)
dfWinterCHS %>% dplyr::select(site, town, ss) %>% unnest(ss) %>% group_by(site, town) %>% kable()
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.