From 963a302100a74a723054777c3ddbc64d8b4b2c32 Mon Sep 17 00:00:00 2001
From: alexkowa <alex@kowarik.net>
Date: Wed, 21 Jun 2023 13:43:37 +0200
Subject: [PATCH] fix matchImpute infinite loop in case of all missing + tests

---
 NEWS.md                          |  3 +++
 R/matchImpute.R                  |  6 ++++++
 inst/tinytest/test_matchImpute.R | 22 ++++++++++++++++++++++
 3 files changed, 31 insertions(+)
 create mode 100644 inst/tinytest/test_matchImpute.R

diff --git a/NEWS.md b/NEWS.md
index c1b90ed..4cdb7d4 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,6 @@
+# VIM 6.x.x
+ - fix infinite loop in matchImpute in case all observations of a variable are missing
+
 # VIM 6.2.3
 - default robust regression method for irmi for numeric variables changes from rlm to lmrob.
 
diff --git a/R/matchImpute.R b/R/matchImpute.R
index f85c1a9..3a0660e 100644
--- a/R/matchImpute.R
+++ b/R/matchImpute.R
@@ -59,8 +59,14 @@ matchImpute <- function(data,variable=colnames(data)[!colnames(data)%in%match_va
     data <- as.data.table(data)
   else
     data <- data.table::copy(data)
+  tfna <- data[,sapply(lapply(.SD,is.na),all),.SDcols=variable]
+  if(any(tfna)){
+    stop(paste0(variable[tfna],collapse=", ")," ", ifelse(sum(tfna)>1,"are","is")," completely missing")
+    
+  }
   na_present <- data[,sum(sapply(lapply(.SD,is.na),sum)),.SDcols=variable]
   
+  
   if(imp_var){
     data[,paste(variable,imp_suffix,sep="_"):=lapply(.SD,is.na),.SDcols=variable]
   }
diff --git a/inst/tinytest/test_matchImpute.R b/inst/tinytest/test_matchImpute.R
new file mode 100644
index 0000000..c396481
--- /dev/null
+++ b/inst/tinytest/test_matchImpute.R
@@ -0,0 +1,22 @@
+library(VIM)
+message("matchImpute general")
+d <- data.frame(x=LETTERS[1:6],y=as.double(1:6),z=as.double(1:6),
+                w=ordered(LETTERS[1:6]), stringsAsFactors = FALSE)
+dorig <- rbind(d,d)
+# minimal example with one match var
+d1 <- matchImpute(setna(dorig,7:12,1)[,1:2],match_var = "y", variable="x")
+expect_identical(d1$x[d1$x_imp],d1$x[!d1$x_imp])
+
+d1b <- matchImpute(setna(dorig,7:12,1)[,1:2],match_var = "y", variable="x", imp_var = FALSE)
+expect_identical(d1b$x[d1$x_imp],d1b$x[!d1$x_imp])
+expect_false("x_imp" %in% colnames(d1b))
+expect_true("x_imp" %in% colnames(d1))
+
+
+# all missing in x -> error
+expect_error(matchImpute(setna(dorig,1:12,1)[,1:2],match_var = "y", variable="x"))
+
+
+# example with two match vars
+d1 <- matchImpute(setna(dorig,7:12,1)[,1:3],match_var = c("y","z"), variable="x")
+expect_identical(d1$x[d1$x_imp],d1$x[!d1$x_imp])