fix: resolved variable name issues in harrington_1986 and uller_2019

R/json.R

@@ -61,14 +61,24 @@ citation_to_json <- function(citation) {
 #' @param variables A list containing variables, via `response` or `covariates`
 #'  slots of a model
 #' @return A list of parsed variables
-variables_to_json <- function(variables) {
+variables_to_json <- function(variables, variable_descriptions = list()) {
   variable_names <- names(variables)
   out <- list()
 
-  for(i in 1:length(variables)) {
+  for (i in seq_along(variables)) {
+    variable_name <- variable_names[[i]]
+
+    if(variable_name %in% names(variable_descriptions)) {
+      description <- variable_descriptions[[variable_name]]
+    } else {
+      def <- allometric::get_variable_def(variable_name, return_exact_only = TRUE)
+      description <- as.character(def$description[[1]])
+    }
+
     out[[i]] <- list(
       name = variable_names[[i]],
-      unit = allometric:::parse_unit_str(variables[i])
+      unit = allometric:::parse_unit_str(variables[i]),
+      description = description
     )
   }
 
@@ -240,30 +250,29 @@ model_to_json <- function(model) {
   model_descriptors <- allometric::descriptors(model)
   model_class <- as.character(class(model))
 
-  response_definition <- ifelse(
-    is.na(model@response_definition), "", model@response_definition
+
+  res_defs <- ifelse(
+    is.na(model@response_definition),
+    list(),
+    model@response_definition
   )
 
+  if(!is.null(names(res_defs))) {
+    browser()
+  }
+
   required <- list(
     "_id" = jsonlite::unbox(model_id),
     pub_id = jsonlite::unbox(model@pub_id),
     model_type = jsonlite::unbox(allometric:::get_model_type(names(model@response))[[1]]),
     model_class = jsonlite::unbox(model_class),
-    response = unbox_nested(variables_to_json(model@response))[[1]],
-    covariates = unbox_nested(variables_to_json(model@covariates)),
+    response = unbox_nested(variables_to_json(model@response, res_defs))[[1]],
+    covariates = unbox_nested(variables_to_json(model@covariates, model@covariate_definitions)),
     descriptors = descriptors_to_json(model_descriptors),
     parameters = unbox_nonnested(as.list(model@parameters)),
     predict_fn_body = parse_func_body(model@predict_fn)
   )
 
-  if(!is.na(model@response_definition)) {
-    required[["response_definition"]] <- jsonlite::unbox(response_definition)
-  }
-
-  if(!length(model@covariate_definitions) == 0) {
-    required[["covariate_definitions"]] <- covariate_definitions_to_json(model@covariate_definitions)
-  }
-
   required
 }
 

publications/f_j/harrington_1986.R

@@ -22,7 +22,7 @@ harrington_1986 <- Publication(
 
 hstix20 <- FixedEffectsModel(
   response = list(
-    hstix = units::as_units("ft")
+    hstix20 = units::as_units("ft")
   ),
   covariates = list(
     hst = units::as_units("ft"),

publications/u_z/uller_2019.R

@@ -112,16 +112,16 @@ mod_7 <- FixedEffectsModel(
   response = list(bt = units::as_units("kg")),
   covariates = list(
     dsob = units::as_units("cm"),
-    rsd = units::as_units("kg / m^3")
+    rws = units::as_units("kg / m^3")
   ),
   parameters = list(
     beta_0 = -9.0086,
     beta_1 = 2.4606,
     beta_2 = 1.0895,
     bcf = 1.0206
   ),
-  predict_fn = function(dsob, rsd) {
-    exp(log(beta_0) + beta_1 * log(dsob) + beta_2 * log(rsd)) * bcf
+  predict_fn = function(dsob, rws) {
+    exp(log(beta_0) + beta_1 * log(dsob) + beta_2 * log(rws)) * bcf
   }
 )
 
@@ -130,14 +130,14 @@ mod_8 <- FixedEffectsModel(
   covariates = list(
     dsob = units::as_units("cm"),
     hst = units::as_units("m"),
-    rsd = units::as_units("kg / m^3")
+    rws = units::as_units("kg / m^3")
   ),
   parameters = list(
     beta_0 = 10.2861,
     beta_1 = 0.00005
   ),
-  predict_fn = function(dsob, hst, rsd) {
-    beta_0 + beta_1 * (dsob^2 * hst * rsd)
+  predict_fn = function(dsob, hst, rws) {
+    beta_0 + beta_1 * (dsob^2 * hst * rws)
   }
 )
 
@@ -146,15 +146,15 @@ mod_9 <- FixedEffectsModel(
   covariates = list(
     dsob = units::as_units("cm"),
     hst = units::as_units("m"),
-    rsd = units::as_units("kg / m^3")
+    rws = units::as_units("kg / m^3")
   ),
   parameters = list(
     beta_0 = -9.1954,
     beta_1 = 0.9561,
     bcf = 1.0209
   ),
-  predict_fn = function(dsob, hst, rsd) {
-    exp(log(beta_0) + beta_1 * log(dsob^2 * hst * rsd)) * bcf
+  predict_fn = function(dsob, hst, rws) {
+    exp(log(beta_0) + beta_1 * log(dsob^2 * hst * rws)) * bcf
   }
 )
 
@@ -163,7 +163,7 @@ mod_10 <- FixedEffectsModel(
   covariates = list(
     dsob = units::as_units("cm"),
     hst = units::as_units("m"),
-    rsd = units::as_units("kg / m^3")
+    rws = units::as_units("kg / m^3")
   ),
   parameters = list(
     beta_0 = -8.8907,
@@ -172,9 +172,9 @@ mod_10 <- FixedEffectsModel(
     beta_3 = 0.9999,
     bcf = 1.0175
   ),
-  predict_fn = function(dsob, hst, rsd) {
+  predict_fn = function(dsob, hst, rws) {
     exp(log(beta_0) + beta_1 * log(dsob) + beta_2 * log(hst) +
-      beta_3 * log(rsd)) * bcf
+      beta_3 * log(rws)) * bcf
   }
 )
 

tests/testthat/test-json.R

@@ -53,8 +53,11 @@ test_that("variables_to_json returns correct value", {
 
   expect_equal(parsed[[1]][["name"]], "hst")
   expect_equal(parsed[[1]][["unit"]], "m")
-
+  expect_equal(parsed[[1]][["description"]], "total height of the stem")
   expect_equal(length(parsed), 1)
+
+  parsed <- variables_to_json(variables, list("hst" = "something else"))
+  expect_equal(parsed[[1]][["description"]], "something else")
 })
 
 test_that("unbox nested unboxes a nested list", {