ggPMXdevelopment / ggPMX

ggPMX R package
37 stars 13 forks source link

Duplicate controller creation takes on properties of last created controller #346

Closed mattfidler closed 1 year ago

mattfidler commented 1 year ago
library(ggPMX)
#> Registered S3 method overwritten by 'GGally':
#>   method from   
#>   +.gg   ggplot2
library(testthat)
theophylline <- file.path(
  system.file(package = "ggPMX"), "testdata",
  "theophylline"
)

WORK_DIR <- file.path(theophylline, "Monolix")
input_file <- file.path(theophylline, "data_pk.csv")

my_settings <- pmx_settings(
  use.labels = TRUE,
  cats.labels = list(SEX = c("0" = "Male", "1" = "Female"), STUD = c("1" = "S", "2" = "D")),
  effects = list(levels = c("ka", "V", "Cl"), labels = c("Absorption_rate", "Volume", "Clearance")),
  covariates = pmx_cov(
    values = list("WT0", "AGE0"),
    labels = list("Weight", "Age")
  )
)

ctr <- pmx_mlx(
  config = "standing",
  directory = WORK_DIR,
  input = input_file,
  dv = "Y",
  dvid = "DVID",
  cats = c("SEX"),
  conts = c("WT0", "AGE0"),
  strats = "SEX",
  settings = my_settings,
  )
#> Warning: The `facets` argument of `facet_grid()` is deprecated as of ggplot2 2.2.0.
#> ℹ Please use the `rows` argument instead.
#> ℹ The deprecated feature was likely used in the ggPMX package.
#>   Please report the issue at
#>   <https://github.com/ggPMXdevelopment/ggPMX/issues>.
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.

p0 <- ctr %>% pmx_plot_eta_hist(strat.facet = ~STUD)
rlang::quo_text(p0$facet$params$rows) == "structure(list(EFFECT = ~EFFECT), class = c(\"quosures\", \"list\"\n))"
#> [1] TRUE

p <- ctr %>% pmx_plot_eta_box(strat.facet = SEX ~ STUD)
expect_true(inherits(p$facet$params$rows, "quosures"))

expect_true(rlang::quo_text(p$facet$params$rows) == "structure(list(SEX = ~SEX), class = c(\"quosures\", \"list\"))")
expect_true(rlang::quo_text(p$facet$params$cols) == "structure(list(STUD = ~STUD), class = c(\"quosures\", \"list\"))")

expect_true(all(unique(p$data$EFFECT) %in% c("Absorption_rate", "Volume", "Clearance")))

p_effect <- ctr %>% pmx_plot_eta_conts()
expect_true(all(unique(p_effect$data$variable) %in% c("WT0", "AGE0")))
#> Error: all(unique(p_effect$data$variable) %in% c("WT0", "AGE0")) is not TRUE
#> 
#> `actual`:   FALSE
#> `expected`: TRUE

p_cov <- ctr %>% pmx_plot_eta_conts(
                   covariates = pmx_cov(
                     values = list("WT0", "AGE0"),
                     labels = list("Weight", "Age")
                   )
                 )
expect_true(all(unique(p_cov$data$variable) %in% c("Weight", "Age")))

# now recreate the exact same controller 

my_settings <- pmx_settings(
  use.labels = TRUE,
  cats.labels = list(SEX = c("0" = "Male", "1" = "Female"), STUD = c("1" = "S", "2" = "D")),
  effects = list(levels = c("ka", "V", "Cl"), labels = c("Absorption_rate", "Volume", "Clearance")),
  covariates = pmx_cov(
    values = list("WT0", "AGE0"),
    labels = list("Weight", "Age")
  )
)

ctr <- pmx_mlx(
  config = "standing",
  directory = WORK_DIR,
  input = input_file,
  dv = "Y",
  dvid = "DVID",
  cats = c("SEX"),
  conts = c("WT0", "AGE0"),
  strats = "SEX",
  settings = my_settings,
  )

p0 <- ctr %>% pmx_plot_eta_hist(strat.facet = ~STUD)
rlang::quo_text(p0$facet$params$rows) == "structure(list(EFFECT = ~EFFECT), class = c(\"quosures\", \"list\"\n))"
#> [1] TRUE

p <- ctr %>% pmx_plot_eta_box(strat.facet = SEX ~ STUD)
expect_true(inherits(p$facet$params$rows, "quosures"))

expect_true(rlang::quo_text(p$facet$params$rows) == "structure(list(SEX = ~SEX), class = c(\"quosures\", \"list\"))")
expect_true(rlang::quo_text(p$facet$params$cols) == "structure(list(STUD = ~STUD), class = c(\"quosures\", \"list\"))")

expect_true(all(unique(p$data$EFFECT) %in% c("Absorption_rate", "Volume", "Clearance")))

p_effect <- ctr %>% pmx_plot_eta_conts()
expect_true(all(unique(p_effect$data$variable) %in% c("WT0", "AGE0")))
#> Error: all(unique(p_effect$data$variable) %in% c("WT0", "AGE0")) is not TRUE
#> 
#> `actual`:   FALSE
#> `expected`: TRUE

Created on 2023-04-10 with reprex v2.0.2

mattfidler commented 1 year ago

Not the issue. In the reprex it is picking up a label that hasn't been defined yet