R/site_model_to_xml_prior.R

Defines functions site_model_to_xml_prior_distr

#' Converts a site model to XML,
#'   used in the \code{prior} section
#' @inheritParams default_params_doc
#' @return the site model as XML text
#' @author Richèl J.C. Bilderbeek
#' @noRd
site_model_to_xml_prior_distr <- function(
  site_model
) {
  testit::assert(is_site_model(site_model)) # nolint beautier function
  id <- site_model$id
  testit::assert(is_id(id)) # nolint beautier function

  text <- NULL
  if (is_hky_site_model(site_model)) { # nolint beautier function
    text <- c(text, paste0("<prior ",
      "id=\"KappaPrior.s:", id, "\" ",
      "name=\"distribution\" x=\"@kappa.s:", id, "\">"))
    text <- c(text,
      indent( # nolint beautier function
        distr_to_xml(site_model$kappa_prior), # nolint beautier function
        n_spaces = 4
      )
    )
    text <- c(text, paste0("</prior>"))
  } else if (is_tn93_site_model(site_model)) { # nolint beautier function
    if (site_model$kappa_1_param$estimate == TRUE) {
      text <- c(text, paste0("<prior id=\"kappa1Prior.s:", id, "\" ",
        "name=\"distribution\" x=\"@kappa1.s:", id, "\">"))
      text <- c(text,
        indent( # nolint beautier function
          distr_to_xml(site_model$kappa_1_prior), # nolint beautier function
          n_spaces = 4
        )
      )
      text <- c(text, paste0("</prior>"))
    }
    if (site_model$kappa_2_param$estimate == TRUE) {
      text <- c(text, paste0("<prior id=\"kappa2Prior.s:", id, "\" ",
        "name=\"distribution\" x=\"@kappa2.s:", id, "\">"))
      text <- c(text,
        indent( # nolint beautier function
          distr_to_xml(site_model$kappa_2_prior), # nolint beautier function
          n_spaces = 4
        )
      )
      text <- c(text, paste0("</prior>"))
    }
  } else if (is_gtr_site_model(site_model)) { # nolint beautier function
    if (site_model$rate_ac_param$estimate == TRUE) {
      text <- c(text, paste0("<prior id=\"RateACPrior.s:", id, "\" ",
        "name=\"distribution\" x=\"@rateAC.s:", id, "\">"))
      text <- c(text, indent( # nolint beautier function
        distr_to_xml(site_model$rate_ac_prior_distr), n_spaces = 4)) # nolint beautier function
      text <- c(text, paste0("</prior>"))
    }
    if (site_model$rate_ag_param$estimate == TRUE) {
      text <- c(text, paste0("<prior id=\"RateAGPrior.s:", id, "\" ",
        "name=\"distribution\" x=\"@rateAG.s:", id, "\">"))
      text <- c(text, indent( # nolint beautier function
        distr_to_xml(site_model$rate_ag_prior_distr), n_spaces = 4)) # nolint beautier function
      text <- c(text, paste0("</prior>"))
    }
    if (site_model$rate_at_param$estimate == TRUE) {
      text <- c(text, paste0("<prior id=\"RateATPrior.s:", id, "\" ",
        "name=\"distribution\" x=\"@rateAT.s:", id, "\">"))
      text <- c(text, indent( # nolint beautier function
        distr_to_xml(site_model$rate_at_prior_distr), n_spaces = 4)) # nolint beautier function
      text <- c(text, paste0("</prior>"))
    }
    if (site_model$rate_cg_param$estimate == TRUE) {
      text <- c(text, paste0("<prior id=\"RateCGPrior.s:", id, "\" ",
        "name=\"distribution\" x=\"@rateCG.s:", id, "\">"))
      text <- c(text, indent( # nolint beautier function
        distr_to_xml(site_model$rate_cg_prior_distr), n_spaces = 4)) # nolint beautier function
      text <- c(text, paste0("</prior>"))
    }
    if (site_model$rate_gt_param$estimate == TRUE) {
      text <- c(text, paste0("<prior id=\"RateGTPrior.s:", id, "\" ",
        "name=\"distribution\" x=\"@rateGT.s:", id, "\">"))
      text <- c(text, indent( # nolint beautier function
        distr_to_xml(site_model$rate_gt_prior_distr), n_spaces = 4)) # nolint beautier function
      text <- c(text, paste0("</prior>"))
    }
  }

  text
}
ropensci/beautier documentation built on March 12, 2019, 8:27 p.m.