From a26d3a5f5fc54ac6a3e95fd5f01d8685e0e77fb3 Mon Sep 17 00:00:00 2001 From: John Harrold Date: Sat, 25 May 2024 10:49:26 -0700 Subject: [PATCH] Stripped out some more monolix/nonmem stuff from the perl build script Removed som myOrg stuff and added NONMEM and Monolix from rxode output Updated the test system file to make everythign work. --- R/ubiquity.r | 119 ++++++++++++++++++++------- inst/ubinc/perl/build_system.pl | 108 ++++++++---------------- inst/ubinc/scripts/ubiquity_fcns.R | 119 ++++++++++++++++++++------- inst/ubinc/systems/system-mab_pk.txt | 2 +- 4 files changed, 211 insertions(+), 137 deletions(-) diff --git a/R/ubiquity.r b/R/ubiquity.r index b156f0b..f9a0c17 100644 --- a/R/ubiquity.r +++ b/R/ubiquity.r @@ -662,10 +662,9 @@ system_fetch_template <- function(cfg, template="Simulation", overwrite=FALSE, "ShinyApp", "Shiny Rmd Report", "NCA", "mrgsolve", - "myOrg", "Model Diagram", "Berkeley Madonna", - "Adapt", "nlmixr", + "Adapt", "nlmixr2", "NONMEM", "Monolix", "mrgsolve") @@ -736,40 +735,95 @@ system_fetch_template <- function(cfg, template="Simulation", overwrite=FALSE, destinations = c("system_adapt.for", "system_adapt.prm") write_file = c(TRUE, TRUE) } - if(template == "myOrg"){ - sources = c(file.path(template_dir, sprintf("report.yaml"))) - destinations = c("myOrg.yaml") - write_file = c(TRUE) - } - if(template == "Model Diagram"){ sources = c(file.path(template_dir, sprintf("system.svg"))) destinations = c("system.svg") write_file = c(TRUE) } - if(template == "NONMEM"){ - sources = c(file.path(temp_directory, sprintf("target_nonmem-%s.ctl",current_set))) - destinations = c("system_nonmem.ctl") - write_file = c(TRUE, TRUE) - } - if(template == "Monolix"){ - sources = c(file.path(temp_directory, sprintf("target_monolix-%s.txt",current_set))) - destinations = c("system_monolix.txt") - write_file = c(TRUE, TRUE) + if(template == "NONMEM" || template == "Monolix" ){ + deps_found = TRUE + # Walking through the dependencies to make sure everything is needed + if(system.file(package="rxode2") == ""){ + isgood = FALSE + deps_found = FALSE + vp(cfg, paste0("The rxode2 package is needed to create ", template, " template.")) + } + if(system.file(package="babelmixr2") == ""){ + isgood = FALSE + deps_found = FALSE + vp(cfg, paste0("The babelmixr2 package is needed to create ", template, " template.")) + } + + if(deps_found){ + nlmixr_file = file.path(temp_directory, sprintf("target_nlmixr-%s.R",current_set)) + cmd = c('require(rxode2)', + 'require(babelmixr2)', + 'source(nlmixr_file)', + 'my_rx = my_model()', + 'capture = list()') + if(template == "NONMEM"){ + cmd = c(cmd, + 'ctl_file = tempfile(fileext=".ctl")', + 'tmpstr = as.character(my_rx$nonmemModel)', + 'fileConn = file(ctl_file)', + 'writeLines(tmpstr, fileConn)', + 'close(fileConn)', + 'capture[["sources"]] = c(ctl_file)', + 'capture[["destinations"]] = c("system_nonmem.ctl")', + 'capture[["write_file"]] = c(TRUE)') + } + if(template == "Monolix"){ + cmd = c(cmd, + 'mlxtran_file = tempfile(fileext=".mlxtran")', + 'tmpstr = as.character(my_rx$mlxtran)', + 'fileConn = file(mlxtran_file)', + 'writeLines(tmpstr, fileConn)', + 'close(fileConn)', + 'mlxtxt_file = tempfile(fileext=".txt")', + 'tmpstr = as.character(my_rx$monolixModel)', + 'fileConn = file(mlxtxt_file)', + 'writeLines(tmpstr, fileConn)', + 'close(fileConn)', + 'capture[["sources"]] = c(mlxtran_file, mlxtxt_file)', + 'capture[["destinations"]] = c("system_monolix.mlxtran", "system_monolix.txt")', + 'capture[["write_file"]] = c(TRUE, TRUE)') + } + + + tcres = tryCatch( + { + eval(parse(text=paste0(cmd, collapse="\n"))) + list(capture=capture,isgood=TRUE) + }, + error = function(e) { + list(error=e, isgood=FALSE) + }) + + if(tcres[["isgood"]]){ + sources = tcres[["capture"]][["sources"]] + destinations = tcres[["capture"]][["destinations"]] + write_file = tcres[["capture"]][["write_file"]] + } else { + vp(cfg, as.character(tcres$error), fmt="danger") + isgood=FALSE + } + } } - if(template == "nlmixr"){ + if(template == "nlmixr2"){ sources = c(file.path(temp_directory, sprintf("target_nlmixr-%s.R",current_set))) - destinations = c("system_nlmixr.R") - write_file = c(TRUE, TRUE) + destinations = c("system_nlmixr2.R") + write_file = c(TRUE) } # if overwrite ifs FALSE we check each of the destination files to see if # they exist. Then we set write_file to FALSE if they do exist, and throw # up an error. if(!overwrite){ - for(fidx in 1:length(destinations)){ - if(file.exists(file.path(output_directory, destinations[fidx]))){ - write_file[fidx] = FALSE + if(!is.null(destinations)){ + for(fidx in 1:length(destinations)){ + if(file.exists(file.path(output_directory, destinations[fidx]))){ + write_file[fidx] = FALSE + } } } } @@ -779,16 +833,17 @@ system_fetch_template <- function(cfg, template="Simulation", overwrite=FALSE, res$destinations = destinations res$write_file = write_file - # next we write the files that are TRUE - for(fidx in 1:length(destinations)){ - if(write_file[fidx]){ - file.copy(sources[fidx], file.path(output_directory, destinations[fidx]), overwrite=TRUE) - vp(cfg, sprintf("Creating file: %s", file.path(output_directory, destinations[fidx]))) - } else { - isgood = FALSE - vp(cfg, sprintf("File: %s, exists, and was not copied.", file.path(output_directory, destinations[fidx]))) - vp(cfg, sprintf("Set overwrite=TRUE to force this file to be copied.")) + if(!is.null(destinations)){ + for(fidx in 1:length(destinations)){ + if(write_file[fidx]){ + file.copy(sources[fidx], file.path(output_directory, destinations[fidx]), overwrite=TRUE) + vp(cfg, sprintf("Creating file: %s", file.path(output_directory, destinations[fidx]))) + } else { + isgood = FALSE + vp(cfg, sprintf("File: %s, exists, and was not copied.", file.path(output_directory, destinations[fidx]))) + vp(cfg, sprintf("Set overwrite=TRUE to force this file to be copied.")) + } } } } else { diff --git a/inst/ubinc/perl/build_system.pl b/inst/ubinc/perl/build_system.pl index d86ad1f..3a17088 100644 --- a/inst/ubinc/perl/build_system.pl +++ b/inst/ubinc/perl/build_system.pl @@ -364,12 +364,6 @@ if(($line =~ '') or ($line =~ '')){ $cfg = &parse_data_file($cfg, $line); } - # - # NONMEM specific options - # - if($line =~ '{files}->{adapt} = 'target_adapt_5'; $cfg->{files}->{mrgsolve} = 'target_mrgsolve'; - $cfg->{files}->{nonmem} = 'target_nonmem'; - $cfg->{files}->{monolix} = 'target_monolix'; # berkeley_madonna output $cfg->{files}->{reserved_words} = 'system_help_reserved_words.txt'; @@ -512,9 +504,6 @@ sub fetch_cfg @{$cfg->{outputs_index}} = (); $cfg->{options} = {}; $cfg->{options}->{output_times} = 'SIMINT_SEQ[0][10][.1]'; - $cfg->{options}->{nonmem}->{input}->{drop} = {}; - $cfg->{options}->{nonmem}->{input}->{rename} = {}; - $cfg->{options}->{nonmem}->{data} = ''; $cfg->{options}->{amtify}->{cmt_to_amt} = {}; $cfg->{options}->{amtify}->{cmt_to_rel} = {}; $cfg->{options}->{amtify}->{vol} = {}; @@ -591,12 +580,6 @@ sub fetch_cfg ROOTTOL => 'insensitive' , TIME => 'insensitive' }, - 'Monolix' => { - pop_ => 'start' , - }, - 'Nonmem' => { - 'S\d+' => 'start' , - }, 'R-project' => { 'NA' => 'exact', 'if' => 'exact', @@ -813,14 +796,11 @@ sub dump_nlmixr } else { if(grep( /^$pname$/, @{$cfg->{options}->{est}->{lt}})){ $m_ele->{SYSTEM_PARAMS_TV} .= $indent."TV_".$pname.&fetch_padding($pname, $cfg->{parameters_length}).' = log('.$pvstr.")\n"; - $pname_trans = "exp(TV_$pname)"; } else { $m_ele->{SYSTEM_PARAMS_TV} .= $indent."TV_".$pname.&fetch_padding($pname, $cfg->{parameters_length}).' = '.$pvstr."\n"; - $pname_trans = "TV_$pname"; } + $pname_trans = "TV_$pname"; } - - # I the model portion we create the actual named parameters: if(!grep( /^$pname$/, @{$cfg->{parameters_variance_index}})){ @@ -829,6 +809,15 @@ sub dump_nlmixr # This creates the algebraic relationnship between the IIV term and # the typical value: $tv_trans = &make_iiv($cfg, $pname, 'rproject', $parameter_set); + + # IF the parameter is log transformed and the distribution is log + # normal we move the parameter name into the exponential to make + # mu-referencing work correctly + my $distribution = $cfg->{iiv}->{$parameter_set}->{parameters}->{$pname}->{distribution}; + if(grep( /^$pname$/, @{$cfg->{options}->{est}->{lt}}) and $distribution eq 'LN'){ + $tv_trans =~ s#SIMINT_PARAMETER_TV\*##g; + $tv_trans =~ s#SIMINT_IIV_VALUE#SIMINT_PARAMETER_TV + SIMINT_IIV_VALUE#g; + } $tv_trans =~ s#SIMINT_PARAMETER_TV#$pname_trans#g; $tv_trans =~ s#SIMINT_IIV_VALUE#$cfg->{iiv}->{$iiv_set}->{parameters}->{$pname}->{iiv_name}#g; $m_ele->{SYSTEM_PARAMS} .= $tv_trans."\n"; @@ -4198,32 +4187,6 @@ sub apply_format } -sub parse_nonmem_options -{ - my ($cfg, $line) = @_; - - $line =~ s#\s##g; - - my $col; - my $value; - - if($line =~ m#.*#$1#; - $cfg->{options}->{nonmem}->{input}->{drop}->{$line} = 'yes'; - } - if($line =~ m#.*#$1#; - $value =~ s#(.*)#$1#; - $cfg->{options}->{nonmem}->{input}->{rename}->{$col} = $value; - } - if($line =~ m##){ - $line =~ s#\s*##; - $cfg->{options}->{nonmem}->{data} .= $line."\n"; - } - return $cfg; -} sub parse_est_p { @@ -6156,31 +6119,32 @@ sub system_check{ # If both a data set and covariates are specified we check to see if the # columns in the dataset have those covariates specified - if((@{$cfg->{covariates_index}}) - and ($cfg->{data}->{file} ne "")){ - - # first we get a list of all the columns that are being used in NONMEM. We - # iterate through all of the columns in the data file - foreach $name (@{$cfg->{data}->{headers}->{values}}){ - #Checking first to see if the column has been renamed - if(defined($cfg->{options}->{nonmem}->{input}->{rename}->{$name})){ - # we put the renamed column on the list of data columns - push @nmdatacols, $cfg->{options}->{nonmem}->{input}->{rename}->{$name}; - } - else{ - #otherwise we just add the column name - push @nmdatacols, $name; } - } - - my $tmpstring = ":::".join(':::', @nmdatacols).":::"; - - # next we loop through each covariate and see if it's in the list of - # nonmem data columns - foreach $name (@{$cfg->{covariates_index}}){ - if(not($tmpstring =~ m#:::${name}:::#)){ - &mywarn("The covariate: $name was specified but not defined in dataset"); } - } - } +# JMH removed this because I'm pretty sure it was only used for nonmem +# if((@{$cfg->{covariates_index}}) +# and ($cfg->{data}->{file} ne "")){ +# +# # first we get a list of all the columns that are being used in NONMEM. We +# # iterate through all of the columns in the data file +# foreach $name (@{$cfg->{data}->{headers}->{values}}){ +# #Checking first to see if the column has been renamed +# if(defined($cfg->{options}->{nonmem}->{input}->{rename}->{$name})){ +# # we put the renamed column on the list of data columns +# push @nmdatacols, $cfg->{options}->{nonmem}->{input}->{rename}->{$name}; +# } +# else{ +# #otherwise we just add the column name +# push @nmdatacols, $name; } +# } +# +# my $tmpstring = ":::".join(':::', @nmdatacols).":::"; +# +# # next we loop through each covariate and see if it's in the list of +# # nonmem data columns +# foreach $name (@{$cfg->{covariates_index}}){ +# if(not($tmpstring =~ m#:::${name}:::#)){ +# &mywarn("The covariate: $name was specified but not defined in dataset"); } +# } +# } # Checking time scales if(exists($cfg->{time_scales})){ diff --git a/inst/ubinc/scripts/ubiquity_fcns.R b/inst/ubinc/scripts/ubiquity_fcns.R index b156f0b..f9a0c17 100644 --- a/inst/ubinc/scripts/ubiquity_fcns.R +++ b/inst/ubinc/scripts/ubiquity_fcns.R @@ -662,10 +662,9 @@ system_fetch_template <- function(cfg, template="Simulation", overwrite=FALSE, "ShinyApp", "Shiny Rmd Report", "NCA", "mrgsolve", - "myOrg", "Model Diagram", "Berkeley Madonna", - "Adapt", "nlmixr", + "Adapt", "nlmixr2", "NONMEM", "Monolix", "mrgsolve") @@ -736,40 +735,95 @@ system_fetch_template <- function(cfg, template="Simulation", overwrite=FALSE, destinations = c("system_adapt.for", "system_adapt.prm") write_file = c(TRUE, TRUE) } - if(template == "myOrg"){ - sources = c(file.path(template_dir, sprintf("report.yaml"))) - destinations = c("myOrg.yaml") - write_file = c(TRUE) - } - if(template == "Model Diagram"){ sources = c(file.path(template_dir, sprintf("system.svg"))) destinations = c("system.svg") write_file = c(TRUE) } - if(template == "NONMEM"){ - sources = c(file.path(temp_directory, sprintf("target_nonmem-%s.ctl",current_set))) - destinations = c("system_nonmem.ctl") - write_file = c(TRUE, TRUE) - } - if(template == "Monolix"){ - sources = c(file.path(temp_directory, sprintf("target_monolix-%s.txt",current_set))) - destinations = c("system_monolix.txt") - write_file = c(TRUE, TRUE) + if(template == "NONMEM" || template == "Monolix" ){ + deps_found = TRUE + # Walking through the dependencies to make sure everything is needed + if(system.file(package="rxode2") == ""){ + isgood = FALSE + deps_found = FALSE + vp(cfg, paste0("The rxode2 package is needed to create ", template, " template.")) + } + if(system.file(package="babelmixr2") == ""){ + isgood = FALSE + deps_found = FALSE + vp(cfg, paste0("The babelmixr2 package is needed to create ", template, " template.")) + } + + if(deps_found){ + nlmixr_file = file.path(temp_directory, sprintf("target_nlmixr-%s.R",current_set)) + cmd = c('require(rxode2)', + 'require(babelmixr2)', + 'source(nlmixr_file)', + 'my_rx = my_model()', + 'capture = list()') + if(template == "NONMEM"){ + cmd = c(cmd, + 'ctl_file = tempfile(fileext=".ctl")', + 'tmpstr = as.character(my_rx$nonmemModel)', + 'fileConn = file(ctl_file)', + 'writeLines(tmpstr, fileConn)', + 'close(fileConn)', + 'capture[["sources"]] = c(ctl_file)', + 'capture[["destinations"]] = c("system_nonmem.ctl")', + 'capture[["write_file"]] = c(TRUE)') + } + if(template == "Monolix"){ + cmd = c(cmd, + 'mlxtran_file = tempfile(fileext=".mlxtran")', + 'tmpstr = as.character(my_rx$mlxtran)', + 'fileConn = file(mlxtran_file)', + 'writeLines(tmpstr, fileConn)', + 'close(fileConn)', + 'mlxtxt_file = tempfile(fileext=".txt")', + 'tmpstr = as.character(my_rx$monolixModel)', + 'fileConn = file(mlxtxt_file)', + 'writeLines(tmpstr, fileConn)', + 'close(fileConn)', + 'capture[["sources"]] = c(mlxtran_file, mlxtxt_file)', + 'capture[["destinations"]] = c("system_monolix.mlxtran", "system_monolix.txt")', + 'capture[["write_file"]] = c(TRUE, TRUE)') + } + + + tcres = tryCatch( + { + eval(parse(text=paste0(cmd, collapse="\n"))) + list(capture=capture,isgood=TRUE) + }, + error = function(e) { + list(error=e, isgood=FALSE) + }) + + if(tcres[["isgood"]]){ + sources = tcres[["capture"]][["sources"]] + destinations = tcres[["capture"]][["destinations"]] + write_file = tcres[["capture"]][["write_file"]] + } else { + vp(cfg, as.character(tcres$error), fmt="danger") + isgood=FALSE + } + } } - if(template == "nlmixr"){ + if(template == "nlmixr2"){ sources = c(file.path(temp_directory, sprintf("target_nlmixr-%s.R",current_set))) - destinations = c("system_nlmixr.R") - write_file = c(TRUE, TRUE) + destinations = c("system_nlmixr2.R") + write_file = c(TRUE) } # if overwrite ifs FALSE we check each of the destination files to see if # they exist. Then we set write_file to FALSE if they do exist, and throw # up an error. if(!overwrite){ - for(fidx in 1:length(destinations)){ - if(file.exists(file.path(output_directory, destinations[fidx]))){ - write_file[fidx] = FALSE + if(!is.null(destinations)){ + for(fidx in 1:length(destinations)){ + if(file.exists(file.path(output_directory, destinations[fidx]))){ + write_file[fidx] = FALSE + } } } } @@ -779,16 +833,17 @@ system_fetch_template <- function(cfg, template="Simulation", overwrite=FALSE, res$destinations = destinations res$write_file = write_file - # next we write the files that are TRUE - for(fidx in 1:length(destinations)){ - if(write_file[fidx]){ - file.copy(sources[fidx], file.path(output_directory, destinations[fidx]), overwrite=TRUE) - vp(cfg, sprintf("Creating file: %s", file.path(output_directory, destinations[fidx]))) - } else { - isgood = FALSE - vp(cfg, sprintf("File: %s, exists, and was not copied.", file.path(output_directory, destinations[fidx]))) - vp(cfg, sprintf("Set overwrite=TRUE to force this file to be copied.")) + if(!is.null(destinations)){ + for(fidx in 1:length(destinations)){ + if(write_file[fidx]){ + file.copy(sources[fidx], file.path(output_directory, destinations[fidx]), overwrite=TRUE) + vp(cfg, sprintf("Creating file: %s", file.path(output_directory, destinations[fidx]))) + } else { + isgood = FALSE + vp(cfg, sprintf("File: %s, exists, and was not copied.", file.path(output_directory, destinations[fidx]))) + vp(cfg, sprintf("Set overwrite=TRUE to force this file to be copied.")) + } } } } else { diff --git a/inst/ubinc/systems/system-mab_pk.txt b/inst/ubinc/systems/system-mab_pk.txt index 68ac985..f6bd38d 100644 --- a/inst/ubinc/systems/system-mab_pk.txt +++ b/inst/ubinc/systems/system-mab_pk.txt @@ -104,7 +104,7 @@ prop_err 0.1 eps inf -- yes Variance add_err 0.1 eps inf ng/ml yes Variance - Vp; Vc; CL; Q + Vp; Vc; CL; Q; ka Vp; Vc; CL; Q; ka; add_err; prop_err add=add_err; prop=prop_err Cp; Ap; Vp