Skip to content

Commit

Permalink
Stripped out some more monolix/nonmem stuff from the perl build script
Browse files Browse the repository at this point in the history 
Removed som myOrg stuff and added NONMEM and Monolix from rxode output

Updated the test system file to make everythign work.
  • Loading branch information
@john-harrold
john-harrold committed May 25, 2024
1 parent 7a0d3d1 commit a26d3a5
Show file tree
Hide file tree
Showing 4 changed files with 211 additions and 137 deletions.
119 changes: 87 additions & 32 deletions R/ubiquity.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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")

Expand Down Expand Up @@ -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
}
}
}
}
Expand All @@ -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 {
Expand Down
108 changes: 36 additions & 72 deletions inst/ubinc/perl/build_system.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -364,12 +364,6 @@
if(($line =~ '<DATA:FILE:CSV>') or ($line =~ '<DATA:HEADER:.*>')){
$cfg = &parse_data_file($cfg, $line); }

#
# NONMEM specific options
#
if($line =~ '<NONMEM:'){
$cfg = &parse_nonmem_options($cfg, $line); }

}

# creating the file:
Expand Down Expand Up @@ -473,8 +467,6 @@ sub fetch_cfg
$cfg->{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';
Expand Down Expand Up @@ -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} = {};
Expand Down Expand Up @@ -591,12 +580,6 @@ sub fetch_cfg
ROOTTOL => 'insensitive' ,
TIME => 'insensitive'
},
'Monolix' => {
pop_ => 'start' ,
},
'Nonmem' => {
'S\d+' => 'start' ,
},
'R-project' => {
'NA' => 'exact',
'if' => 'exact',
Expand Down Expand Up @@ -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}})){
Expand All @@ -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";
Expand Down Expand Up @@ -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#<NONMEM:INPUT:DROP:#){
$line =~ s#<NONMEM:INPUT:DROP:(.*)>.*#$1#;
$cfg->{options}->{nonmem}->{input}->{drop}->{$line} = 'yes';
}
if($line =~ m#<NONMEM:INPUT:RENAME#){
$col = $line;
$value = $line;
$col =~ s#<NONMEM:INPUT:RENAME:(.*)>.*#$1#;
$value =~ s#<NONMEM:INPUT:RENAME:.*>(.*)#$1#;
$cfg->{options}->{nonmem}->{input}->{rename}->{$col} = $value;
}
if($line =~ m#<NONMEM:DATA>#){
$line =~ s#<NONMEM:DATA>\s*##;
$cfg->{options}->{nonmem}->{data} .= $line."\n";
}
return $cfg;
}

sub parse_est_p
{
Expand Down Expand Up @@ -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})){
Expand Down
Loading

0 comments on commit a26d3a5

Please sign in to comment.