ropensci / beautier
Showing 134 of 383 files from the diff.
Newly tracked file
R/check_param.R created.
Other files ignored by Codecov
man/beautier.Rd has changed.
man/is_mcmc.Rd has changed.
NAMESPACE has changed.
DESCRIPTION has changed.

@@ -65,7 +65,7 @@
Loading
65 65
  id,
66 66
  ...
67 67
) {
68 -
  if (!is_tree_prior_name(name)) { # nolint beautier function
68 +
  if (!beautier::is_tree_prior_name(name)) {
69 69
    tree_priors_as_string <- function() {
70 70
      s <- NULL
71 71
      for (p in beautier::get_tree_prior_names()) {

@@ -17,7 +17,7 @@
Loading
17 17
#' @return nothing
18 18
#' @seealso Use \link{create_treelog} to create a valid \code{treelog}
19 19
#' @author Richèl J.C. Bilderbeek
20 -
#' @noRd
20 +
#' @export
21 21
check_treelog_names <- function(treelog) {
22 22
23 23
  list_element_names <- c(
@@ -41,7 +41,7 @@
Loading
41 41
#' @return nothing
42 42
#' @seealso Use \link{create_treelog} to create a valid treelog
43 43
#' @author Richèl J.C. Bilderbeek
44 -
#' @noRd
44 +
#' @export
45 45
check_treelog_values <- function(treelog) {
46 46
47 47
  if (!beautier::is_one_na(treelog$filename)) {

@@ -0,0 +1,73 @@
Loading
1 +
#' Check if the parameter is a valid parameter
2 +
#'
3 +
#' Calls \code{stop} if the parameter is invalid
4 +
#' @inheritParams default_params_doc
5 +
#' @return nothing
6 +
#' @seealso Use \link{create_param} to create a valid parameter
7 +
#' @examples
8 +
#' library(testthat)
9 +
#'
10 +
#' expect_silent(check_param(create_alpha_param()))
11 +
#' expect_silent(check_param(create_beta_param()))
12 +
#'
13 +
#' # List of two parameters is not a/one parameter
14 +
#' expect_error(
15 +
#'    check_param(
16 +
#'      list(create_alpha_param(), create_beta_param())
17 +
#'    )
18 +
#'  )
19 +
#'
20 +
#' # Must stop on non-parameters
21 +
#' expect_error(check_param("nonsense"))
22 +
#' expect_error(check_param(NULL))
23 +
#' expect_error(check_param(NA))
24 +
#' expect_error(check_param(""))
25 +
#' expect_error(check_param(c()))
26 +
#' @author Richèl J.C. Bilderbeek
27 +
#' @export
28 +
check_param <- function(param) {
29 +
  beautier::check_param_names(param)
30 +
  beautier::check_param_types(param)
31 +
}
32 +
33 +
#' Check if the \code{param} has the list elements
34 +
#' of a valid \code{param} object.
35 +
#'
36 +
#' Calls \code{stop} if an element is missing
37 +
#' @inheritParams default_params_doc
38 +
#' @return nothing
39 +
#' @seealso Use \link{create_param} to create a valid \code{param}
40 +
#' @author Richèl J.C. Bilderbeek
41 +
#' @export
42 +
check_param_names <- function(param) {
43 +
  list_element_names <- c(
44 +
    "name", "id", "value"
45 +
  )
46 +
  for (arg_name in list_element_names) {
47 +
    if (!arg_name %in% names(param)) {
48 +
      stop(
49 +
        "'", arg_name, "' must be an element of an 'param'. \n",
50 +
        "Tip: use 'create_param'"
51 +
      )
52 +
    }
53 +
  }
54 +
}
55 +
56 +
#' Check if the \code{param} has the list elements
57 +
#' of the right type for a valid \code{param} object.
58 +
#'
59 +
#' Calls \code{stop} if an element has the incorrect type
60 +
#' @inheritParams default_params_doc
61 +
#' @return nothing
62 +
#' @seealso Use \link{create_param} to create a valid \code{param}
63 +
#' @author Richèl J.C. Bilderbeek
64 +
#' @export
65 +
check_param_types <- function(param) {
66 +
67 +
  if (!param$name %in% beautier::get_param_names()) {
68 +
    stop("'param$name' must be a valid parameter name")
69 +
  }
70 +
  if (beautier::is_one_na(param$value)) {
71 +
    stop("'param$value' must not be NA")
72 +
  }
73 +
}

@@ -3,7 +3,7 @@
Loading
3 3
#' @inheritParams default_params_doc
4 4
#' @return the tree priors as XML text
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
tree_priors_to_xml_operators <- function(
8 8
  tree_priors,
9 9
  fixed_crown_ages = rep(FALSE, times = length(tree_priors))

@@ -8,7 +8,7 @@
Loading
8 8
#' #'   # Here
9 9
#' # </logger>
10 10
#' @author Richèl J.C. Bilderbeek
11 -
#' @noRd
11 +
#' @export
12 12
tree_priors_to_xml_tracelog <- function(
13 13
  tree_priors
14 14
) {

@@ -32,7 +32,7 @@
Loading
32 32
  if (beautier::is_tree_prior(tree_prior)) {
33 33
    return()
34 34
  }
35 -
  if (length(tree_prior) == 1 && is_tree_prior(tree_prior[[1]])) { # nolint beautier function
35 +
  if (length(tree_prior) == 1 && beautier::is_tree_prior(tree_prior[[1]])) {
36 36
    return()
37 37
  }
38 38
  stop(

@@ -1,8 +1,8 @@
Loading
1 -
#' Convert a clock model to the XML of the TreeLogger
1 +
#' Convert a clock model to the XML of the \code{TreeLogger}
2 2
#' @inherit default_params_doc
3 3
#' @return a character vector of XML strings
4 4
#' @author Richèl J.C. Bilderbeek
5 -
#' @noRd
5 +
#' @export
6 6
clock_model_to_xml_treelogger <- function(
7 7
  clock_model
8 8
) {

@@ -13,23 +13,23 @@
Loading
13 13
#'  #     <distribution id="likelihood" ...>
14 14
#'  #     </distribution>
15 15
#'  # </distribution>
16 -
#' @noRd
17 -
tree_prior_to_xml_prior_distr <- function( # nolint beautier function
16 +
#' @export
17 +
tree_prior_to_xml_prior_distr <- function(
18 18
  tree_prior
19 19
) {
20 20
  testit::assert(beautier::is_tree_prior(tree_prior))
21 21
  text <- NULL
22 22
  if (beautier::is_bd_tree_prior(tree_prior)) {
23 -
    text <- c(text, bd_tree_prior_to_xml_prior_distr(tree_prior)) # nolint beautier function
23 +
    text <- c(text, beautier::bd_tree_prior_to_xml_prior_distr(tree_prior))
24 24
  } else if (beautier::is_cbs_tree_prior(tree_prior)) {
25 -
    text <- c(text, cbs_tree_prior_to_xml_prior_distr(tree_prior)) # nolint beautier function
25 +
    text <- c(text, beautier::cbs_tree_prior_to_xml_prior_distr(tree_prior))
26 26
  } else if (beautier::is_ccp_tree_prior(tree_prior)) {
27 -
    text <- c(text, ccp_tree_prior_to_xml_prior_distr(tree_prior)) # nolint beautier function
27 +
    text <- c(text, beautier::ccp_tree_prior_to_xml_prior_distr(tree_prior))
28 28
  } else if (beautier::is_cep_tree_prior(tree_prior)) {
29 -
    text <- c(text, cep_tree_prior_to_xml_prior_distr(tree_prior)) # nolint beautier function
29 +
    text <- c(text, beautier::cep_tree_prior_to_xml_prior_distr(tree_prior))
30 30
  } else {
31 31
    testit::assert(beautier::is_yule_tree_prior(tree_prior))
32 -
    text <- c(text, yule_tree_prior_to_xml_prior_distr(tree_prior)) # nolint beautier function
32 +
    text <- c(text, beautier::yule_tree_prior_to_xml_prior_distr(tree_prior))
33 33
  }
34 34
  text
35 35
}

@@ -54,10 +54,10 @@
Loading
54 54
  fixed_crown_ages <- FALSE
55 55
  tipdates_filename <- inference_model$tipdates_filename
56 56
57 -
  text <- mcmc_to_xml_run(mcmc) # nolint beautier function
57 +
  text <- beautier::mcmc_to_xml_run(mcmc)
58 58
  text <- c(text,
59 59
    beautier::indent(
60 -
      create_beast2_input_state( # nolint beautier function
60 +
      beautier::create_beast2_input_state(
61 61
        site_models = site_models,
62 62
        clock_models = clock_models,
63 63
        tree_priors = tree_priors,

@@ -1,15 +1,16 @@
Loading
1 +
#' Write the XML \code{operators} section from the site models.
1 2
#' @inheritParams default_params_doc
2 3
#' @return lines of XML text
3 4
#' @author Richèl J.C. Bilderbeek
4 -
#' @noRd
5 +
#' @export
5 6
site_models_to_xml_operators <- function(
6 7
  site_models
7 8
) {
8 -
  testit::assert(are_site_models(site_models)) # nolint beautier function
9 +
  testit::assert(beautier::are_site_models(site_models))
9 10
10 11
  text <- NULL
11 12
  for (site_model in site_models) {
12 -
    text <- c(text, site_model_to_xml_operators(site_model)) # nolint beautier function
13 +
    text <- c(text, beautier::site_model_to_xml_operators(site_model))
13 14
  }
14 15
  text
15 16
}

@@ -5,9 +5,11 @@
Loading
5 5
#' @return a list of site_models
6 6
#' @seealso Use \link{create_clock_model} to create a clock model
7 7
#' @examples
8 -
#'  clock_models <- create_clock_models()
9 -
#'  testit::assert(beautier:::is_rln_clock_model(clock_models[[1]]))
10 -
#'  testit::assert(beautier:::is_strict_clock_model(clock_models[[2]]))
8 +
#' library(testthat)
9 +
#'
10 +
#' clock_models <- create_clock_models()
11 +
#' expect_true(is_rln_clock_model(clock_models[[1]]))
12 +
#' expect_true(is_strict_clock_model(clock_models[[2]]))
11 13
#' @author Richèl J.C. Bilderbeek
12 14
#' @export
13 15
create_clock_models <- function() {

@@ -3,15 +3,18 @@
Loading
3 3
#' @return the number of parameters the tree priors have
4 4
#' @author Richèl J.C. Bilderbeek
5 5
#' @examples
6 -
#'  testit::assert(
7 -
#'    beautier:::get_tree_priors_n_params(
8 -
#'      list(
9 -
#'        create_bd_tree_prior(), # zero
10 -
#'        create_cep_tree_prior() # two
11 -
#'      )
12 -
#'    ) == 2
13 -
#'  )
14 -
#' @noRd
6 +
#' library(testthat)
7 +
#'
8 +
#' expect_equal(
9 +
#'   get_tree_priors_n_params(
10 +
#'     list(
11 +
#'       create_bd_tree_prior(), # zero
12 +
#'       create_cep_tree_prior() # two
13 +
#'     )
14 +
#'   ),
15 +
#'   2
16 +
#' )
17 +
#' @export
15 18
get_tree_priors_n_params <- function(
16 19
  tree_priors
17 20
) {

@@ -2,7 +2,7 @@
Loading
2 2
#' @inheritParams default_params_doc
3 3
#' @return IDs of the clock models
4 4
#' @author Richèl J.C. Bilderbeek
5 -
#' @noRd
5 +
#' @export
6 6
get_clock_models_ids <- function(
7 7
  clock_models
8 8
) {

@@ -37,7 +37,7 @@
Loading
37 37
#'   in \code{clock_models} is a relaxed log-normal
38 38
#'   clock model, FALSE otherwise
39 39
#' @author Richèl J.C. Bilderbeek
40 -
#' @noRd
40 +
#' @export
41 41
are_rln_clock_models <- function(
42 42
  clock_models
43 43
) {

@@ -10,13 +10,13 @@
Loading
10 10
#'  #     </distribution>
11 11
#'  # </distribution>
12 12
#' @author Richèl J.C. Bilderbeek
13 -
#' @noRd
13 +
#' @export
14 14
site_models_to_xml_prior_distr <- function(site_models) {
15 15
  text <- NULL
16 16
  for (site_model in site_models) {
17 17
    text <- c(
18 18
      text,
19 -
      site_model_to_xml_prior_distr(site_model) # nolint beautier function
19 +
      beautier::site_model_to_xml_prior_distr(site_model)
20 20
    )
21 21
  }
22 22
  text

@@ -4,7 +4,7 @@
Loading
4 4
#' @examples
5 5
#' library(testthat)
6 6
#'
7 -
#' names <- beautier:::get_tree_prior_names()
7 +
#' names <- get_tree_prior_names()
8 8
#' expect_true("birth_death" %in% names)
9 9
#' expect_true("coalescent_bayesian_skyline" %in% names)
10 10
#' expect_true("coalescent_constant_population" %in% names)

@@ -3,16 +3,16 @@
Loading
3 3
#' @inheritParams default_params_doc
4 4
#' @return the random phylogeny as XML text
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
taxa_to_xml_tree <- function(
8 8
  id,
9 9
  tipdates_filename = NA
10 10
) {
11 11
  testit::assert(beautier::is_id(id))
12 12
  if (beautier::is_one_na(tipdates_filename)) {
13 -
    no_taxa_to_xml_tree(id = id) # nolint beautier function
13 +
    beautier::no_taxa_to_xml_tree(id = id)
14 14
  } else {
15 -
    tipdate_taxa_to_xml_tree( # nolint beautier function
15 +
    beautier::tipdate_taxa_to_xml_tree(
16 16
      id = id,
17 17
      tipdates_filename = tipdates_filename
18 18
    )
@@ -25,7 +25,7 @@
Loading
25 25
#' @inheritParams default_params_doc
26 26
#' @return the random phylogeny as XML text
27 27
#' @author Richèl J.C. Bilderbeek
28 -
#' @noRd
28 +
#' @export
29 29
no_taxa_to_xml_tree <- function(
30 30
  id
31 31
) {
@@ -47,7 +47,7 @@
Loading
47 47
#' @inheritParams default_params_doc
48 48
#' @return the random phylogeny as XML text
49 49
#' @author Richèl J.C. Bilderbeek
50 -
#' @noRd
50 +
#' @export
51 51
tipdate_taxa_to_xml_tree <- function(
52 52
  id,
53 53
  tipdates_filename

@@ -3,7 +3,7 @@
Loading
3 3
#' @inheritParams default_params_doc
4 4
#' @return the site model as XML text
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
site_model_to_xml_operators <- function(
8 8
  site_model
9 9
) {

@@ -4,7 +4,7 @@
Loading
4 4
#' @return lines of XML text, without indentation nor \code{state}
5 5
#'   tags
6 6
#' @author Richèl J.C. Bilderbeek
7 -
#' @noRd
7 +
#' @export
8 8
clock_model_to_xml_state <- function(
9 9
  clock_model,
10 10
  has_tip_dating = FALSE

@@ -4,7 +4,7 @@
Loading
4 4
#' @return lines of XML text, without indentation nor \code{state}
5 5
#'   tags
6 6
#' @author Richèl J.C. Bilderbeek
7 -
#' @noRd
7 +
#' @export
8 8
site_models_to_xml_state <- function(
9 9
  site_models
10 10
) {
@@ -13,7 +13,7 @@
Loading
13 13
  text <- NULL
14 14
  for (site_model in site_models) {
15 15
    text <- c(text,
16 -
      site_model_to_xml_state(site_model) # nolint beautier function
16 +
      beautier::site_model_to_xml_state(site_model)
17 17
    )
18 18
  }
19 19
  text

@@ -13,7 +13,7 @@
Loading
13 13
#'   #     <taxon id="B25702_aco" spec="Taxon"/>
14 14
#'   #     <taxon id="61430_aco" spec="Taxon"/>
15 15
#'   # </taxonset>
16 -
#' @noRd
16 +
#' @export
17 17
mrca_prior_to_xml_taxonset <- function(
18 18
  mrca_prior,
19 19
  taxa_names_with_ids = NULL

@@ -8,13 +8,13 @@
Loading
8 8
#' #'   # Here
9 9
#' # </logger>
10 10
#' @author Richèl J.C. Bilderbeek
11 -
#' @noRd
11 +
#' @export
12 12
site_models_to_xml_tracelog <- function(
13 13
  site_models
14 14
) {
15 15
  text <- NULL
16 16
  for (site_model in site_models) {
17 -
    text <- c(text, site_model_to_xml_tracelog(site_model)) # nolint beautier function
17 +
    text <- c(text, beautier::site_model_to_xml_tracelog(site_model))
18 18
  }
19 19
  text
20 20
}

@@ -11,7 +11,7 @@
Loading
11 11
#'  #       HERE, where the ID of the distribution is 'likelihood'
12 12
#'  #     </distribution>
13 13
#'  # </distribution>
14 -
#' @noRd
14 +
#' @export
15 15
site_model_to_xml_lh_distr <- function(
16 16
  site_model
17 17
) {

@@ -7,12 +7,14 @@
Loading
7 7
#'   and \code{\link{create_yule_tree_prior}}
8 8
#' @return a list of tree_priors
9 9
#' @examples
10 -
#'   tree_priors <- create_tree_priors()
11 -
#'   testit::assert(beautier:::is_bd_tree_prior(tree_priors[[1]]))
12 -
#'   testit::assert(beautier:::is_cbs_tree_prior(tree_priors[[2]]))
13 -
#'   testit::assert(beautier:::is_ccp_tree_prior(tree_priors[[3]]))
14 -
#'   testit::assert(beautier:::is_cep_tree_prior(tree_priors[[4]]))
15 -
#'   testit::assert(beautier:::is_yule_tree_prior(tree_priors[[5]]))
10 +
#' library(testthat)
11 +
#'
12 +
#' tree_priors <- create_tree_priors()
13 +
#' expect_true(is_bd_tree_prior(tree_priors[[1]]))
14 +
#' expect_true(is_cbs_tree_prior(tree_priors[[2]]))
15 +
#' expect_true(is_ccp_tree_prior(tree_priors[[3]]))
16 +
#' expect_true(is_cep_tree_prior(tree_priors[[4]]))
17 +
#' expect_true(is_yule_tree_prior(tree_priors[[5]]))
16 18
#' @author Richèl J.C. Bilderbeek
17 19
#' @export
18 20
create_tree_priors <- function() {

@@ -4,12 +4,19 @@
Loading
4 4
#' @inheritParams default_params_doc
5 5
#' @return name of the clock model
6 6
#' @examples
7 -
#'   strict <- create_strict_clock_model()
8 -
#'   testit::assert(beautier:::get_clock_model_name(strict) == "StrictClock")
9 -
#'   rln <- create_rln_clock_model()
10 -
#'   testit::assert(beautier:::get_clock_model_name(rln) == "RelaxedClock")
7 +
#' library(testthat)
8 +
#'
9 +
#' expect_equal(
10 +
#'   get_clock_model_name(create_strict_clock_model()),
11 +
#'   "StrictClock"
12 +
#' )
13 +
#'
14 +
#' expect_equal(
15 +
#'   get_clock_model_name(create_rln_clock_model()),
16 +
#'   "RelaxedClock"
17 +
#' )
11 18
#' @author Richèl J.C. Bilderbeek
12 -
#' @noRd
19 +
#' @export
13 20
get_clock_model_name <- function(
14 21
  clock_model
15 22
) {

@@ -1,5 +1,4 @@
Loading
1 1
#' Create the XML declaration as XML text
2 -
#' @inheritParams default_params_doc
3 2
#' @return lines of XML text
4 3
#' @author Richèl J.C. Bilderbeek
5 4
#' @export

@@ -15,15 +15,15 @@
Loading
15 15
#'  #     <distribution id="likelihood" ...>
16 16
#'  #     </distribution>
17 17
#'  # </distribution>
18 -
#' @noRd
19 -
mrca_prior_to_xml_prior_distr <- function( # nolint beautier function
18 +
#' @export
19 +
mrca_prior_to_xml_prior_distr <- function(
20 20
  mrca_prior,
21 21
  has_non_strict_clock_model = FALSE,
22 22
  taxa_names_with_ids = NULL
23 23
) {
24 24
  testit::assert(beautier::is_mrca_prior(mrca_prior))
25 25
  text <- NULL
26 -
  if (!has_non_strict_clock_model && # nolint beautier function
26 +
  if (!has_non_strict_clock_model &&
27 27
      !beautier::is_one_na(mrca_prior$mrca_distr)
28 28
  ) {
29 29
    testit::assert(!beautier::is_one_na(mrca_prior$alignment_id))
@@ -38,7 +38,7 @@
Loading
38 38
    text <- c(
39 39
      text,
40 40
      beautier::indent(
41 -
        distr_to_xml(create_uniform_distr( # nolint beautier function
41 +
        beautier::distr_to_xml(beautier::create_uniform_distr(
42 42
          id = mrca_prior$clock_prior_distr_id)
43 43
        )
44 44
      )
@@ -62,7 +62,7 @@
Loading
62 62
  text <- c(
63 63
    text,
64 64
    beautier::indent(
65 -
      mrca_prior_to_xml_taxonset( # nolint beautier function
65 +
      beautier::mrca_prior_to_xml_taxonset(
66 66
        mrca_prior,
67 67
        taxa_names_with_ids
68 68
      )

@@ -3,7 +3,7 @@
Loading
3 3
#' @inheritParams default_params_doc
4 4
#' @return the phylogeny as XML text
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
rnd_phylo_to_xml_init <- function(
8 8
  id
9 9
) {

@@ -34,7 +34,7 @@
Loading
34 34
#' expect_false(is_distr(NULL))
35 35
#' expect_false(is_distr("nonsense"))
36 36
#' @export
37 -
is_distr <- function(
37 +
is_distr <- function( # nolint simplification of this will hurt readablity
38 38
  x
39 39
) {
40 40
  if (beautier::is_beta_distr(x)) return(TRUE)

@@ -3,7 +3,7 @@
Loading
3 3
#' @inheritParams default_params_doc
4 4
#' @return the tree prior as XML text
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
tree_prior_to_xml_operators <- function(
8 8
  tree_prior,
9 9
  fixed_crown_age = FALSE
@@ -13,7 +13,7 @@
Loading
13 13
  testit::assert(beautier::is_id(id))
14 14
15 15
  text <- NULL
16 -
  operator_id_pre <- get_operator_id_pre(tree_prior) # nolint beautier function
16 +
  operator_id_pre <- beautier::get_operator_id_pre(tree_prior)
17 17
18 18
  if (beautier::is_bd_tree_prior(tree_prior)) {
19 19
    text <- c(text, paste0("<operator id=\"BirthRateScaler.t:",

@@ -1,15 +1,16 @@
Loading
1 1
#' Get the XML opening tag
2 -
#' @inheritParams default_params_doc
3 2
#' @param text text to be determined to be valid
4 -
#' @return the openin tag if found, else NA
3 +
#' @return the opening tag if found, else NA
5 4
#' @examples
6 -
#'   testit::assert(
7 -
#'     beautier:::get_xml_opening_tag("<my_tag text=something/>")
8 -
#'     == "my_tag"
9 -
#'   )
10 -
#'   testit::assert(is_one_na(beautier:::get_xml_opening_tag("no_xml")))
5 +
#' library(testthat)
6 +
#'
7 +
#' expect_equal(
8 +
#'   get_xml_opening_tag("<my_tag text=something/>"),
9 +
#'   "my_tag"
10 +
#' )
11 +
#' expect_true(is_one_na(get_xml_opening_tag("no_xml")))
11 12
#' @author Richèl J.C. Bilderbeek
12 -
#' @noRd
13 +
#' @export
13 14
get_xml_opening_tag <- function(text) {
14 15
  first_line <- stringr::str_trim(text[1])
15 16

@@ -3,19 +3,13 @@
Loading
3 3
#' @return the number of distributions the site models have
4 4
#' @author Richèl J.C. Bilderbeek
5 5
#' @examples
6 -
#'   testit::assert(
7 -
#'     beautier:::get_site_models_n_distrs(list(create_gtr_site_model())) == 6
8 -
#'   )
9 -
#'   testit::assert(
10 -
#'     beautier:::get_site_models_n_distrs(list(create_hky_site_model())) == 2
11 -
#'   )
12 -
#'   testit::assert(
13 -
#'     beautier:::get_site_models_n_distrs(list(create_jc69_site_model())) == 1
14 -
#'   )
15 -
#'   testit::assert(
16 -
#'     beautier:::get_site_models_n_distrs(list(create_tn93_site_model())) == 3
17 -
#'   )
18 -
#' @noRd
6 +
#' library(testthat)
7 +
#'
8 +
#' expect_equal(get_site_models_n_distrs(list(create_gtr_site_model())), 5)
9 +
#' expect_equal(get_site_models_n_distrs(list(create_hky_site_model())), 1)
10 +
#' expect_equal(get_site_models_n_distrs(list(create_jc69_site_model())), 0)
11 +
#' expect_equal(get_site_models_n_distrs(list(create_tn93_site_model())), 2)
12 +
#' @export
19 13
get_site_models_n_distrs <- function(
20 14
  site_models
21 15
) {

@@ -5,7 +5,7 @@
Loading
5 5
#'   as created by \code{\link{create_gamma_site_model}})
6 6
#' @return the gamma_site model as XML text
7 7
#' @author Richèl J.C. Bilderbeek
8 -
#' @noRd
8 +
#' @export
9 9
gamma_site_model_to_xml_state <- function(
10 10
  gamma_site_model,
11 11
  id

@@ -37,12 +37,14 @@
Loading
37 37
is_param <- function(
38 38
  x
39 39
) {
40 -
  if (!"name" %in% names(x)) return(FALSE)
41 -
  if (!x$name %in% beautier::get_param_names()) return(FALSE)
42 -
  if (!"id" %in% names(x)) return(FALSE)
43 -
  if (!"value" %in% names(x)) return(FALSE)
44 -
  if (beautier::is_one_na(x$value)) return(FALSE)
45 -
  TRUE
40 +
  result <- FALSE
41 +
  tryCatch({
42 +
    beautier::check_param(x)
43 +
    result <- TRUE
44 +
  },
45 +
    error = function(e) {} # nolint do not care about e
46 +
  )
47 +
  result
46 48
}
47 49
48 50
#' Determine if the object is a valid
@@ -186,9 +188,6 @@
Loading
186 188
#'   \code{\link{create_kappa_1_param}}
187 189
#' @author Richèl J.C. Bilderbeek
188 190
#' @examples
189 -
#'   kappa_1_param <- create_kappa_1_param()
190 -
#'   testit::assert(beautier:::is_kappa_1_param(kappa_1_param))
191 -
#' @examples
192 191
#' library(testthat)
193 192
#'
194 193
#' expect_false(is_kappa_1_param(create_alpha_param()))

@@ -3,7 +3,7 @@
Loading
3 3
#' @param required requirement
4 4
#' @return the XML
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
create_beast2_beast_xml <- function(
8 8
  beast2_version,
9 9
  required = ""

@@ -3,7 +3,7 @@
Loading
3 3
#' @param lines_to_remove lines of character that need to be removed from text
4 4
#' @return lines of text
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
remove_multiline <- function(text, lines_to_remove) {
8 8
  first_line_to_remove <- lines_to_remove[1]
9 9
  first_line_to_remove_index <- which(text == first_line_to_remove)

@@ -14,7 +14,7 @@
Loading
14 14
#'  #       HERE, where the ID of the distribution is 'likelihood'
15 15
#'  #     </distribution>
16 16
#'  # </distribution>
17 -
#' @noRd
17 +
#' @export
18 18
mrca_prior_to_xml_lh_distr <- function(
19 19
  mrca_prior,
20 20
  has_non_strict_clock_model = FALSE
@@ -23,7 +23,7 @@
Loading
23 23
  if (length(mrca_prior) == 1 && beautier::is_one_na(mrca_prior)) {
24 24
    return(NULL)
25 25
  }
26 -
  if (!has_non_strict_clock_model && # nolint beautier function
26 +
  if (!has_non_strict_clock_model &&
27 27
    !beautier::is_one_na(mrca_prior$mrca_distr)
28 28
  ) {
29 29
    testit::assert(!beautier::is_one_na(mrca_prior$alignment_id))

@@ -15,7 +15,9 @@
Loading
15 15
  clock_models <- list()
16 16
  for (i in seq_along(clock_model_names)) {
17 17
    clock_model_name <- clock_model_names[i]
18 -
    clock_models[[i]] <- create_clock_model_from_name(clock_model_name) # nolint beautier function
18 +
    clock_models[[i]] <- beautier::create_clock_model_from_name(
19 +
      clock_model_name
20 +
    )
19 21
  }
20 22
  clock_models
21 23
}

@@ -4,10 +4,12 @@
Loading
4 4
#' @return the distribution as XML text
5 5
#' @author Richèl J.C. Bilderbeek
6 6
#' @examples
7 -
#'   xml <- beautier:::distr_to_xml(create_uniform_distr(id = 1))
8 -
#'   testit::assert(is.character(xml))
9 -
#'   testit::assert(length(xml) == 1)
10 -
#'   testit::assert(nchar(xml) > 1)
7 +
#' library(testthat)
8 +
#'
9 +
#' xml <- distr_to_xml(create_uniform_distr(id = 1))
10 +
#' expect_true(is.character(xml))
11 +
#' expect_true(length(xml) == 1)
12 +
#' expect_true(nchar(xml) > 1)
11 13
#' @export
12 14
distr_to_xml <- function(
13 15
  distr
@@ -18,26 +20,26 @@
Loading
18 20
    stop("distribution must have an ID")
19 21
  }
20 22
  if (beautier::is_beta_distr(distr)) {
21 -
    text <- c(text, distr_to_xml_beta(distr)) # nolint beautier function
23 +
    text <- c(text, beautier::distr_to_xml_beta(distr))
22 24
  } else if (beautier::is_exp_distr(distr)) {
23 -
    text <- c(text, distr_to_xml_exp(distr)) # nolint beautier function
25 +
    text <- c(text, beautier::distr_to_xml_exp(distr))
24 26
  } else if (beautier::is_gamma_distr(distr)) {
25 -
    text <- c(text, distr_to_xml_gamma(distr)) # nolint beautier function
27 +
    text <- c(text, beautier::distr_to_xml_gamma(distr))
26 28
  } else if (beautier::is_inv_gamma_distr(distr)) {
27 -
    text <- c(text, distr_to_xml_inv_gamma(distr)) # nolint beautier function
29 +
    text <- c(text, beautier::distr_to_xml_inv_gamma(distr))
28 30
  } else if (beautier::is_laplace_distr(distr)) {
29 -
    text <- c(text, distr_to_xml_laplace(distr)) # nolint beautier function
31 +
    text <- c(text, beautier::distr_to_xml_laplace(distr))
30 32
  } else if (beautier::is_log_normal_distr(distr)) {
31 -
    text <- c(text, distr_to_xml_log_normal(distr)) # nolint beautier function
33 +
    text <- c(text, beautier::distr_to_xml_log_normal(distr))
32 34
  } else if (beautier::is_normal_distr(distr)) {
33 -
    text <- c(text, distr_to_xml_normal(distr)) # nolint beautier function
35 +
    text <- c(text, beautier::distr_to_xml_normal(distr))
34 36
  } else if (beautier::is_one_div_x_distr(distr)) {
35 -
    text <- c(text, distr_to_xml_one_div_x(distr)) # nolint beautier function
37 +
    text <- c(text, beautier::distr_to_xml_one_div_x(distr))
36 38
  } else if (beautier::is_poisson_distr(distr)) {
37 -
    text <- c(text, distr_to_xml_poisson(distr)) # nolint beautier function
39 +
    text <- c(text, beautier::distr_to_xml_poisson(distr))
38 40
  } else {
39 41
    testit::assert(beautier::is_uniform_distr(distr))
40 -
    text <- c(text, distr_to_xml_uniform(distr)) # nolint beautier function
42 +
    text <- c(text, beautier::distr_to_xml_uniform(distr))
41 43
  }
42 44
  testit::assert(beautier::is_xml(text))
43 45
  text
@@ -48,6 +50,7 @@
Loading
48 50
#'   as created by \code{\link{create_beta_distr}})
49 51
#' @return the distribution as XML text
50 52
#' @author Richèl J.C. Bilderbeek
53 +
#' @export
51 54
distr_to_xml_beta <- function(
52 55
  distr
53 56
) {
@@ -76,6 +79,7 @@
Loading
76 79
#'   as created by \code{\link{create_exp_distr}})
77 80
#' @return the distribution as XML text
78 81
#' @author Richèl J.C. Bilderbeek
82 +
#' @export
79 83
distr_to_xml_exp <- function(
80 84
  distr
81 85
) {
@@ -100,6 +104,7 @@
Loading
100 104
#'   as created by \code{\link{create_gamma_distr}})
101 105
#' @return the distribution as XML text
102 106
#' @author Richèl J.C. Bilderbeek
107 +
#' @export
103 108
distr_to_xml_gamma <- function(
104 109
  distr
105 110
) {
@@ -129,6 +134,7 @@
Loading
129 134
#'   as created by \code{\link{create_inv_gamma_distr}})
130 135
#' @return the distribution as XML text
131 136
#' @author Richèl J.C. Bilderbeek
137 +
#' @export
132 138
distr_to_xml_inv_gamma <- function(
133 139
  distr
134 140
) {
@@ -158,6 +164,7 @@
Loading
158 164
#'   as created by \code{\link{create_laplace_distr}})
159 165
#' @return the distribution as XML text
160 166
#' @author Richèl J.C. Bilderbeek
167 +
#' @export
161 168
distr_to_xml_laplace <- function(
162 169
  distr
163 170
) {
@@ -186,6 +193,7 @@
Loading
186 193
#'   as created by \code{\link{create_log_normal_distr}})
187 194
#' @return the distribution as XML text
188 195
#' @author Richèl J.C. Bilderbeek
196 +
#' @export
189 197
distr_to_xml_log_normal <- function(
190 198
  distr
191 199
) {
@@ -216,6 +224,7 @@
Loading
216 224
#'   as created by \code{\link{create_normal_distr}})
217 225
#' @return the distribution as XML text
218 226
#' @author Richèl J.C. Bilderbeek
227 +
#' @export
219 228
distr_to_xml_normal <- function(
220 229
  distr
221 230
) {
@@ -245,6 +254,7 @@
Loading
245 254
#'   as created by \code{\link{create_one_div_x_distr}})
246 255
#' @return the distribution as XML text
247 256
#' @author Richèl J.C. Bilderbeek
257 +
#' @export
248 258
distr_to_xml_one_div_x <- function(
249 259
  distr
250 260
) {
@@ -263,6 +273,7 @@
Loading
263 273
#'   as created by \code{\link{create_poisson_distr}})
264 274
#' @return the distribution as XML text
265 275
#' @author Richèl J.C. Bilderbeek
276 +
#' @export
266 277
distr_to_xml_poisson <- function(
267 278
  distr
268 279
) {
@@ -288,6 +299,7 @@
Loading
288 299
#'   as created by \code{\link{create_uniform_distr}})
289 300
#' @return the distribution as XML text
290 301
#' @author Richèl J.C. Bilderbeek
302 +
#' @export
291 303
distr_to_xml_uniform <- function(
292 304
  distr
293 305
) {

@@ -4,36 +4,17 @@
Loading
4 4
#'   its named functions
5 5
#' @return the number of parameters that distribution uses
6 6
#' @examples
7 -
#'   testit::assert(
8 -
#'     beautier:::get_distr_n_params(create_beta_distr()) == 2
9 -
#'   )
10 -
#'   testit::assert(
11 -
#'     beautier:::get_distr_n_params(create_exp_distr()) == 1
12 -
#'   )
13 -
#'   testit::assert(
14 -
#'     beautier:::get_distr_n_params(create_gamma_distr()) == 2
15 -
#'   )
16 -
#'   testit::assert(
17 -
#'     beautier:::get_distr_n_params(create_inv_gamma_distr()) == 2
18 -
#'   )
19 -
#'   testit::assert(
20 -
#'     beautier:::get_distr_n_params(create_laplace_distr()) == 2
21 -
#'   )
22 -
#'   testit::assert(
23 -
#'     beautier:::get_distr_n_params(create_log_normal_distr()) == 2
24 -
#'   )
25 -
#'   testit::assert(
26 -
#'     beautier:::get_distr_n_params(create_normal_distr()) == 2
27 -
#'   )
28 -
#'   testit::assert(
29 -
#'     beautier:::get_distr_n_params(create_one_div_x_distr()) == 0
30 -
#'   )
31 -
#'   testit::assert(
32 -
#'     beautier:::get_distr_n_params(create_poisson_distr()) == 1
33 -
#'   )
34 -
#'   testit::assert(
35 -
#'     beautier:::get_distr_n_params(create_uniform_distr()) == 0
36 -
#'   )
7 +
#' library(testthat)
8 +
#' expect_equal(get_distr_n_params(create_beta_distr()), 2)
9 +
#' expect_equal(get_distr_n_params(create_exp_distr()), 1)
10 +
#' expect_equal(get_distr_n_params(create_gamma_distr()), 2)
11 +
#' expect_equal(get_distr_n_params(create_inv_gamma_distr()), 2)
12 +
#' expect_equal(get_distr_n_params(create_laplace_distr()), 2)
13 +
#' expect_equal(get_distr_n_params(create_log_normal_distr()), 2)
14 +
#' expect_equal(get_distr_n_params(create_normal_distr()), 2)
15 +
#' expect_equal(get_distr_n_params(create_one_div_x_distr()), 0)
16 +
#' expect_equal(get_distr_n_params(create_poisson_distr()), 1)
17 +
#' expect_equal(get_distr_n_params(create_uniform_distr()), 0)
37 18
#' @author Richèl J.C. Bilderbeek
38 19
#' @export
39 20
get_distr_n_params <- function(

@@ -0,0 +1,70 @@
Loading
1 +
#' Check if the \code{tn93_site_model} is a valid
2 +
#' TN93 nucleotide substitution model.
3 +
#'
4 +
#' Use \link{create_tn93_site_model} to create a valid
5 +
#' TN93 nucleotide substitution model.
6 +
#' @inheritParams default_params_doc
7 +
#' @examples
8 +
#' library(testthat)
9 +
#'
10 +
#' expect_silent(check_tn93_site_model(create_tn93_site_model()))
11 +
#'
12 +
#' expect_error(check_tn93_site_model("nonsense"))
13 +
#' expect_error(check_tn93_site_model(NA))
14 +
#' expect_error(check_tn93_site_model(NULL))
15 +
#' expect_error(check_tn93_site_model(""))
16 +
#' expect_error(check_tn93_site_model(c()))
17 +
#' @export
18 +
check_tn93_site_model <- function(tn93_site_model) {
19 +
20 +
  if (!beautier::is_site_model(tn93_site_model)) {
21 +
    stop("'tn93_site_model' must be a site model")
22 +
  }
23 +
  beautier::check_tn93_site_model_names(tn93_site_model)
24 +
25 +
  if (!beautier::is_distr(tn93_site_model$kappa_1_prior_distr)) {
26 +
    stop("'tn93_site_model$kappa_1_prior_distr' must be a distribution")
27 +
  }
28 +
  if (!beautier::is_distr(tn93_site_model$kappa_2_prior_distr)) {
29 +
    stop("'tn93_site_model$kappa_2_prior_distr' must be a distribution")
30 +
  }
31 +
  if (!beautier::is_param(tn93_site_model$kappa_1_param)) {
32 +
    stop("'tn93_site_model$kappa_1_param' must be a parameter")
33 +
  }
34 +
  if (!beautier::is_param(tn93_site_model$kappa_2_param)) {
35 +
    stop("'tn93_site_model$kappa_2_param' must be a parameter")
36 +
  }
37 +
  if (!beautier::is_freq_equilibrium_name(tn93_site_model$freq_equilibrium)) {
38 +
    stop(
39 +
      "'tn93_site_model$freq_equilibrium' must be ",
40 +
      "an equilibrium frequency name"
41 +
    )
42 +
  }
43 +
44 +
}
45 +
46 +
#' Check if the \code{tn93_site_model} has the list elements
47 +
#' of a valid \code{tn93_site_model} object.
48 +
#'
49 +
#' Calls \code{stop} if an element is missing
50 +
#' @inheritParams default_params_doc
51 +
#' @return nothing
52 +
#' @seealso Use \link{create_tn93_site_model}
53 +
#' to create a valid \code{tn93_site_model}
54 +
#' @author Richèl J.C. Bilderbeek
55 +
#' @export
56 +
check_tn93_site_model_names <- function(tn93_site_model) {
57 +
58 +
  list_element_names <- c(
59 +
    "kappa_1_prior_distr", "kappa_2_prior_distr",
60 +
    "kappa_1_param", "kappa_2_param", "freq_equilibrium"
61 +
  )
62 +
  for (arg_name in list_element_names) {
63 +
    if (!arg_name %in% names(tn93_site_model)) {
64 +
      stop(
65 +
        "'", arg_name, "' must be an element of an 'tn93_site_model'. \n",
66 +
        "Tip: use 'create_tn93_site_model'"
67 +
      )
68 +
    }
69 +
  }
70 +
}

@@ -3,7 +3,7 @@
Loading
3 3
#' @return lines of XML text
4 4
#' @author Richèl J.C. Bilderbeek
5 5
#' @export
6 -
create_beast2_input_operators <- function( # nolint beautier function
6 +
create_beast2_input_operators <- function(
7 7
  site_models,
8 8
  clock_models,
9 9
  tree_priors,
@@ -29,10 +29,10 @@
Loading
29 29
    )
30 30
  )
31 31
32 -
  text <- c(text, site_models_to_xml_operators(site_models)) # nolint beautier function
32 +
  text <- c(text, beautier::site_models_to_xml_operators(site_models))
33 33
  text <- c(
34 34
    text,
35 -
    clock_models_to_xml_operators( # nolint beautier function
35 +
    beautier::clock_models_to_xml_operators(
36 36
      clock_models = clock_models,
37 37
      mrca_priors = mrca_priors,
38 38
      tipdates_filename = tipdates_filename

@@ -3,9 +3,16 @@
Loading
3 3
#' @seealso Use \code{\link{create_mcmc}} to create an MCMC
4 4
#' @return TRUE if x is a valid MCMC, FALSE otherwise
5 5
#' @examples
6 -
#'   testthat::expect_true(is_mcmc(create_mcmc()))
7 -
#'   testthat::expect_true(is_mcmc(create_ns_mcmc()))
8 -
#'   testthat::expect_false(is_mcmc("nonsense"))
6 +
#' library(testthat)
7 +
#'
8 +
#' expect_true(is_mcmc(create_mcmc()))
9 +
#' expect_true(is_mcmc(create_ns_mcmc()))
10 +
#'
11 +
#' expect_false(is_mcmc("nonsense"))
12 +
#' expect_false(is_mcmc(NULL))
13 +
#' expect_false(is_mcmc(NA))
14 +
#' expect_false(is_mcmc(""))
15 +
#' expect_false(is_mcmc(c()))
9 16
#' @author Richèl J.C. Bilderbeek
10 17
#' @export
11 18
is_mcmc <- function(

@@ -1,16 +1,15 @@
Loading
1 1
#' Checks if the text is a valid XML node, that is,
2 2
#' it has a opening and matching closing tag
3 -
#' @inheritParams default_params_doc
4 3
#' @param text text to be determined to be valid
5 4
#' @return TRUE if the text is valid XML, FALSE otherwise
6 5
#' @author Richèl J.C. Bilderbeek
7 6
#' @export
8 7
is_xml <- function(text) {
9 8
  if (beautier::is_one_na(text)) return(FALSE)
10 -
  if (!has_xml_opening_tag(text)) return(FALSE) # nolint beautier function
11 -
  if (has_xml_short_closing_tag(text)) return(TRUE) # nolint beautier function
12 -
  opening_tag <- get_xml_opening_tag(text) # nolint beautier function
13 -
  closing_tag <- get_xml_closing_tag(text) # nolint beautier function
9 +
  if (!beautier::has_xml_opening_tag(text)) return(FALSE)
10 +
  if (beautier::has_xml_short_closing_tag(text)) return(TRUE)
11 +
  opening_tag <- beautier::get_xml_opening_tag(text)
12 +
  closing_tag <- beautier::get_xml_closing_tag(text)
14 13
  if (beautier::is_one_na(closing_tag)) return(FALSE)
15 14
  testit::assert(!beautier::is_one_na(closing_tag))
16 15
  if (opening_tag != closing_tag) return(FALSE)

@@ -13,7 +13,7 @@
Loading
13 13
#'  #       HERE, where the ID of the distribution is 'likelihood'
14 14
#'  #     </distribution>
15 15
#'  # </distribution>
16 -
#' @noRd
16 +
#' @export
17 17
clock_model_to_xml_lh_distr <- function(
18 18
  clock_model,
19 19
  mrca_priors = NA,

@@ -1,17 +1,20 @@
Loading
1 -
#' Initializes all site models
1 +
#' Initializes a gamma site model
2 2
#' @inheritParams default_params_doc
3 3
#' @param distr_id the first distributions' ID
4 4
#' @param param_id the first parameter's ID
5 5
#' @return an initialized gamma site model
6 6
#' @author Richèl J.C. Bilderbeek
7 7
#' @examples
8 -
#'   gamma_site_model <- create_gamma_site_model(
9 -
#'     gamma_shape_prior_distr = create_one_div_x_distr(id = NA)
10 -
#'   )
11 -
#'  testit::assert(!beautier:::is_init_gamma_site_model(gamma_site_model))
12 -
#'  gamma_site_model <- beautier:::init_gamma_site_model(gamma_site_model)
13 -
#'  testit::assert(beautier:::is_init_gamma_site_model(gamma_site_model))
14 -
#' @noRd
8 +
#' library(testthat)
9 +
#'
10 +
#' gamma_site_model <- create_gamma_site_model(
11 +
#'   gamma_cat_count = 2,
12 +
#'   gamma_shape_prior_distr = create_one_div_x_distr(id = NA)
13 +
#' )
14 +
#' expect_false(is_init_gamma_site_model(gamma_site_model))
15 +
#' gamma_site_model <- init_gamma_site_model(gamma_site_model)
16 +
#' expect_true(is_init_gamma_site_model(gamma_site_model))
17 +
#' @export
15 18
init_gamma_site_model <- function(
16 19
  gamma_site_model,
17 20
  distr_id = 0,
@@ -19,8 +22,8 @@
Loading
19 22
) {
20 23
  testit::assert(beautier::is_gamma_site_model(gamma_site_model))
21 24
22 -
  if (!is_init_distr(gamma_site_model$gamma_shape_prior_distr)) { # nolint beautier function
23 -
    gamma_site_model$gamma_shape_prior_distr <- init_distr( # nolint beautier function
25 +
  if (!beautier::is_init_distr(gamma_site_model$gamma_shape_prior_distr)) {
26 +
    gamma_site_model$gamma_shape_prior_distr <- beautier::init_distr(
24 27
      gamma_site_model$gamma_shape_prior_distr,
25 28
      distr_id = distr_id,
26 29
      param_id = param_id

@@ -11,5 +11,5 @@
Loading
11 11
#' @author Richèl J.C. Bilderbeek
12 12
#' @export
13 13
get_fasta_filename <- function() {
14 -
  beautier::get_beautier_path("test_output_0.fas") # nolint beautier function
14 +
  beautier::get_beautier_path("test_output_0.fas")
15 15
}

@@ -3,7 +3,7 @@
Loading
3 3
#' @inheritParams default_params_doc
4 4
#' @return the site model as XML text
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
site_model_to_xml_subst_model <- function(
8 8
  site_model
9 9
) {
@@ -12,14 +12,14 @@
Loading
12 12
  testit::assert(beautier::is_id(id))
13 13
14 14
  if (beautier::is_jc69_site_model(site_model)) {
15 -
    return(jc69_site_model_to_xml_subst_model(site_model)) # nolint beautier function
15 +
    return(beautier::jc69_site_model_to_xml_subst_model(site_model))
16 16
  } else if (beautier::is_hky_site_model(site_model)) {
17 -
    return(hky_site_model_to_xml_subst_model(site_model)) # nolint beautier function
17 +
    return(beautier::hky_site_model_to_xml_subst_model(site_model))
18 18
  } else if (beautier::is_tn93_site_model(site_model)) {
19 -
    return(tn93_site_model_to_xml_subst_model(site_model)) # nolint beautier function
19 +
    return(beautier::tn93_site_model_to_xml_subst_model(site_model))
20 20
  } else {
21 21
    testit::assert(beautier::is_gtr_site_model(site_model))
22 -
    return(gtr_site_model_to_xml_subst_model(site_model)) # nolint beautier function
22 +
    return(beautier::gtr_site_model_to_xml_subst_model(site_model))
23 23
  }
24 24
}
25 25
@@ -28,7 +28,7 @@
Loading
28 28
#' @inheritParams default_params_doc
29 29
#' @return the site model as XML text
30 30
#' @author Richèl J.C. Bilderbeek
31 -
#' @noRd
31 +
#' @export
32 32
jc69_site_model_to_xml_subst_model <- function( # nolint indeed a long function name, which is fine for internal functions
33 33
  site_model
34 34
) {
@@ -44,7 +44,7 @@
Loading
44 44
#' @inheritParams default_params_doc
45 45
#' @return the site model as XML text
46 46
#' @author Richèl J.C. Bilderbeek
47 -
#' @noRd
47 +
#' @export
48 48
hky_site_model_to_xml_subst_model <- function( # nolint indeed a long function name, which is fine for internal functions
49 49
  site_model
50 50
) {
@@ -72,7 +72,7 @@
Loading
72 72
#' @inheritParams default_params_doc
73 73
#' @return the site model as XML text
74 74
#' @author Richèl J.C. Bilderbeek
75 -
#' @noRd
75 +
#' @export
76 76
tn93_site_model_to_xml_subst_model <- function( # nolint indeed a long function name, which is fine for internal functions
77 77
  site_model
78 78
) {
@@ -125,7 +125,7 @@
Loading
125 125
#' @inheritParams default_params_doc
126 126
#' @return the site model as XML text
127 127
#' @author Richèl J.C. Bilderbeek
128 -
#' @noRd
128 +
#' @export
129 129
gtr_site_model_to_xml_subst_model <- function( # nolint indeed a long function name, which is fine for internal functions
130 130
  site_model
131 131
) {
@@ -176,7 +176,7 @@
Loading
176 176
    text <- c(
177 177
      text,
178 178
      beautier::indent(
179 -
        parameter_to_xml_rate_ac( # nolint beautier function
179 +
        beautier::parameter_to_xml_rate_ac(
180 180
          site_model$rate_ac_param, which_name = "rate_name"
181 181
        )
182 182
      )
@@ -189,7 +189,7 @@
Loading
189 189
    text <- c(
190 190
      text,
191 191
      beautier::indent(
192 -
        parameter_to_xml_rate_ag( # nolint beautier function
192 +
        beautier::parameter_to_xml_rate_ag(
193 193
          site_model$rate_ag_param, which_name = "rate_name"
194 194
        )
195 195
      )
@@ -202,7 +202,7 @@
Loading
202 202
    text <- c(
203 203
      text,
204 204
      beautier::indent(
205 -
        parameter_to_xml_rate_at( # nolint beautier function
205 +
        beautier::parameter_to_xml_rate_at(
206 206
          site_model$rate_at_param, which_name = "rate_name"
207 207
        )
208 208
      )
@@ -215,7 +215,7 @@
Loading
215 215
    text <- c(
216 216
      text,
217 217
      beautier::indent(
218 -
        parameter_to_xml_rate_cg( # nolint beautier function
218 +
        beautier::parameter_to_xml_rate_cg(
219 219
          site_model$rate_cg_param, which_name = "rate_name"
220 220
        )
221 221
      )
@@ -227,7 +227,7 @@
Loading
227 227
    text <- c(
228 228
      text,
229 229
      beautier::indent(
230 -
        parameter_to_xml_rate_ct( # nolint beautier function
230 +
        beautier::parameter_to_xml_rate_ct(
231 231
          site_model$rate_ct_param, which_name = "rate_name"
232 232
        )
233 233
      )
@@ -238,7 +238,7 @@
Loading
238 238
    text <- c(
239 239
      text,
240 240
      beautier::indent(
241 -
        parameter_to_xml_rate_gt( # nolint beautier function
241 +
        beautier::parameter_to_xml_rate_gt(
242 242
          site_model$rate_gt_param,
243 243
          which_name = "rate_name"
244 244
        )

@@ -4,16 +4,18 @@
Loading
4 4
#'   gamma site model
5 5
#' @author Richèl J.C. Bilderbeek
6 6
#' @examples
7 -
#'   testthat::expect_silent(
8 -
#'     beautier:::check_gamma_site_model(
9 -
#'       create_gamma_site_model()
10 -
#'     )
7 +
#' library(testthat)
8 +
#'
9 +
#' expect_silent(
10 +
#'   check_gamma_site_model(
11 +
#'     create_gamma_site_model()
11 12
#'   )
12 -
#'   testthat::expect_error(
13 -
#'     check_gamma_site_model(
14 -
#'       "not a gamma site model"
15 -
#'     )
13 +
#' )
14 +
#' expect_error(
15 +
#'   check_gamma_site_model(
16 +
#'     "not a gamma site model"
16 17
#'   )
18 +
#' )
17 19
#' @export
18 20
check_gamma_site_model <- function(gamma_site_model) {
19 21

@@ -3,25 +3,34 @@
Loading
3 3
#' @return TRUE if the name is a valid parameter name, FALSE otherwise
4 4
#' @author Richèl J.C. Bilderbeek
5 5
#' @examples
6 -
#'   testit::assert(beautier:::is_param_name("alpha"))
7 -
#'   testit::assert(beautier:::is_param_name("beta"))
8 -
#'   testit::assert(beautier:::is_param_name("clock_rate"))
9 -
#'   testit::assert(beautier:::is_param_name("kappa_1"))
10 -
#'   testit::assert(beautier:::is_param_name("kappa_2"))
11 -
#'   testit::assert(beautier:::is_param_name("lambda"))
12 -
#'   testit::assert(beautier:::is_param_name("m"))
13 -
#'   testit::assert(beautier:::is_param_name("mean"))
14 -
#'   testit::assert(beautier:::is_param_name("mu"))
15 -
#'   testit::assert(beautier:::is_param_name("rate_ac"))
16 -
#'   testit::assert(beautier:::is_param_name("rate_ag"))
17 -
#'   testit::assert(beautier:::is_param_name("rate_at"))
18 -
#'   testit::assert(beautier:::is_param_name("rate_cg"))
19 -
#'   testit::assert(beautier:::is_param_name("rate_ct"))
20 -
#'   testit::assert(beautier:::is_param_name("rate_gt"))
21 -
#'   testit::assert(beautier:::is_param_name("s"))
22 -
#'   testit::assert(beautier:::is_param_name("scale"))
23 -
#'   testit::assert(beautier:::is_param_name("sigma"))
24 -
#' @noRd
6 +
#' library(testthat)
7 +
#'
8 +
#' expect_true(is_param_name("alpha"))
9 +
#' expect_true(is_param_name("beta"))
10 +
#' expect_true(is_param_name("clock_rate"))
11 +
#' expect_true(is_param_name("kappa_1"))
12 +
#' expect_true(is_param_name("kappa_2"))
13 +
#' expect_true(is_param_name("lambda"))
14 +
#' expect_true(is_param_name("m"))
15 +
#' expect_true(is_param_name("mean"))
16 +
#' expect_true(is_param_name("mu"))
17 +
#' expect_true(is_param_name("rate_ac"))
18 +
#' expect_true(is_param_name("rate_ag"))
19 +
#' expect_true(is_param_name("rate_at"))
20 +
#' expect_true(is_param_name("rate_cg"))
21 +
#' expect_true(is_param_name("rate_ct"))
22 +
#' expect_true(is_param_name("rate_gt"))
23 +
#' expect_true(is_param_name("s"))
24 +
#' expect_true(is_param_name("scale"))
25 +
#' expect_true(is_param_name("sigma"))
26 +
#'
27 +
#' expect_false(is_param_name("nonsense"))
28 +
#' expect_false(is_param_name(NA))
29 +
#' expect_false(is_param_name(NULL))
30 +
#' expect_false(is_param_name(""))
31 +
#' expect_false(is_param_name(c()))
32 +
#' @export
25 33
is_param_name <- function(name) {
34 +
  if (length(name) == 0) return(FALSE)
26 35
  name %in% beautier::get_param_names()
27 36
}

@@ -3,35 +3,35 @@
Loading
3 3
#' @param section the XML section name
4 4
#' @return the section's lines of XML text, including the tags
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
extract_xml_section_from_lines <- function(
8 8
  lines,
9 9
  section
10 10
) {
11 11
  assertive::assert_is_a_string(section)
12 12
  if (section == "operators") {
13 -
    return(extract_xml_operators_from_lines(lines)) # nolint beautier function
13 +
    return(beautier::extract_xml_operators_from_lines(lines))
14 14
  }
15 15
  if (section == "loggers") {
16 16
    return(beautier::extract_xml_loggers_from_lines(lines))
17 17
  }
18 -
  if (!has_xml_opening_tag(lines = lines, section = section)) { # nolint beautier function
18 +
  if (!beautier::has_xml_opening_tag(lines = lines, section = section)) {
19 19
    stop(
20 20
      "Opening tag for 'section' could not be found in 'lines', ",
21 21
      "'section' has value '", section, "'"
22 22
    )
23 23
  }
24 -
  if (!has_xml_closing_tag(lines = lines, section = section)) { # nolint beautier function
24 +
  if (!beautier::has_xml_closing_tag(lines = lines, section = section)) {
25 25
    stop(
26 26
      "Closing tag for 'section' could not be found in 'lines', ",
27 27
      "'section' has value '", section, "'"
28 28
    )
29 29
  }
30 -
  from_index <- find_first_xml_opening_tag_line( # nolint beautier function
30 +
  from_index <- beautier::find_first_xml_opening_tag_line(
31 31
    lines = lines,
32 32
    section = section
33 33
  )
34 -
  to_index <- find_last_xml_closing_tag_line( # nolint beautier function
34 +
  to_index <- beautier::find_last_xml_closing_tag_line(
35 35
    lines = lines,
36 36
    section = section
37 37
  )

@@ -8,7 +8,7 @@
Loading
8 8
#' #'   # Here
9 9
#' # </logger>
10 10
#' @author Richèl J.C. Bilderbeek
11 -
#' @noRd
11 +
#' @export
12 12
mrca_priors_to_xml_tracelog <- function(
13 13
  clock_models,
14 14
  mrca_priors,

@@ -173,13 +173,13 @@
Loading
173 173
  if (beautier::is_one_double(clock_rate_param)) {
174 174
    clock_rate_param <- create_clock_rate_param(clock_rate_param)
175 175
  }
176 -
  if (!is_clock_rate_param(clock_rate_param)) { # nolint beautier function
176 +
  if (!beautier::is_clock_rate_param(clock_rate_param)) {
177 177
    stop(
178 178
      "'clock_rate_param' must be a clock rate parameter, ",
179 179
      "as can be created by 'create_clock_rate_param'"
180 180
    )
181 181
  }
182 -
  if (!is_distr(clock_rate_distr)) { # nolint beautier function
182 +
  if (!beautier::is_distr(clock_rate_distr)) {
183 183
    stop(
184 184
      "'clock_rate_distr' must be a distribution, ",
185 185
      "as can be created by 'create_distr'"

@@ -3,7 +3,7 @@
Loading
3 3
#' @return lines of text from the first to and including the last operators line
4 4
#' @author Richèl J.C. Bilderbeek
5 5
#' @export
6 -
extract_xml_loggers_from_lines <- function( # nolint beautier function
6 +
extract_xml_loggers_from_lines <- function(
7 7
  lines
8 8
) {
9 9
  first_line <- beautier::find_first_regex_line(lines, "<logger id=\"")

@@ -3,8 +3,8 @@
Loading
3 3
#' @inheritParams default_params_doc
4 4
#' @return lines of XML text
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
7 -
gamma_site_model_to_xml_prior_distr <- function( # nolint beautier function
6 +
#' @export
7 +
gamma_site_model_to_xml_prior_distr <- function( # nolint indeed long function name
8 8
  site_model
9 9
) {
10 10
  testit::assert(beautier::is_site_model(site_model))

@@ -1,5 +1,4 @@
Loading
1 1
#' Creates the map section of a BEAST2 XML parameter file
2 -
#' @inheritParams default_params_doc
3 2
#' @return lines of XML text
4 3
#' @author Richèl J.C. Bilderbeek
5 4
#' @export

@@ -4,7 +4,7 @@
Loading
4 4
#' @param param_id the first parameter's ID
5 5
#' @return a list of initialized MRCA priors
6 6
#' @author Richèl J.C. Bilderbeek
7 -
#' @noRd
7 +
#' @export
8 8
init_mrca_priors <- function(
9 9
  mrca_priors,
10 10
  distr_id = 0,

@@ -1,11 +1,10 @@
Loading
1 1
#' Creates the data section of a BEAST2 XML parameter file
2 +
#' @inheritParams default_params_doc
2 3
#' @param input_fasta_filename one FASTA filename
3 -
#' @param nucleotides_uppercase are the nucleotides written in uppercase?
4 -
#'   Yes if TRUE, no if FALSE
5 4
#' @return lines of XML text
6 5
#' @author Richèl J.C. Bilderbeek
7 -
#' @noRd
8 -
create_beast2_input_data_sequences <- function( # nolint beautier function
6 +
#' @export
7 +
create_beast2_input_data_sequences <- function( # nolint indeed long function name
9 8
  input_fasta_filename,
10 9
  beauti_options = create_beauti_options()
11 10
) {

@@ -9,7 +9,7 @@
Loading
9 9
#' #'   # Here
10 10
#' # </logger>
11 11
#' @author Richèl J.C. Bilderbeek
12 -
#' @noRd
12 +
#' @export
13 13
tree_models_to_xml_tracelog <- function(
14 14
  site_models
15 15
) {

@@ -1,6 +1,5 @@
Loading
1 1
#' See if x is one MRCA prior with a distribution
2 2
#' @param x the object to be tested
3 -
#' @inheritParams default_params_doc
4 3
#' @return TRUE if x is one MRCA prior with a distribution,
5 4
#'   FALSE otherwise
6 5
#' @author Richèl J.C. Bilderbeek

@@ -6,63 +6,53 @@
Loading
6 6
#' @examples
7 7
#' library(testthat)
8 8
#'
9 -
#' xml <- beautier:::parameter_to_xml(create_alpha_param(id = 1))
9 +
#' xml <- parameter_to_xml(create_alpha_param(id = 1))
10 10
#' expect_equal(length(xml), 1)
11 11
#' expect_true(nchar(xml) > 1)
12 12
#' @export
13 -
parameter_to_xml <- function(
13 +
parameter_to_xml <- function( # nolint simplifying further hurts readability
14 14
  parameter
15 15
) {
16 -
  text <- NULL
17 -
  id <- parameter$id
18 -
  if (!beautier::is_id(id)) {
19 -
    stop("parameter must have an ID")
20 -
  }
21 -
  testit::assert(!beautier::is_one_na(id))
22 -
  if (beautier::is_one_na(parameter$value)) {
23 -
    stop("parameter must have a value")
24 -
  }
16 +
  beautier::check_param(parameter)
17 +
  testit::assert(beautier::is_id(parameter$id))
25 18
  if (beautier::is_alpha_param(parameter)) {
26 -
    text <- c(text, parameter_to_xml_alpha(parameter)) # nolint beautier function
19 +
    return(beautier::parameter_to_xml_alpha(parameter))
27 20
  } else if (beautier::is_beta_param(parameter)) {
28 -
    text <- c(text, parameter_to_xml_beta(parameter)) # nolint beautier function
21 +
    return(beautier::parameter_to_xml_beta(parameter))
29 22
  } else if (beautier::is_clock_rate_param(parameter)) {
30 -
    text <- c(text, parameter_to_xml_clock_rate(parameter)) # nolint beautier function
23 +
    return(beautier::parameter_to_xml_clock_rate(parameter))
31 24
  } else if (beautier::is_kappa_1_param(parameter)) {
32 -
    text <- c(text, parameter_to_xml_kappa_1(parameter)) # nolint beautier function
25 +
    return(beautier::parameter_to_xml_kappa_1(parameter))
33 26
  } else if (beautier::is_kappa_2_param(parameter)) {
34 -
    text <- c(text, parameter_to_xml_kappa_2(parameter)) # nolint beautier function
27 +
    return(beautier::parameter_to_xml_kappa_2(parameter))
35 28
  } else if (beautier::is_lambda_param(parameter)) {
36 -
    text <- c(text, parameter_to_xml_lambda(parameter)) # nolint beautier function
29 +
    return(beautier::parameter_to_xml_lambda(parameter))
37 30
  } else if (beautier::is_m_param(parameter)) {
38 -
    text <- c(text, parameter_to_xml_m(parameter)) # nolint beautier function
31 +
    return(beautier::parameter_to_xml_m(parameter))
39 32
  } else if (beautier::is_mean_param(parameter)) {
40 -
    text <- c(text, parameter_to_xml_mean(parameter)) # nolint beautier function
33 +
    return(beautier::parameter_to_xml_mean(parameter))
41 34
  } else if (beautier::is_mu_param(parameter)) {
42 -
    text <- c(text, parameter_to_xml_mu(parameter)) # nolint beautier function
35 +
    return(beautier::parameter_to_xml_mu(parameter))
43 36
  } else if (beautier::is_rate_ac_param(parameter)) {
44 -
    text <- c(text, parameter_to_xml_rate_ac(parameter)) # nolint beautier function
37 +
    return(beautier::parameter_to_xml_rate_ac(parameter))
45 38
  } else if (beautier::is_rate_ag_param(parameter)) {
46 -
    text <- c(text, parameter_to_xml_rate_ag(parameter)) # nolint beautier function
39 +
    return(beautier::parameter_to_xml_rate_ag(parameter))
47 40
  } else if (beautier::is_rate_at_param(parameter)) {
48 -
    text <- c(text, parameter_to_xml_rate_at(parameter)) # nolint beautier function
41 +
    return(beautier::parameter_to_xml_rate_at(parameter))
49 42
  } else if (beautier::is_rate_cg_param(parameter)) {
50 -
    text <- c(text, parameter_to_xml_rate_cg(parameter)) # nolint beautier function
43 +
    return(beautier::parameter_to_xml_rate_cg(parameter))
51 44
  } else if (beautier::is_rate_ct_param(parameter)) {
52 -
    text <- c(text, parameter_to_xml_rate_ct(parameter)) # nolint beautier function
45 +
    return(beautier::parameter_to_xml_rate_ct(parameter))
53 46
  } else if (beautier::is_rate_gt_param(parameter)) {
54 -
    text <- c(text, parameter_to_xml_rate_gt(parameter)) # nolint beautier function
47 +
    return(beautier::parameter_to_xml_rate_gt(parameter))
55 48
  } else if (beautier::is_s_param(parameter)) {
56 -
    text <- c(text, parameter_to_xml_s(parameter)) # nolint beautier function
49 +
    return(beautier::parameter_to_xml_s(parameter))
57 50
  } else if (beautier::is_scale_param(parameter)) {
58 -
    text <- c(text, parameter_to_xml_scale(parameter)) # nolint beautier function
59 -
  } else {
60 -
    # This assert will also fail for new parameter types
61 -
    testit::assert(beautier::is_sigma_param(parameter)) # nolint beautier function
62 -
    text <- c(text, parameter_to_xml_sigma(parameter)) # nolint beautier function
51 +
    return(beautier::parameter_to_xml_scale(parameter))
63 52
  }
64 -
  testit::assert(beautier::is_xml(text))
65 -
  text
53 +
  # This assert will also fail for new parameter types
54 +
  testit::assert(beautier::is_sigma_param(parameter))
55 +
  beautier::parameter_to_xml_sigma(parameter)
66 56
}
67 57
68 58
#' Converts an alpha parameter to XML
@@ -72,6 +62,7 @@
Loading
72 62
#'   as created by \code{\link{create_alpha_param}})
73 63
#' @return the parameter as XML text
74 64
#' @author Richèl J.C. Bilderbeek
65 +
#' @export
75 66
parameter_to_xml_alpha <- function(
76 67
  parameter
77 68
) {
@@ -96,6 +87,7 @@
Loading
96 87
#'   as created by \code{\link{create_beta_param}})
97 88
#' @return the parameter as XML text
98 89
#' @author Richèl J.C. Bilderbeek
90 +
#' @export
99 91
parameter_to_xml_beta <- function(
100 92
  parameter
101 93
) {
@@ -120,6 +112,7 @@
Loading
120 112
#'   as created by \code{\link{create_clock_rate_param}})
121 113
#' @return the parameter as XML text
122 114
#' @author Richèl J.C. Bilderbeek
115 +
#' @export
123 116
parameter_to_xml_clock_rate <- function(
124 117
  parameter
125 118
) {
@@ -145,6 +138,7 @@
Loading
145 138
#'   as created by \code{\link{create_kappa_1_param}})
146 139
#' @return the parameter as XML text
147 140
#' @author Richèl J.C. Bilderbeek
141 +
#' @export
148 142
parameter_to_xml_kappa_1 <- function(
149 143
  parameter
150 144
) {
@@ -164,6 +158,7 @@
Loading
164 158
#'   as created by \code{\link{create_kappa_2_param}})
165 159
#' @return the parameter as XML text
166 160
#' @author Richèl J.C. Bilderbeek
161 +
#' @export
167 162
parameter_to_xml_kappa_2 <- function(
168 163
  parameter
169 164
) {
@@ -185,6 +180,7 @@
Loading
185 180
#'   as created by \code{\link{create_lambda_param}})
186 181
#' @return the parameter as XML text
187 182
#' @author Richèl J.C. Bilderbeek
183 +
#' @export
188 184
parameter_to_xml_lambda <- function(
189 185
  parameter
190 186
) {
@@ -206,6 +202,7 @@
Loading
206 202
#'   as created by \code{\link{create_m_param}})
207 203
#' @return the parameter as XML text
208 204
#' @author Richèl J.C. Bilderbeek
205 +
#' @export
209 206
parameter_to_xml_m <- function(
210 207
  parameter
211 208
) {
@@ -230,6 +227,7 @@
Loading
230 227
#'   as created by \code{\link{create_mean_param}})
231 228
#' @return the parameter as XML text
232 229
#' @author Richèl J.C. Bilderbeek
230 +
#' @export
233 231
parameter_to_xml_mean <- function(
234 232
  parameter
235 233
) {
@@ -254,6 +252,7 @@
Loading
254 252
#'   as created by \code{\link{create_mu_param}})
255 253
#' @return the parameter as XML text
256 254
#' @author Richèl J.C. Bilderbeek
255 +
#' @export
257 256
parameter_to_xml_mu <- function(
258 257
  parameter
259 258
) {
@@ -279,6 +278,7 @@
Loading
279 278
#' @param which_name the name, can be \code{state_node} or \code{rate_name}
280 279
#' @return the parameter as XML text
281 280
#' @author Richèl J.C. Bilderbeek
281 +
#' @export
282 282
parameter_to_xml_rate_ac <- function(
283 283
  parameter,
284 284
  which_name = "state_node"
@@ -311,6 +311,7 @@
Loading
311 311
#' @param which_name the name, can be \code{state_node} or \code{rate_name}
312 312
#' @return the parameter as XML text
313 313
#' @author Richèl J.C. Bilderbeek
314 +
#' @export
314 315
parameter_to_xml_rate_ag <- function(
315 316
  parameter,
316 317
  which_name = "state_node"
@@ -343,6 +344,7 @@
Loading
343 344
#' @param which_name the name, can be \code{state_node} or \code{rate_name}
344 345
#' @return the parameter as XML text
345 346
#' @author Richèl J.C. Bilderbeek
347 +
#' @export
346 348
parameter_to_xml_rate_at <- function(
347 349
  parameter,
348 350
  which_name = "state_node"
@@ -375,6 +377,7 @@
Loading
375 377
#' @param which_name the name, can be \code{state_node} or \code{rate_name}
376 378
#' @return the parameter as XML text
377 379
#' @author Richèl J.C. Bilderbeek
380 +
#' @export
378 381
parameter_to_xml_rate_cg <- function(
379 382
  parameter,
380 383
  which_name = "state_node"
@@ -407,6 +410,7 @@
Loading
407 410
#' @param which_name the name, can be \code{state_node} or \code{rate_name}
408 411
#' @return the parameter as XML text
409 412
#' @author Richèl J.C. Bilderbeek
413 +
#' @export
410 414
parameter_to_xml_rate_ct <- function(
411 415
  parameter,
412 416
  which_name = "state_node"
@@ -439,6 +443,7 @@
Loading
439 443
#' @param which_name the name, can be \code{state_node} or \code{rate_name}
440 444
#' @return the parameter as XML text
441 445
#' @author Richèl J.C. Bilderbeek
446 +
#' @export
442 447
parameter_to_xml_rate_gt <- function(
443 448
  parameter,
444 449
  which_name = "state_node"
@@ -470,6 +475,7 @@
Loading
470 475
#'   as created by \code{\link{create_s_param}})
471 476
#' @return the parameter as XML text
472 477
#' @author Richèl J.C. Bilderbeek
478 +
#' @export
473 479
parameter_to_xml_s <- function(
474 480
  parameter
475 481
) {
@@ -508,6 +514,7 @@
Loading
508 514
#'   as created by \code{\link{create_scale_param}})
509 515
#' @return the parameter as XML text
510 516
#' @author Richèl J.C. Bilderbeek
517 +
#' @export
511 518
parameter_to_xml_scale <- function(
512 519
  parameter
513 520
) {
@@ -532,6 +539,7 @@
Loading
532 539
#'   as created by \code{\link{create_sigma_param}})
533 540
#' @return the parameter as XML text
534 541
#' @author Richèl J.C. Bilderbeek
542 +
#' @export
535 543
parameter_to_xml_sigma <- function(
536 544
  parameter
537 545
) {

@@ -28,7 +28,7 @@
Loading
28 28
#' @return nothing
29 29
#' @seealso Use \link{create_mcmc} to create a valid MCMC
30 30
#' @author Richèl J.C. Bilderbeek
31 -
#' @noRd
31 +
#' @export
32 32
check_mcmc_list_element_names <- function(mcmc) {
33 33
34 34
  list_element_names <- c(
@@ -53,7 +53,7 @@
Loading
53 53
#' @return nothing
54 54
#' @seealso Use \link{create_mcmc} to create a valid MCMC
55 55
#' @author Richèl J.C. Bilderbeek
56 -
#' @noRd
56 +
#' @export
57 57
check_mcmc_values <- function(mcmc) {
58 58
59 59
  if (mcmc$chain_length <= 0) {

@@ -4,7 +4,7 @@
Loading
4 4
#' @return the clock models with the desired ID, NULL if such a clock model is
5 5
#'   absent
6 6
#' @author Richèl J.C. Bilderbeek
7 -
#' @noRd
7 +
#' @export
8 8
find_clock_model <- function(
9 9
  clock_models,
10 10
  id

@@ -22,7 +22,7 @@
Loading
22 22
  )[[1]]
23 23
24 24
  # Tree prior. TODO: remove plurals
25 -
  inference_model$tree_prior <- init_tree_priors( # nolint beautier function
25 +
  inference_model$tree_prior <- beautier::init_tree_priors(
26 26
    list(inference_model$tree_prior),
27 27
    ids = get_alignment_ids_from_fasta_filenames(
28 28
      fasta_filenames = input_filename
@@ -32,14 +32,14 @@
Loading
32 32
  )[[1]]
33 33
34 34
  # MRCA prior. TODO: remove plurals
35 -
  inference_model$mrca_prior <- init_mrca_priors( # nolint beautier function
35 +
  inference_model$mrca_prior <- beautier::init_mrca_priors(
36 36
    list(inference_model$mrca_prior),
37 37
    distr_id = 150,
38 38
    param_id = 300
39 39
  )[[1]]
40 40
41 41
  # Set the alignment ID and taxon names
42 -
  inference_model <- init_mrca_prior(input_filename, inference_model)
42 +
  inference_model <- beautier::init_mrca_prior(input_filename, inference_model)
43 43
44 44
  inference_model
45 45
}

@@ -5,38 +5,80 @@
Loading
5 5
#' @return nothing
6 6
#' @seealso Use \link{create_site_model} to create a valid site model
7 7
#' @examples
8 -
#'  testthat::expect_silent(check_site_model(create_jc69_site_model()))
9 -
#'  testthat::expect_silent(check_site_model(create_hky_site_model()))
10 -
#'  testthat::expect_silent(check_site_model(create_tn93_site_model()))
11 -
#'  testthat::expect_silent(check_site_model(create_gtr_site_model()))
8 +
#' library(testthat)
12 9
#'
13 -
#'  # Can use list of one site model
14 -
#'  testthat::expect_silent(check_site_model(list(create_jc69_site_model())))
10 +
#' expect_silent(check_site_model(create_jc69_site_model()))
11 +
#' expect_silent(check_site_model(create_hky_site_model()))
12 +
#' expect_silent(check_site_model(create_tn93_site_model()))
13 +
#' expect_silent(check_site_model(create_gtr_site_model()))
15 14
#'
16 -
#'  # List of two site models is not a/one site model
17 -
#'  testthat::expect_error(
15 +
#' # Can use list of one site model
16 +
#' expect_silent(check_site_model(list(create_jc69_site_model())))
17 +
#'
18 +
#' # List of two site models is not a/one site model
19 +
#' expect_error(
18 20
#'    check_site_model(
19 21
#'      list(create_jc69_site_model(), create_jc69_site_model())
20 22
#'    )
21 23
#'  )
22 24
#'
23 -
#'  # Must stop on non-site models
24 -
#'  testthat::expect_error(check_site_model(site_model = "nonsense"))
25 -
#'  testthat::expect_error(check_site_model(site_model = NULL))
26 -
#'  testthat::expect_error(check_site_model(site_model = NA))
25 +
#' # Must stop on non-site models
26 +
#' expect_error(check_site_model("nonsense"))
27 +
#' expect_error(check_site_model(NULL))
28 +
#' expect_error(check_site_model(NA))
29 +
#' expect_error(check_site_model(""))
30 +
#' expect_error(check_site_model(c()))
27 31
#' @author Richèl J.C. Bilderbeek
28 32
#' @export
29 33
check_site_model <- function(site_model) {
30 -
31 -
  if (beautier::is_site_model(site_model)) {
32 -
    return()
33 -
  }
34 -
  if (length(site_model) == 1 && beautier::is_site_model(site_model[[1]])) {
34 +
  if (length(site_model) == 1) {
35 +
    beautier::check_site_model_names(site_model[[1]])
36 +
    beautier::check_site_model_types(site_model[[1]])
35 37
    return()
36 38
  }
37 -
  stop(
38 -
    "'site_model' must be a valid site model.\n",
39 -
    "Actual value: ", site_model
39 +
  beautier::check_site_model_names(site_model)
40 +
  beautier::check_site_model_types(site_model)
41 +
}
42 +
43 +
#' Check if the \code{site_model} has the list elements
44 +
#' of a valid \code{site_model} object.
45 +
#'
46 +
#' Calls \code{stop} if an element is missing
47 +
#' @inheritParams default_params_doc
48 +
#' @return nothing
49 +
#' @seealso Use \link{create_site_model} to create a valid \code{site_model}
50 +
#' @author Richèl J.C. Bilderbeek
51 +
#' @export
52 +
check_site_model_names <- function(site_model) {
53 +
54 +
  list_element_names <- c(
55 +
    "name", "id", "gamma_site_model"
40 56
  )
57 +
  for (arg_name in list_element_names) {
58 +
    if (!arg_name %in% names(site_model)) {
59 +
      stop(
60 +
        "'", arg_name, "' must be an element of an 'site_model'. \n",
61 +
        "Tip: use 'create_site_model'"
62 +
      )
63 +
    }
64 +
  }
65 +
}
41 66
67 +
#' Check if the \code{site_model} has the list elements
68 +
#' of the right type for a valid \code{site_model} object.
69 +
#'
70 +
#' Calls \code{stop} if an element has the incorrect type
71 +
#' @inheritParams default_params_doc
72 +
#' @return nothing
73 +
#' @seealso Use \link{create_site_model} to create a valid \code{site_model}
74 +
#' @author Richèl J.C. Bilderbeek
75 +
#' @export
76 +
check_site_model_types <- function(site_model) {
77 +
78 +
  if (!beautier::is_site_model_name(site_model$name)) {
79 +
    stop("Invalid site model name. Actual value: '", site_model$name, "'")
80 +
  }
81 +
  if (!beautier::is_gamma_site_model(site_model$gamma_site_model)) {
82 +
    stop("Invalid 'site_model$gamma_site_model'")
83 +
  }
42 84
}

@@ -8,8 +8,8 @@
Loading
8 8
#' #'   # Here
9 9
#' # </logger>
10 10
#' @author Richèl J.C. Bilderbeek
11 -
#' @noRd
12 -
mrca_prior_to_xml_tracelog <- function( # nolint beautier function
11 +
#' @export
12 +
mrca_prior_to_xml_tracelog <- function(
13 13
  clock_models,
14 14
  mrca_prior,
15 15
  tipdates_filename = NA

@@ -19,14 +19,14 @@
Loading
19 19
  text <- c(text, "<log idref=\"posterior\"/>") # nolint this is no absolute path
20 20
  text <- c(text, "<log idref=\"likelihood\"/>") # nolint this is no absolute path
21 21
  text <- c(text, "<log idref=\"prior\"/>") # nolint this is no absolute path
22 -
  text <- c(text, tree_models_to_xml_tracelog(site_models)) # nolint beautier function
22 +
  text <- c(text, beautier::tree_models_to_xml_tracelog(site_models))
23 23
24 -
  site_models_xml <- site_models_to_xml_tracelog(site_models) # nolint beautier function
24 +
  site_models_xml <- beautier::site_models_to_xml_tracelog(site_models)
25 25
  if (!is.null(site_models_xml)) {
26 26
    text <- c(text, site_models_xml)
27 27
  }
28 28
29 -
  clock_models_xml <- clock_models_to_xml_tracelog( # nolint beautier function
29 +
  clock_models_xml <- beautier::clock_models_to_xml_tracelog(
30 30
    clock_models = clock_models,
31 31
    mrca_priors = mrca_priors
32 32
  )
@@ -34,10 +34,10 @@
Loading
34 34
    text <- c(text, clock_models_xml)
35 35
  }
36 36
37 -
  text <- c(text, tree_priors_to_xml_tracelog(tree_priors)) # nolint beautier function
37 +
  text <- c(text, beautier::tree_priors_to_xml_tracelog(tree_priors))
38 38
  text <- c(
39 39
    text,
40 -
    mrca_priors_to_xml_tracelog( # nolint beautier function
40 +
    beautier::mrca_priors_to_xml_tracelog(
41 41
      clock_models = clock_models,
42 42
      mrca_priors = mrca_priors,
43 43
      tipdates_filename = tipdates_filename

@@ -8,7 +8,7 @@
Loading
8 8
#' @examples
9 9
#' library(testthat)
10 10
#'
11 -
#' names <- beautier:::get_freq_equilibrium_names()
11 +
#' names <- get_freq_equilibrium_names()
12 12
#' expect_true("estimated" %in% names)
13 13
#' expect_true("empirical" %in% names)
14 14
#' expect_true("all_equal" %in% names)

@@ -3,14 +3,18 @@
Loading
3 3
#' @return the number of distributions a tree prior has
4 4
#' @author Richèl J.C. Bilderbeek
5 5
#' @examples
6 -
#'  testit::assert(
7 -
#'    beautier:::get_tree_priors_n_distrs(
8 -
#'      list(
9 -
#'        create_bd_tree_prior(), # has two distributions
10 -
#'        create_ccp_tree_prior() # has one distribution
11 -
#'      )
12 -
#'    ) == 3)
13 -
#' @noRd
6 +
#' library(testthat)
7 +
#'
8 +
#' expect_equal(
9 +
#'   get_tree_priors_n_distrs(
10 +
#'     list(
11 +
#'       create_bd_tree_prior(), # has two distributions
12 +
#'       create_ccp_tree_prior() # has one distribution
13 +
#'     )
14 +
#'   ),
15 +
#'   3
16 +
#' )
17 +
#' @export
14 18
get_tree_priors_n_distrs <- function(
15 19
  tree_priors
16 20
) {

@@ -8,8 +8,8 @@
Loading
8 8
#' #'   # Here
9 9
#' # </logger>
10 10
#' @author Richèl J.C. Bilderbeek
11 -
#' @noRd
12 -
tree_prior_to_xml_tracelog <- function( # nolint beautier function
11 +
#' @export
12 +
tree_prior_to_xml_tracelog <- function(
13 13
  tree_prior
14 14
) {
15 15
  testit::assert(beautier::is_tree_prior(tree_prior))

@@ -3,30 +3,22 @@
Loading
3 3
#' @return the number of distributions a tree prior has
4 4
#' @author Richèl J.C. Bilderbeek
5 5
#' @examples
6 -
#'  # birth_rate_distr and death_rate_distr
7 -
#'  testit::assert(
8 -
#'    beautier:::get_tree_prior_n_distrs(create_bd_tree_prior()) == 2
9 -
#'  )
6 +
#' library(testthat)
10 7
#'
11 -
#'  # none
12 -
#'  testit::assert(
13 -
#'    beautier:::get_tree_prior_n_distrs(create_cbs_tree_prior()) == 0
14 -
#'  )
8 +
#' # birth_rate_distr and death_rate_distr
9 +
#' expect_equal(get_tree_prior_n_distrs(create_bd_tree_prior()), 2)
10 +
#'
11 +
#' # none
12 +
#' expect_equal(get_tree_prior_n_distrs(create_cbs_tree_prior()), 0)
15 13
#'
16 14
#'  # pop_size_distr
17 -
#'  testit::assert(
18 -
#'    beautier:::get_tree_prior_n_distrs(create_ccp_tree_prior()) == 1
19 -
#'  )
15 +
#' expect_equal(get_tree_prior_n_distrs(create_ccp_tree_prior()), 1)
20 16
#'
21 17
#'  # pop_size_distr and growth_rate_distr
22 -
#'  testit::assert(
23 -
#'    beautier:::get_tree_prior_n_distrs(create_cep_tree_prior()) == 2
24 -
#'  )
18 +
#' expect_equal(get_tree_prior_n_distrs(create_cep_tree_prior()), 2)
25 19
#'
26 20
#'  # birth_rate_distr
27 -
#'  testit::assert(
28 -
#'    beautier:::get_tree_prior_n_distrs(create_yule_tree_prior()) == 1
29 -
#'  )
21 +
#' expect_equal(get_tree_prior_n_distrs(create_yule_tree_prior()), 1)
30 22
#' @export
31 23
get_tree_prior_n_distrs <- function(
32 24
  tree_prior

@@ -16,7 +16,7 @@
Loading
16 16
get_beautier_paths <- function(filenames) {
17 17
18 18
  for (i in seq_along(filenames)) {
19 -
    filenames[i] <- beautier::get_beautier_path(filenames[i]) # nolint beautier function
19 +
    filenames[i] <- beautier::get_beautier_path(filenames[i])
20 20
  }
21 21
22 22
  filenames

@@ -13,7 +13,7 @@
Loading
13 13
#'   section under investigation, so that a diff tool
14 14
#'   can compare these
15 15
#' @author Richèl J.C. Bilderbeek
16 -
#' @noRd
16 +
#' @export
17 17
compare_lines <- function(
18 18
  lines,
19 19
  expected,

@@ -8,7 +8,7 @@
Loading
8 8
#' #'   # Here
9 9
#' # </logger>
10 10
#' @author Richèl J.C. Bilderbeek
11 -
#' @noRd
11 +
#' @export
12 12
site_model_to_xml_tracelog <- function(
13 13
  site_model
14 14
) {

@@ -4,11 +4,11 @@
Loading
4 4
#' @return the line number's index (which is 1 for the first line) if the
5 5
#'   opening tag is found, else NA
6 6
#' @author Richèl J.C. Bilderbeek
7 -
#' @noRd
7 +
#' @export
8 8
find_last_xml_closing_tag_line <- function(
9 9
  lines,
10 10
  section
11 11
) {
12 12
  assertive::assert_is_a_string(section)
13 -
  find_last_regex_line(lines, paste0("</", section, ">")) # nolint beautier function
13 +
  beautier::find_last_regex_line(lines, paste0("</", section, ">"))
14 14
}

@@ -4,14 +4,12 @@
Loading
4 4
#' @return TRUE if there is an XML tag that also closes present in the lines
5 5
#'   of text, FALSE otherwise
6 6
#' @examples
7 -
#'   testit::assert(beautier:::has_xml_short_closing_tag("<my_tag id=1/>"))
8 -
#'   testit::assert(
9 -
#'     !beautier:::has_xml_short_closing_tag(
10 -
#'       "<my_tag id=1>text</my_tag>"
11 -
#'     )
12 -
#'   )
7 +
#' library(testthat)
8 +
#'
9 +
#' expect_true(has_xml_short_closing_tag("<my_tag id=1/>"))
10 +
#' expect_false(has_xml_short_closing_tag("<my_tag id=1>text</my_tag>"))
13 11
#' @author Richèl J.C. Bilderbeek
14 -
#' @noRd
12 +
#' @export
15 13
has_xml_short_closing_tag <- function(
16 14
  lines
17 15
) {

@@ -2,18 +2,20 @@
Loading
2 2
#' @param name the name to be tested
3 3
#' @return TRUE if the name is a valid distribution name, FALSE otherwise
4 4
#' @examples
5 -
#'   testit::assert(beautier:::is_distr_name("uniform"))
6 -
#'   testit::assert(beautier:::is_distr_name("normal"))
7 -
#'   testit::assert(beautier:::is_distr_name("one_div_x"))
8 -
#'   testit::assert(beautier:::is_distr_name("log_normal"))
9 -
#'   testit::assert(beautier:::is_distr_name("exponential"))
10 -
#'   testit::assert(beautier:::is_distr_name("gamma"))
11 -
#'   testit::assert(beautier:::is_distr_name("beta"))
12 -
#'   testit::assert(beautier:::is_distr_name("laplace"))
13 -
#'   testit::assert(beautier:::is_distr_name("inv_gamma"))
14 -
#'   testit::assert(beautier:::is_distr_name("poisson"))
5 +
#' library(testthat)
6 +
#'
7 +
#' expect_true(is_distr_name("uniform"))
8 +
#' expect_true(is_distr_name("normal"))
9 +
#' expect_true(is_distr_name("one_div_x"))
10 +
#' expect_true(is_distr_name("log_normal"))
11 +
#' expect_true(is_distr_name("exponential"))
12 +
#' expect_true(is_distr_name("gamma"))
13 +
#' expect_true(is_distr_name("beta"))
14 +
#' expect_true(is_distr_name("laplace"))
15 +
#' expect_true(is_distr_name("inv_gamma"))
16 +
#' expect_true(is_distr_name("poisson"))
15 17
#' @author Richèl J.C. Bilderbeek
16 -
#' @noRd
18 +
#' @export
17 19
is_distr_name <- function(name) {
18 20
  name %in% beautier::get_distr_names()
19 21
}

@@ -13,8 +13,8 @@
Loading
13 13
#'  #     </distribution>
14 14
#'  # </distribution>
15 15
#' @author Richèl J.C. Bilderbeek
16 -
#' @noRd
17 -
mrca_priors_to_xml_prior_distr <- function( # nolint beautier function
16 +
#' @export
17 +
mrca_priors_to_xml_prior_distr <- function(
18 18
  mrca_priors,
19 19
  has_non_strict_clock_model
20 20
) {

@@ -2,12 +2,14 @@
Loading
2 2
#' @inheritParams default_params_doc
3 3
#' @return the prefix of operator IDs, similar to the name of a tree prior
4 4
#' @examples
5 -
#'   bd_pre <- beautier:::get_operator_id_pre(
6 -
#'     tree_prior = create_bd_tree_prior()
7 -
#'   )
8 -
#'   testthat::expect_equal(bd_pre, "BirthDeath")
5 +
#' library(testthat)
6 +
#'
7 +
#' bd_pre <- get_operator_id_pre(
8 +
#'   tree_prior = create_bd_tree_prior()
9 +
#' )
10 +
#' expect_equal(bd_pre, "BirthDeath")
9 11
#' @author Richèl J.C. Bilderbeek
10 -
#' @noRd
12 +
#' @export
11 13
get_operator_id_pre <- function(tree_prior) {
12 14
  if (beautier::is_bd_tree_prior(tree_prior)) {
13 15
    return("BirthDeath")

@@ -31,7 +31,7 @@
Loading
31 31
  testit::assert(length(input_filename) == 1)
32 32
  testit::assert(file.exists(input_filename))
33 33
34 -
  text <- create_beast2_beast_xml( # nolint beautier function
34 +
  text <- beautier::create_beast2_beast_xml(
35 35
    beast2_version = inference_model$beauti_options$beast2_version,
36 36
    required = inference_model$beauti_options$required
37 37
  )

@@ -3,7 +3,7 @@
Loading
3 3
#' @inheritParams default_params_doc
4 4
#' @return a character vector of XML strings
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
clock_model_to_xml_operators <- function(
8 8
  clock_model,
9 9
  mrca_priors,

@@ -3,7 +3,7 @@
Loading
3 3
#' @inheritParams default_params_doc
4 4
#' @return the tree prior as XML text
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
mrca_prior_to_xml_state <- function(
8 8
  mrca_prior,
9 9
  has_non_strict_clock_model = FALSE

@@ -9,7 +9,7 @@
Loading
9 9
#'   FALSE otherwise
10 10
#' @seealso to check for equivalence, use \code{\link{are_equivalent_xml_files}}
11 11
#' @author Richèl J.C. Bilderbeek
12 -
#' @noRd
12 +
#' @export
13 13
are_equal_xml_files <- function(
14 14
  filename_1,
15 15
  filename_2,

@@ -31,7 +31,17 @@
Loading
31 31
      )
32 32
    }
33 33
  }
34 -
  beautier::check_site_model(inference_model$site_model)
34 +
  tryCatch(
35 +
    beautier::check_site_model(inference_model$site_model),
36 +
    error = function(e) {
37 +
      stop(
38 +
        "'site_model' must be a valid site model. \n",
39 +
        "Error: ", e$message, "\n",
40 +
        "Value: ", inference_model$site_model
41 +
      )
42 +
    }
43 +
  )
44 +
35 45
  tryCatch(
36 46
    beautier::check_clock_model(inference_model$clock_model),
37 47
    error = function(e) {

@@ -4,7 +4,7 @@
Loading
4 4
#'   TRUE will remove all surrounding whitespace
5 5
#' @return the lines with text
6 6
#' @author Richèl J.C. Bilderbeek
7 -
#' @noRd
7 +
#' @export
8 8
remove_empty_lines <- function(lines, trim = FALSE) {
9 9
  trimmed <- stringr::str_trim(lines)
10 10
  if (trim == FALSE) {

@@ -13,15 +13,15 @@
Loading
13 13
#'  #     </distribution>
14 14
#'  # </distribution>
15 15
#' @author Richèl J.C. Bilderbeek
16 -
#' @noRd
17 -
tree_priors_to_xml_prior_distr <- function( # nolint beautier function
16 +
#' @export
17 +
tree_priors_to_xml_prior_distr <- function(
18 18
  tree_priors
19 19
) {
20 20
  testit::assert(beautier::are_tree_priors(tree_priors))
21 21
22 22
  text <- NULL
23 23
  for (tree_prior in tree_priors) {
24 -
    text <- c(text, tree_prior_to_xml_prior_distr(tree_prior)) # nolint beautier function
24 +
    text <- c(text, beautier::tree_prior_to_xml_prior_distr(tree_prior))
25 25
  }
26 26
  text
27 27
}

@@ -32,13 +32,13 @@
Loading
32 32
      )
33 33
    }
34 34
  }
35 -
  if (!is_one_bool(beauti_options$capitalize_first_char_id)) { # nolint beautier function
35 +
  if (!beautier::is_one_bool(beauti_options$capitalize_first_char_id)) {
36 36
    stop(
37 37
      "'capitalize_first_char_id' must be one boolean. \n",
38 38
      "Actual value: ", beauti_options$capitalize_first_char_id
39 39
    )
40 40
  }
41 -
  if (!is_one_bool(beauti_options$nucleotides_uppercase)) { # nolint beautier function
41 +
  if (!beautier::is_one_bool(beauti_options$nucleotides_uppercase)) {
42 42
    stop(
43 43
      "'nucleotides_uppercase' must be one boolean. \n",
44 44
      "Actual value: ", beauti_options$nucleotides_uppercase

@@ -11,7 +11,7 @@
Loading
11 11
#'  #     <distribution id="likelihood" ...>
12 12
#'  #     </distribution>
13 13
#'  # </distribution>
14 -
#' @noRd
14 +
#' @export
15 15
clock_model_to_xml_prior_distr <- function(
16 16
  clock_model,
17 17
  mrca_priors = NA,
@@ -23,9 +23,12 @@
Loading
23 23
  if (beautier::is_rln_clock_model(clock_model)) {
24 24
25 25
    if (
26 -
      is_mrca_prior_with_distr(mrca_priors[[1]]) # nolint beautier function
26 +
      beautier::is_mrca_prior_with_distr(mrca_priors[[1]])
27 27
    ) {
28 -
      text <- c(text, rln_clock_model_to_xml_mean_rate_prior(clock_model)) # nolint beautier function
28 +
      text <- c(
29 +
        text,
30 +
        beautier::rln_clock_model_to_xml_mean_rate_prior(clock_model)
31 +
      )
29 32
    }
30 33
31 34
    id <- clock_model$id
@@ -35,7 +38,7 @@
Loading
35 38
      "x=\"@ucldStdev.c:", id, "\">"))
36 39
    text <- c(text,
37 40
      beautier::indent(
38 -
        distr_to_xml( # nolint beautier function
41 +
        beautier::distr_to_xml(
39 42
          distr = clock_model$ucldstdev_distr
40 43
        )
41 44
      )
@@ -52,7 +55,7 @@
Loading
52 55
        "name=\"distribution\" x=\"@clockRate.c:", id, "\">"))
53 56
      text <- c(text,
54 57
        beautier::indent(
55 -
          distr_to_xml( # nolint beautier function
58 +
          beautier::distr_to_xml(
56 59
            clock_model$clock_rate_distr
57 60
          )
58 61
        )

@@ -15,5 +15,5 @@
Loading
15 15
is_id <- function(
16 16
  x
17 17
) {
18 -
  assertive::is_a_string(x) || beautier::is_one_int(x) # nolint beautier function
18 +
  assertive::is_a_string(x) || beautier::is_one_int(x)
19 19
}

@@ -8,7 +8,7 @@
Loading
8 8
#' #'   # Here
9 9
#' # </logger>
10 10
#' @author Richèl J.C. Bilderbeek
11 -
#' @noRd
11 +
#' @export
12 12
clock_models_to_xml_tracelog <- function(
13 13
  clock_models,
14 14
  mrca_priors = NA
@@ -21,7 +21,7 @@
Loading
21 21
    testit::assert(beautier::is_clock_model(clock_model))
22 22
    text <- c(
23 23
      text,
24 -
      clock_model_to_xml_tracelog( # nolint beautier function
24 +
      beautier::clock_model_to_xml_tracelog(
25 25
        clock_model = clock_model,
26 26
        mrca_priors = mrca_priors
27 27
      )

@@ -3,7 +3,7 @@
Loading
3 3
#' @inheritParams default_params_doc
4 4
#' @return the site model as XML text
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
site_model_to_xml_state <- function(
8 8
  site_model
9 9
) {
@@ -25,22 +25,22 @@
Loading
25 25
    testit::assert("estimate" %in% names(site_model$rate_ct_param))
26 26
    testit::assert("estimate" %in% names(site_model$rate_gt_param))
27 27
    if (site_model$rate_ac_param$estimate == TRUE) {
28 -
      text <- c(text, parameter_to_xml(site_model$rate_ac_param)) # nolint beautier function
28 +
      text <- c(text, beautier::parameter_to_xml(site_model$rate_ac_param))
29 29
    }
30 30
    if (site_model$rate_ag_param$estimate == TRUE) {
31 -
      text <- c(text, parameter_to_xml(site_model$rate_ag_param)) # nolint beautier function
31 +
      text <- c(text, beautier::parameter_to_xml(site_model$rate_ag_param))
32 32
    }
33 33
    if (site_model$rate_at_param$estimate == TRUE) {
34 -
      text <- c(text, parameter_to_xml(site_model$rate_at_param)) # nolint beautier function
34 +
      text <- c(text, beautier::parameter_to_xml(site_model$rate_at_param))
35 35
    }
36 36
    if (site_model$rate_cg_param$estimate == TRUE) {
37 -
      text <- c(text, parameter_to_xml(site_model$rate_cg_param)) # nolint beautier function
37 +
      text <- c(text, beautier::parameter_to_xml(site_model$rate_cg_param))
38 38
    }
39 39
    if (site_model$rate_ct_param$estimate == TRUE) {
40 -
      text <- c(text, parameter_to_xml(site_model$rate_ct_param)) # nolint beautier function
40 +
      text <- c(text, beautier::parameter_to_xml(site_model$rate_ct_param))
41 41
    }
42 42
    if (site_model$rate_gt_param$estimate == TRUE) {
43 -
      text <- c(text, parameter_to_xml(site_model$rate_gt_param)) # nolint beautier function
43 +
      text <- c(text, beautier::parameter_to_xml(site_model$rate_gt_param))
44 44
    }
45 45
  } else if (beautier::is_hky_site_model(site_model)) {
46 46
    site_model$kappa_param$id <- id
@@ -50,15 +50,15 @@
Loading
50 50
  } else if (beautier::is_tn93_site_model(site_model)) {
51 51
    if (site_model$kappa_1_param$estimate == TRUE) {
52 52
      site_model$kappa_1_param$id <- id
53 -
      text <- c(text, parameter_to_xml(site_model$kappa_1_param)) # nolint beautier function
53 +
      text <- c(text, beautier::parameter_to_xml(site_model$kappa_1_param))
54 54
    }
55 55
    if (site_model$kappa_2_param$estimate == TRUE) {
56 56
      site_model$kappa_2_param$id <- id
57 -
      text <- c(text, parameter_to_xml(site_model$kappa_2_param)) # nolint beautier function
57 +
      text <- c(text, beautier::parameter_to_xml(site_model$kappa_2_param))
58 58
    }
59 59
  }
60 60
61 -
  if (!is_jc69_site_model(site_model)) { # nolint beautier function
61 +
  if (!beautier::is_jc69_site_model(site_model)) {
62 62
    text <- c(
63 63
      text,
64 64
      paste0(
@@ -72,7 +72,7 @@
Loading
72 72
73 73
  text <- c(
74 74
    text,
75 -
    gamma_site_model_to_xml_state(site_model$gamma_site_model, id) # nolint beautier function
75 +
    beautier::gamma_site_model_to_xml_state(site_model$gamma_site_model, id)
76 76
  )
77 77
  text
78 78
}

@@ -6,7 +6,7 @@
Loading
6 6
#' @param df a data frame with two columns
7 7
#' @return the trait set string
8 8
#' @author Richèl J.C. Bilderbeek
9 -
#' @noRd
9 +
#' @export
10 10
create_trait_set_string <- function(
11 11
  df
12 12
) {

@@ -2,7 +2,7 @@
Loading
2 2
#' @param fasta_filename One existing FASTA filenames
3 3
#' @return a table of sequences
4 4
#' @author Richèl J.C. Bilderbeek
5 -
#' @noRd
5 +
#' @export
6 6
fasta_file_to_sequences <- function(fasta_filename) {
7 7
  beautier::check_file_exists(fasta_filename, "fasta_filename")
8 8

@@ -3,7 +3,7 @@
Loading
3 3
#' @inheritParams default_params_doc
4 4
#' @return the site model as XML text
5 5
#' @author Richèl J.C. Bilderbeek
6 -
#' @noRd
6 +
#' @export
7 7
site_model_to_xml_prior_distr <- function(
8 8
  site_model
9 9
) {

@@ -8,6 +8,7 @@
Loading
8 8
#'     these are set by reading these from the alignment file
9 9
#' }
10 10
#' @inheritParams default_params_doc
11 +
#' @export
11 12
init_mrca_prior <- function(
12 13
  input_filename,
13 14
  inference_model

@@ -6,7 +6,7 @@
Loading
6 6
#'   FALSE otherwise
7 7
#' @seealso to check for equality, use \code{are_equal_xml_files}
8 8
#' @author Richèl J.C. Bilderbeek
9 -
#' @noRd
9 +
#' @export
10 10
are_equivalent_xml_files <- function(
11 11
  filename_1,
12 12
  filename_2,
@@ -103,10 +103,14 @@
Loading
103 103
) {
104 104
  assertive::assert_is_a_string(section)
105 105
  if (section == "operators") {
106 -
    return(are_equivalent_xml_lines_operators(lines_1, lines_2, verbose)) # nolint beautier function
106 +
    return(
107 +
      beautier::are_equivalent_xml_lines_operators(lines_1, lines_2, verbose)
108 +
    )
107 109
  }
108 110
  if (section == "loggers") {
109 -
    return(are_equivalent_xml_lines_loggers(lines_1, lines_2, verbose)) # nolint beautier function
111 +
    return(
112 +
      beautier::are_equivalent_xml_lines_loggers(lines_1, lines_2, verbose)
113 +
    )
110 114
  }
111 115
  if (!has_xml_opening_tag(lines = lines_1, section = section)) {
112 116
    stop(
@@ -136,7 +140,9 @@
Loading
136 140
    lines = lines_1, section = section)
137 141
  section_2 <- extract_xml_section_from_lines(
138 142
    lines = lines_2, section = section)
139 -
  are_equivalent_xml_lines_all(section_1, section_2, verbose = verbose) # nolint beautier function
143 +
  beautier::are_equivalent_xml_lines_all(
144 +
    section_1, section_2, verbose = verbose
145 +
  )
140 146
}
141 147
142 148
#' Determine if XML operator lines result in equivalent trees
@@ -146,7 +152,8 @@
Loading
146 152
#' @return TRUE if the two XML lines result in equivalent trees,
147 153
#'   FALSE otherwise
148 154
#' @author Richèl J.C. Bilderbeek
149 -
are_equivalent_xml_lines_operators <- function( # nolint don't care about internal function length
155 +
#' @export
156 +
are_equivalent_xml_lines_operators <- function( # nolint indeed long function name
150 157
  lines_1,
151 158
  lines_2,
152 159
  verbose = FALSE
@@ -165,6 +172,7 @@
Loading
165 172
#' @return TRUE if the two XML lines result in equivalent trees,
166 173
#'   FALSE otherwise
167 174
#' @author Richèl J.C. Bilderbeek
175 +
#' @export
168 176
are_equivalent_xml_lines_loggers <- function(# nolint don't care about internal function length
169 177
  lines_1,
170 178
  lines_2,

@@ -4,7 +4,7 @@
Loading
4 4
#' @param param_id the first parameter's ID
5 5
#' @return a list of initialized site models
6 6
#' @author Richèl J.C. Bilderbeek
7 -
#' @noRd
7 +
#' @export
8 8
init_site_models <- function(
9 9
  site_models,
10 10
  ids,
@@ -26,21 +26,21 @@
Loading
26 26
      )
27 27
    } else if (beautier::is_hky_site_model(site_model)) {
28 28
      # HKY
29 -
      site_model <- init_hky_site_model( # nolint beautier function call
29 +
      site_model <- beautier::init_hky_site_model(
30 30
        site_model,
31 31
        distr_id = distr_id,
32 32
        param_id = param_id
33 33
      )
34 34
    } else if (beautier::is_jc69_site_model(site_model)) {
35 35
      # JC69
36 -
      site_model <- init_jc69_site_model( # nolint beautier function call
36 +
      site_model <- beautier::init_jc69_site_model(
37 37
        site_model,
38 38
        distr_id = distr_id,
39 39
        param_id = param_id
40 40
      )
41 41
    } else {
42 42
      testit::assert(beautier::is_tn93_site_model(site_model))
43 -
      site_model <- init_tn93_site_model( # nolint beautier function call
43 +
      site_model <- beautier::init_tn93_site_model(
44 44
        site_model,
45 45
        distr_id = distr_id,
46 46
        param_id = param_id
@@ -98,8 +98,8 @@
Loading
98 98
    }
99 99
  }
100 100
101 -
  if (!is_init_distr(gtr_site_model$rate_ac_prior_distr)) { # nolint beautier function
102 -
    gtr_site_model$rate_ac_prior_distr <- init_distr( # nolint beautier function
101 +
  if (!beautier::is_init_distr(gtr_site_model$rate_ac_prior_distr)) {
102 +
    gtr_site_model$rate_ac_prior_distr <- beautier::init_distr(
103 103
      gtr_site_model$rate_ac_prior_distr,
104 104
      distr_id = distr_id,
105 105
      param_id = param_id
@@ -109,8 +109,8 @@
Loading
109 109
      gtr_site_model$rate_ac_prior_distr
110 110
    )
111 111
  }
112 -
  if (!is_init_distr(gtr_site_model$rate_ag_prior_distr)) { # nolint beautier function
113 -
    gtr_site_model$rate_ag_prior_distr <- init_distr( # nolint beautier function
112 +
  if (!beautier::is_init_distr(gtr_site_model$rate_ag_prior_distr)) {
113 +
    gtr_site_model$rate_ag_prior_distr <- beautier::init_distr(
114 114
      gtr_site_model$rate_ag_prior_distr,
115 115
      distr_id = distr_id,
116 116
      param_id = param_id
@@ -120,8 +120,8 @@
Loading
120 120
      gtr_site_model$rate_ag_prior_distr
121 121
    )
122 122
  }
123 -
  if (!is_init_distr(gtr_site_model$rate_at_prior_distr)) { # nolint beautier function
124 -
    gtr_site_model$rate_at_prior_distr <- init_distr( # nolint beautier function
123 +
  if (!beautier::is_init_distr(gtr_site_model$rate_at_prior_distr)) {
124 +
    gtr_site_model$rate_at_prior_distr <- beautier::init_distr(
125 125
      gtr_site_model$rate_at_prior_distr,
126 126
      distr_id = distr_id,
127 127
      param_id = param_id
@@ -131,8 +131,8 @@
Loading
131 131
      gtr_site_model$rate_at_prior_distr
132 132
    )
133 133
  }
134 -
  if (!is_init_distr(gtr_site_model$rate_cg_prior_distr)) { # nolint beautier function
135 -
    gtr_site_model$rate_cg_prior_distr <- init_distr( # nolint beautier function
134 +
  if (!beautier::is_init_distr(gtr_site_model$rate_cg_prior_distr)) {
135 +
    gtr_site_model$rate_cg_prior_distr <- beautier::init_distr(
136 136
      gtr_site_model$rate_cg_prior_distr,
137 137
      distr_id = distr_id,
138 138
      param_id = param_id
@@ -207,10 +207,13 @@
Loading
207 207
#' @return an initialized HKY site model
208 208
#' @author Richèl J.C. Bilderbeek
209 209
#' @examples
210 -
#'   hky_site_model <- create_hky_site_model()
211 -
#'   testit::assert(!beautier:::is_init_hky_site_model(hky_site_model))
212 -
#'   hky_site_model <- beautier:::init_hky_site_model(hky_site_model)
213 -
#'   testit::assert(beautier:::is_init_hky_site_model(hky_site_model))
210 +
#' library(testthat)
211 +
#'
212 +
#' hky_site_model <- create_hky_site_model()
213 +
#' expect_false(is_init_hky_site_model(hky_site_model))
214 +
#' hky_site_model <- init_hky_site_model(hky_site_model)
215 +
#' expect_true(is_init_hky_site_model(hky_site_model))
216 +
#' @export
214 217
init_hky_site_model <- function(
215 218
  hky_site_model,
216 219
  distr_id = 0,
@@ -266,10 +269,12 @@
Loading
266 269
#' @return an initialized HKY site model
267 270
#' @author Richèl J.C. Bilderbeek
268 271
#' @examples
269 -
#'   hky_site_model <- create_hky_site_model()
270 -
#'   testit::assert(!beautier:::is_init_hky_site_model(hky_site_model))
271 -
#'   hky_site_model <- beautier:::init_hky_site_model(hky_site_model)
272 -
#'   testit::assert(beautier:::is_init_hky_site_model(hky_site_model))
272 +
#' library(testthat)
273 +
#'
274 +
#' hky_site_model <- create_hky_site_model()
275 +
#' expect_false(is_init_hky_site_model(hky_site_model))
276 +
#' hky_site_model <- init_hky_site_model(hky_site_model)
277 +
#' expect_true(is_init_hky_site_model(hky_site_model))
273 278
#' @export
274 279
init_jc69_site_model <- function(
275 280
  jc69_site_model,

@@ -10,8 +10,8 @@
Loading
10 10
#' @inheritParams default_params_doc
11 11
#' @return a character vector of XML strings
12 12
#' @author Richèl J.C. Bilderbeek
13 -
#' @noRd
14 -
clock_models_to_xml_prior_distr <- function( # nolint beautier function
13 +
#' @export
14 +
clock_models_to_xml_prior_distr <- function( # nolint indeed long function name
15 15
  clock_models,
16 16
  mrca_priors = NA,
17 17
  tipdates_filename = NA
@@ -22,7 +22,7 @@
Loading
22 22
    clock_model <- clock_models[[i]]
23 23
    text <- c(
24 24
      text,
25 -
      clock_model_to_xml_prior_distr( # nolint beautier function
25 +
      beautier::clock_model_to_xml_prior_distr(
26 26
        clock_model = clock_model,
27 27
        mrca_priors = mrca_priors,
28 28
        tipdates_filename = tipdates_filename

@@ -4,7 +4,7 @@
Loading
4 4
#' @return lines of XML text, without indentation nor \code{state}
5 5
#'   tags
6 6
#' @author Richèl J.C. Bilderbeek
7 -
#' @noRd
7 +
#' @export
8 8
clock_models_to_xml_state <- function(
9 9
  clock_models,
10 10
  mrca_priors = NA,
@@ -36,7 +36,7 @@
Loading
36 36
  if (beautier::is_rln_clock_model(clock_models[[1]]) &&
37 37
      !beautier::is_mrca_prior_with_distr(mrca_priors[[1]])) {
38 38
    # A RLN clock model returns three lines, only remove the first
39 -
    line_to_remove <- clock_model_to_xml_state(clock_models[[1]]) # nolint
39 +
    line_to_remove <- beautier::clock_model_to_xml_state(clock_models[[1]]