andrewhooker · mattfidler · Oct 24, 2024 · Oct 24, 2024 · Oct 24, 2024 · Oct 24, 2024
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -30,3 +30,5 @@
 ^\.github$
 ^vignettes/articles$
 ^CRAN-SUBMISSION$
+^\.positai$
+^\.claude$
diff --git a/.gitignore b/.gitignore
@@ -7,3 +7,4 @@ PopED_output_summary_mfea_opt_1.txt
 inst/doc
 .DS_Store
 docs
+.positai
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -32,7 +32,8 @@ Suggests:
     gridExtra,
     covr,
     devtools,
-    mrgsolve
+    mrgsolve,
+    babelmixr2
 Authors@R: c(
     person("Andrew C.","Hooker", email="andrew.hooker@farmaci.uu.se", 
       role=c("aut","cre","trl","cph"),
@@ -58,7 +59,7 @@ URL: https://andrewhooker.github.io/PopED/, https://github.com/andrewhooker/PopE
 BugReports: https://github.com/andrewhooker/PopED/issues
 Copyright: 2014-2021 Andrew C. Hooker
 Encoding: UTF-8
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 VignetteBuilder: knitr
 Config/Needs/website:
     mrgsolve,

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,7 @@
 # PopED (development version)
 
+* Make parallelization work with `babelmixr2` models on windows (#79)
+
 # PopED 0.7.0
 
 * `create.poped.database()` now uses a better method of identifying the total number of parameters of each type (bpop, d, sigma, etc.) in a user defined model parameter function (the `ff_fun` argument in `create.poped.database()`) (#73).

diff --git a/R/Doptim.R b/R/Doptim.R
@@ -74,7 +74,6 @@ Doptim <- function(poped.db,ni, xt, model_switch, x, a, bpopdescr,
                    iter_max=10,
                    ...){
 
-
   ## update poped.db with options supplied in function
   called_args <- match.call()
   default_args <- formals()

diff --git a/R/LinMatrixH.R b/R/LinMatrixH.R
@@ -23,7 +23,8 @@
 ## Function translated automatically using 'matlab.to.r()'
 ## Author: Andrew Hooker
 
-LinMatrixH <- function(model_switch,xt_ind,x,a,bpop,b_ind,bocc_ind,poped.db){
+LinMatrixH <- function(model_switch,xt_ind,x,a,bpop,b_ind,bocc_ind,
+poped.db){
   #----------Model linearization with respect to epsilon.
   #
   # size of return is (samples per individual x number of epsilons) 

diff --git a/R/LinMatrixL.R b/R/LinMatrixL.R
@@ -22,7 +22,6 @@
 ## Author: Andrew Hooker
 
 LinMatrixL <- function(model_switch,xt_ind,x,a,bpop,b_ind,bocc_ind,poped.db){
-
   if((poped.db$parameters$NumRanEff==0)){
     y=0
   } else {

diff --git a/R/LinMatrixLH.R b/R/LinMatrixLH.R
@@ -56,6 +56,7 @@ LinMatrixLH <- function(model_switch,xt_ind,x,a,bpop,b_ind,bocc_ind,NumEPS,poped
 
 #Helper function to get the hessian for the AD derivative
 new_ferror_file <- function(model_switch,deriv_vec,xt_ind,x,a,bpop,bocc_ind,poped.db){
+
   fg0=feval(poped.db$model$fg_pointer,x,a,bpop,deriv_vec(1:poped.db$parameters$NumRanEff),bocc_ind) #Interaction
   returnArgs <- feval(poped.db$model$ferror_pointer,model_switch,xt_ind,fg0,deriv_vec(poped.db$parameters$NumRanEff+1:length(deriv_vec)),poped.db) 
   f_error <- returnArgs[[1]]

diff --git a/R/RS_opt.R b/R/RS_opt.R
@@ -74,7 +74,6 @@ RS_opt <- function(poped.db,
                        compute_inv=TRUE,
                        ...){
 
-
   # Only get inputs that are needed, not double inputs
   # needed inputs to function: get first then run function
   # poped.db$settings$cfaxt     0.001

diff --git a/R/blockexp.R b/R/blockexp.R
@@ -25,7 +25,7 @@
 blockexp <- function(fn,poped.db,e_flag=FALSE,
                      opt_xt=poped.db$settings$optsw[2],opt_a=poped.db$settings$optsw[4],opt_x=poped.db$settings$optsw[4],
                      opt_samps=poped.db$settings$optsw[1],opt_inds=poped.db$settings$optsw[5]){
-  
+
   fprintf(fn,'==============================================================================\n')
   fprintf(fn,'Model description : %s \n',poped.db$settings$modtit)
   fprintf(fn,'\n')
@@ -155,6 +155,7 @@ blockexp <- function(fn,poped.db,e_flag=FALSE,
 }
 
 print_params <- function (params,name_str, fn, poped.db, param_sqrt=FALSE,head_txt=NULL,matrix_elements=F,e_flag=FALSE) {
+
   if(is.null(head_txt)) head_txt <- "Parameter Values"
   uncer_txt <- ""
   if(e_flag) uncer_txt <- " (Uncertainty Distribution)"

diff --git a/R/blockopt.R b/R/blockopt.R
@@ -20,7 +20,7 @@
 ## Author: Andrew Hooker
 
 blockopt <- function(fn,poped.db,opt_method=""){
-  
+
   if(any(opt_method==c("RS","SG","DO"))){
     fprintf(fn,'==============================================================================\n')
     fprintf(fn,'Optimization Settings\n\n')
@@ -50,4 +50,4 @@ blockopt <- function(fn,poped.db,opt_method=""){
     fprintf(fn,"\n")
   }
   return( ) 
-}
+}
diff --git a/R/calc_ofv_and_fim.R b/R/calc_ofv_and_fim.R
@@ -47,7 +47,8 @@ calc_ofv_and_fim <- function (poped.db,
                               ofv_fun = poped.db$settings$ofv_fun,
                               evaluate_fim = TRUE,
                               ...) {
-
+
+
   ## compute the OFV
   if((ofv==0)){
     if(d_switch){ 
@@ -177,4 +178,4 @@ calc_ofv_and_fim <- function (poped.db,
     fim <- fmf
   }
   return(list(ofv=ofv,fim=fim)) 
-}
+}
diff --git a/R/create_ofv.R b/R/create_ofv.R
@@ -15,7 +15,6 @@ create_ofv <- function(poped.db,
                        ofv_fun = poped.db$settings$ofv_fun,
                        transform_parameters=T,
                        ...){
-
   #------------ update poped.db with options supplied in function
   called_args <- match.call()
   default_args <- formals()

diff --git a/R/dfimdalpha.R b/R/dfimdalpha.R
@@ -33,4 +33,4 @@ dfimdalpha <- function(alpha, model_switch,groupsize,ni,xtoptn,xoptn,aoptn,bpopd
   }
   return(list( grad= grad,fim =fim )) 
 }
-
+
diff --git a/R/evaluate.e.ofv.fim.R b/R/evaluate.e.ofv.fim.R
@@ -45,7 +45,6 @@ evaluate.e.ofv.fim <- function(poped.db,
                                use_laplace=poped.db$settings$iEDCalculationType, 
                                laplace.fim=FALSE, 
                                ...){
-
   ## update poped.db with options supplied in function
   called_args <- match.call()
   default_args <- formals()

diff --git a/R/evaluate.fim.R b/R/evaluate.fim.R
@@ -72,7 +72,6 @@ evaluate.fim <- function(poped.db,
                          deriv.type = NULL,
                          ...){
 
-
   if(is.null(bpop.val)) bpop.val <- poped.db$parameters$param.pt.val$bpop
   if(is.null(d_full)) d_full <- poped.db$parameters$param.pt.val$d
   if(is.null(docc_full)) docc_full <- poped.db$parameters$param.pt.val$docc

diff --git a/R/evaluate_design.R b/R/evaluate_design.R
@@ -23,4 +23,4 @@ evaluate_design <- function(poped.db, ...) {
     colnames(out$fim) <- names(out$rse)
   }
   return(out)
-}
+}
diff --git a/R/evaluate_fim_map.R b/R/evaluate_fim_map.R
@@ -37,7 +37,6 @@ evaluate_fim_map <- function(poped.db,
                       num_sim_ids = 1000,
                       use_purrr = FALSE,
                       shrink_mat=F){
-
   # if (poped.db$design$m > 1) {
   #   warning("Shrinkage should only be computed for a single arm, please adjust your script accordingly.")
   # }
@@ -176,4 +175,4 @@ evaluate_fim_map <- function(poped.db,
   return(out_df)
 
 
-}
+}
diff --git a/R/evaluate_power.R b/R/evaluate_power.R
@@ -85,4 +85,4 @@ evaluate_power <- function(poped.db, bpop_idx, h0=0, alpha=0.05, power=0.80, two
   }
 
   return(out)
-}
+}
diff --git a/R/get_cv.R b/R/get_cv.R
@@ -62,7 +62,6 @@ get_rse <- function (fim, poped.db,
                      prior_fim = poped.db$settings$prior_fim,
                      #pseudo_on_fail = FALSE,
                      ...) {
-
   ## update poped.db with options supplied in function
   called_args <- match.call()
   default_args <- formals()

diff --git a/R/get_unfixed_params.R b/R/get_unfixed_params.R
@@ -15,7 +15,6 @@
 #' @export
 #' @keywords internal
 get_unfixed_params <- function(poped.db,params=NULL){
-
   if(is.null(params)){
     bpop = poped.db$parameters$bpop[,2,drop=F]
     d = poped.db$parameters$d[,2,drop=F]

diff --git a/R/grad_bpop.R b/R/grad_bpop.R
@@ -13,7 +13,6 @@ grad_bpop <- function(func,select_par,nout,model_switch,xt_ind,x,a,bpop,b_ind,bo
 
 # helper for m2
 helper_v_EBE <- function(model_switch,xt_ind,x,a,bpop,b_ind,bocc_ind,d,sigma,docc,poped.db) {
-
   if((poped.db$settings$bCalculateEBE)){
     #zeros(size(b_ind)[1],size(b_ind)[2])
     b_ind_x = ind_estimates(poped.db$mean_data,bpop,d,sigma,t(b_ind),(poped.db$settings$iApproximationMethod==2),FALSE,model_switch,xt_ind,x,a,b_ind,bocc_ind,poped.db)
@@ -28,7 +27,6 @@ helper_v_EBE <- function(model_switch,xt_ind,x,a,bpop,b_ind,bocc_ind,d,sigma,doc
 
 # helper for m1
 helper_LinMatrix <- function(model_switch,xt_ind,x,a,bpop,b_ind,bocc_ind,d,sigma,docc,poped.db) {
-
   epsi0 = zeros(1,length(poped.db$parameters$notfixed_sigma))
 
   # create linearized model

diff --git a/R/graddetmf_ext.R b/R/graddetmf_ext.R
@@ -2,7 +2,6 @@
 ## Author: Andrew Hooker
 
 graddetmf_ext <- function(model_switch,aX,groupsize,ni,xt,x,a,bpop,d,sigma,docc,poped.db,lndet=FALSE,gradxt=FALSE){
-
   n = get_fim_size(poped.db)
   m=size(ni,1)
   if (gradxt==FALSE) {

diff --git a/R/gradofv_a.R b/R/gradofv_a.R
@@ -2,7 +2,6 @@
 ## Author: Andrew Hooker
 
 gradofv_a <- function(model_switch,aa,groupsize,ni,xt,x,a,bpop,d,sigma,docc,poped.db){
-
   #Input: the prior FIM or (empty) and all the other things to calculate the
   #grad with for a
   #Return a vector that is the gradient

diff --git a/R/gradofv_xt.R b/R/gradofv_xt.R
@@ -2,7 +2,6 @@
 ## Author: Andrew Hooker
 
 gradofv_xt <- function(model_switch,axt,groupsize,ni,xt,x,a,bpop,d,sigma,docc,poped.db){
-
   #Input: the prior FIM or (empty) and all the other things to calculate the
   #grad with
   #Return a vector that is the gradient and the global structure

diff --git a/R/gradtrmf.R b/R/gradtrmf.R
@@ -3,7 +3,6 @@ gradtrmf <- function(model_switch,aX,groupsize,ni,xt,x,a,bpop,d,sigma,docc,poped
   #  Looks at the gradient of tr(FIM^-1) with respect to time (xt) or covariate (a).
   #  problems can arise when a or xt goes negative. So only do forward
   #  differencing. 
-
   m=size(ni,1)
   if (gradxt == FALSE) {
     gdmf=matrix(1,m,size(a,2))

diff --git a/R/helper.R b/R/helper.R
@@ -109,4 +109,4 @@ get_fim_size <- function(poped.db) {
     numnotfixed_covdocc+numnotfixed_sigma+numnotfixed_covsigma
   fim_size <- n_fixed_eff+n_rand_eff
   return(fim_size)
-}
+}
diff --git a/R/hessian_eta_complex.R b/R/hessian_eta_complex.R
@@ -1,6 +1,5 @@
 #Hessian over eta, evaluated at eta_hat => laplace approximation possible
 hessian_eta_complex <- function(model_switch,xt_ind,x,a,bpop,b_ind,bocc_ind,poped.db,return_gradient=F){
-
   bAutomatic = FALSE
   epsi0 = zeros(1,length(poped.db$parameters$notfixed_sigma))
   n=length(b_ind)

diff --git a/R/ind_estimates.R b/R/ind_estimates.R
@@ -1,7 +1,6 @@
 #Get the emperical bayes estimates for one individual
 #Written for PopED by JN
 ind_estimates <- function(data,bpop,d,sigma,start_bind,bInter,bUDDLike,model_switch,xt_ind,x,a,b_ind,bocc_ind,poped.db){
-
   b_i = t(start_bind)
   c1 = length(t(start_bind))/2*log(2*pi)
   c2 = 1/2*log(det(d))

diff --git a/R/m3.R b/R/m3.R
@@ -4,7 +4,6 @@
 m3 <- function(model_switch,xt_ind,x,a,bpop,b_ind,bocc_ind,d,sigma,docc,bUseVarSigmaDerivative,poped.db){
   #
   # size: (samps per subject^2 x (number of random effects + number of occasion variances + number of sigmas))
-
   dv_dd = NULL
   dv_covd = NULL
   dv_ddocc = NULL

diff --git a/R/mf3.R b/R/mf3.R
@@ -22,7 +22,6 @@
 ## Author: Andrew Hooker
 
 mf3 <- function(model_switch,xt,x,a,bpop,d,sigma,docc,poped.db){
-
   numnotfixed_bpop = sum(poped.db$parameters$notfixed_bpop)
   numnotfixed_d    = sum(poped.db$parameters$notfixed_d)
   numnotfixed_covd = sum(poped.db$parameters$notfixed_covd)

diff --git a/R/mf7.R b/R/mf7.R
@@ -19,7 +19,6 @@
 ## Author: Andrew Hooker
 
 mf7 <- function(model_switch,xt_ind,x,a,bpop,d,sigma,docc,poped.db){
-
   #This calculation of FIM divides the calculation up into one calculation
   #per model switch
 

diff --git a/R/mf_all.R b/R/mf_all.R
@@ -3,7 +3,6 @@
 ## Author: Andrew Hooker
 
 mf_all <- function(model_switch,xt_ind,x,a,bpop,d,sigma,docc,poped.db){
-
     returnArgs <- switch(poped.db$settings$iFIMCalculationType+1,
                          mf3(model_switch,xt_ind,x,a,bpop,d,sigma,docc,poped.db), #Default (with no assumption that bpop and b are uncorrelated)
                          mf3(model_switch,xt_ind,x,a,bpop,d,sigma,docc,poped.db), #Reduced FIM

diff --git a/R/mfea.R b/R/mfea.R
@@ -36,7 +36,6 @@ mfea <- function(poped.db,model_switch,ni,xt,x,a,bpopdescr,ddescr,maxxt,minxt,ma
                  #opt_inds=poped.db$settings$optsw[5],
                  trflag=T,
                  ...){
-
   if((poped.db$settings$EACriteria!=1)){
     stop(sprintf('The criteria that can be used is Modified Fedorov Exchange Algorithm (EACriteria = 1)'))
   }

diff --git a/R/ofv_fim.R b/R/ofv_fim.R
@@ -37,7 +37,6 @@ ofv_fim <- function(fmf,poped.db,
                     ds_index=poped.db$parameters$ds_index,
                     use_log = TRUE,
                     ...){
-
   #Input: the FIM
   #Return the single value that should be maximized
 

diff --git a/R/optim_ARS.R b/R/optim_ARS.R
@@ -62,6 +62,7 @@ optim_ARS <- function(par,
                       parallel_type=NULL,
                       num_cores = NULL,
                       mrgsolve_model=NULL,
+                      babelmixr2_model=NULL,
                       seed=round(runif(1,0,10000000)),
                       allow_replicates=TRUE,
                       replicates_index=seq(1,length(par)), # same value, parameters can not be the same value
@@ -134,6 +135,7 @@ optim_ARS <- function(par,
                                parallel_type=parallel_type,
                                num_cores=num_cores,
                                mrgsolve_model=mrgsolve_model,
+                               babelmixr2_model=babelmixr2_model,
                                ...) 
     on.exit(if(parallel && (attr(parallel,"type")=="snow")) 
       parallel::stopCluster(attr(parallel,"cluster")))

diff --git a/R/optim_LS.R b/R/optim_LS.R
@@ -67,6 +67,7 @@ optim_LS <- function(par,
                      parallel_type=NULL,
                      num_cores = NULL,
                      mrgsolve_model=NULL,
+                     babelmixr2_model=NULL,
                      seed=round(runif(1,0,10000000)),
                      allow_replicates=TRUE,
                      replicates_index=seq(1,length(par)), # same value, parameters can not be the same value
@@ -124,7 +125,7 @@ optim_LS <- function(par,
 
   # start parallel computing
   if(parallel){
-    parallel <- start_parallel(parallel,seed=seed,parallel_type=parallel_type,num_cores=num_cores,mrgsolve_model=mrgsolve_model,...) 
+    parallel <- start_parallel(parallel,seed=seed,parallel_type=parallel_type,num_cores=num_cores,mrgsolve_model=mrgsolve_model,babelmixr2_model=babelmixr2_model,...) 
     on.exit(if(parallel && (attr(parallel,"type")=="snow")) parallel::stopCluster(attr(parallel,"cluster")))
   }   
   #if(is.null(iter_chunk)) if(parallel) iter_chunk <- attr(parallel,"cores") else iter_chunk <- 1

diff --git a/R/optimize_n.R b/R/optimize_n.R
@@ -62,7 +62,6 @@ optimize_groupsize <-
            props = c(poped.db$design$groupsize/sum(poped.db$design$groupsize)),
            trace=1,
            ...){
-
     # need to fix:
     # limits on the proportions to account for max and min values of N in each group
     # return actual values.
@@ -231,7 +230,6 @@ optimize_n_rse <- function(poped.db,
                            allowed_values = seq(poped.db$design$m,
                                                 sum(poped.db$design$groupsize)*5,
                                                 by=poped.db$design$m)){
-
   n_per_group = poped.db$design$groupsize
   n_tot <- sum(n_per_group)
   props = c(n_per_group/n_tot)
@@ -275,7 +273,6 @@ optimize_n_eff <- function(poped.db,
                            ofv_ref,
                            norm_group_fim = NULL,  
                            ...){
-
   n_per_group = poped.db$design$groupsize
   n_tot <- sum(n_per_group)
   props = c(n_per_group/n_tot)

diff --git a/R/par_and_space_tbl.R b/R/par_and_space_tbl.R
@@ -264,7 +264,7 @@ get_par_and_space_optim <- function(poped.db,
                                     cont_cat = "both",
                                     warn_when_none=TRUE) 
 {
-    
+
   type <- index <- fixed <- cont <- par <- lower <- upper <- NULL
 
   #----------- checks

diff --git a/R/pargen.R b/R/pargen.R
@@ -29,7 +29,6 @@
 ## Author: Andrew Hooker
 
 pargen <- function(par,user_dist_pointer,sample_size,bLHS,sample_number,poped.db){
-
   nvar=size(par,1)
   ret=zeros(sample_size,nvar)
Original file line number	Diff line number	Diff line change
Expand Up		@@ -33,4 +33,4 @@ dfimdalpha <- function(alpha, model_switch,groupsize,ni,xtoptn,xoptn,aoptn,bpopd
		}
		return(list( grad= grad,fim =fim ))
		}
-Original file line number
+Diff line change
@@ Expand Up / @@ -23,4 +23,4 @@ evaluate_design <- function(poped.db, ...) { @@
         colnames(out$fim) <- names(out$rse)
       }
       return(out)
-    }
+    }