Merge pull request #226 from michaelhallquist/codex/fix-data-file-loading-for-mplusmodel

Handle missing data paths for mplusModel

Author: michaelhallquist

R/mplusModel.R

@@ -273,12 +273,40 @@ mplusModel_r6 <- R6::R6Class(
         if (is.null(data) && private$pvt_output_loaded && !is.null(self$input$data$file)) {
           dfile <- self$input$data$file
           private$pvt_dat_file <- self$input$data$file
-          
-          # if file cannot be loaded as is because of a relative path problem, look in the model directory
-          if (!file.exists(dfile)) dfile <- file.path(private$pvt_model_dir, dfile)
-          data <- tryCatch(data.table::fread(dfile, header = FALSE, na.strings=c("*", "."), strip.white=TRUE, data.table = FALSE),
-                           error=function(e) { warning("Could not load data file: ", dfile); return(NULL) })
-          
+
+          # If the data file cannot be loaded as-is, attempt to locate it in the
+          # directory of the input/output files.  This handles cases where the
+          # data file was specified with an absolute path on another machine but
+          # the .dat, .inp and .out files all reside in the same folder.
+          if (!file.exists(dfile)) {
+            # first, try using the provided path relative to the model directory
+            rel_dfile <- file.path(private$pvt_model_dir, dfile)
+            if (file.exists(rel_dfile)) {
+              dfile <- rel_dfile
+            } else {
+              # next, try just the basename of the data file in the model directory
+              base_dfile <- file.path(private$pvt_model_dir, basename(dfile))
+              if (file.exists(base_dfile)) {
+                dfile <- base_dfile
+                private$pvt_dat_file <- basename(dfile)
+              }
+            }
+          }
+
+          data <- tryCatch(
+            data.table::fread(
+              dfile,
+              header = FALSE,
+              na.strings = c("*", "."),
+              strip.white = TRUE,
+              data.table = FALSE
+            ),
+            error = function(e) {
+              warning("Could not load data file: ", dfile)
+              return(NULL)
+            }
+          )
+
           # set the names of the data if read succeeds
           if (!is.null(data)) names(data) <- strsplit(expandCmd(self$input$variable$names), "\\s+")[[1]]
         }

tests/testthat/test-mplusModel.R

@@ -53,6 +53,27 @@ test_that("mplusModel reads existing output", {
   expect_equal(nrow(m$data), 500)
 })
 
+test_that("mplusModel falls back to basename for missing data file", {
+  tmp <- tempdir()
+  file.copy(testthat::test_path("submitModels", "ex3.1.dat"), tmp, overwrite = TRUE)
+  file.copy(testthat::test_path("submitModels", "ex3.1.inp"), tmp, overwrite = TRUE)
+  file.copy(testthat::test_path("ex3.1.out"), tmp, overwrite = TRUE)
+
+  bad_path <- normalizePath(file.path(tempdir(), "nonexistent", "path", "ex3.1.dat"),
+                            winslash = "/", mustWork = FALSE)
+  inp_lines <- readLines(file.path(tmp, "ex3.1.inp"))
+  inp_lines <- gsub("ex3.1.dat", bad_path, inp_lines, fixed = TRUE)
+  writeLines(inp_lines, file.path(tmp, "ex3.1.inp"))
+  out_lines <- readLines(file.path(tmp, "ex3.1.out"))
+  out_lines <- gsub("ex3.1.dat", bad_path, out_lines, fixed = TRUE)
+  writeLines(out_lines, file.path(tmp, "ex3.1.out"))
+
+  mplus_fake <- tempfile(); file.create(mplus_fake)
+  m <- mplusModel(inp_file = file.path(tmp, "ex3.1.inp"), read = TRUE, Mplus_command = mplus_fake)
+  expect_equal(nrow(m$data), 500)
+  expect_equal(m$dat_file, file.path(tmp, "ex3.1.dat"))
+})
+
 test_that("mplusModel exposes readModels sections", {
   tmp <- tempdir()
   file.copy(testthat::test_path("submitModels","ex3.1.inp"), tmp, overwrite = TRUE)