knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE) run <- params$run grp_names <- groups(params$run$tables$pmxploitab) group_cols <- plyr::mapvalues(as.character(grp_names), run$model$covariates$column, run$model$covariates$name, warn_missing = FALSE)
qc <- run %>% quality_criteria(prediction = params$prediction, log_data = params$log_data, alpha = params$alpha)
filters <- attr(run$tables$pmxploitab, "filters") has_filters <- !is.null(filters) n_obs <- run$info$number_of_observations n_filtered_rows <- nrow(run$tables$pmxploitab) filter_text <- ifelse(has_filters & (n_filtered_rows != n_obs), sprintf("%s (filtered from %s)", n_filtered_rows, n_obs), n_obs)
Number of observations: r filter_text
r if(has_filters) {"Filters:"}
if(has_filters) knitr::kable(tibble(condition = as.character(filters)), align = "c")
qc_cols <- intersect(colnames(qc), c("n_observations", "standard", group_cols)) qc_s <- qc %>% select(one_of(qc_cols)) %>% unnest(standard) %>% rename("Maximal Error" = max_err, "Absolute Average Fold Error" = aafe) knitr::kable(qc_s, align = "c")
qc_cols <- intersect(colnames(qc), c("n_observations", "bias", group_cols)) qc_b <- qc %>% select(one_of(qc_cols)) %>% unnest(bias) ci <- (1 - as.numeric(params$alpha)) * 100 dots <- setNames(c("value", "ci_low", "ci_up", "relative_value"), nm = c("MPE (absolute)", paste(ci, "% CI (lower bound)"), paste(ci, "% CI (upper bound)"), "MPE (%)")) qc_b <- qc_b %>% rename(!!!dots) %>% mutate(`MPE (%)` = `MPE (%)` * 100) knitr::kable(qc_b, align = "c")
qc_cols <- intersect(colnames(qc), c("n_observations", "precision", group_cols)) qc_p <- qc %>% select(one_of(qc_cols)) %>% unnest(precision) ci <- (1 - as.numeric(params$alpha)) * 100 dots <- setNames(c("value", "ci_low", "ci_up", "relative_value"), nm = c("RMSE (absolute)", paste(ci, "% CI (lower bound)"), paste(ci, "% CI (upper bound)"), "RMSE (%)")) qc_p <- qc_p %>% rename(!!!dots) %>% mutate(`RMSE (%)` = `RMSE (%)` * 100) knitr::kable(qc_p, align = "c")
qc_cols <- intersect(colnames(qc), c("n_observations", "t_test_obs", group_cols)) qc_t_o <- qc %>% select(one_of(qc_cols)) %>% mutate(t_test_obs = map(t_test_obs, broom::tidy)) %>% unnest(t_test_obs) %>% select(-method, -alternative) knitr::kable(qc_t_o)
qc_cols <- intersect(colnames(qc), c("n_observations", "t_test_res", group_cols)) qc_t_r <-qc %>% select(one_of(qc_cols)) %>% filter(!map_lgl(t_test_res, is.null))%>% unnest(t_test_res) %>% mutate(t.test = map(t.test, broom::tidy)) %>% unnest(t.test) %>% select(-method, -alternative) knitr::kable(qc_t_r)
Observations vs Predictions
qc_cols <- intersect(colnames(qc), c("n_observations", "correlation_test", group_cols)) qc_c <- qc %>% select(one_of(qc_cols)) %>% mutate(correlation_test = map(correlation_test, broom::tidy)) %>% unnest(correlation_test) %>% select(-method, -alternative) knitr::kable(qc_c)
$$Prediction = Intercept + Slope * Observation$$
qc_cols <- intersect(colnames(qc), c("n_observations", "linear_regression", group_cols)) qc_l <- qc %>% select(one_of(qc_cols)) %>% mutate(linear_regression = map(linear_regression, tidy)) %>% unnest(linear_regression) %>% mutate(term = plyr::revalue(term, c("observations" = "slope"))) knitr::kable(qc_l, align = "c")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.