fix use of lhs indexing variables or expressions

nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorIndexingOps.h

@@ -290,21 +290,19 @@ namespace Eigen {
       array<Index, NumDims> m_strides;
       Index m_stride_DimId, m_stride_DimId_plus_1_input, m_stride_DimId_plus_1;
       TensorEvaluator<ArgType, Device> m_impl;
-      TensorEvaluator<IV_Type, Device> m_IV_impl;
+      TensorEvaluator<const IV_Type, Device> m_IV_impl;
       const internal::IVDimensionId<DimId> m_dim;
       bool DimId_is_first, DimId_is_last;
     };
 
 
   // Eval as lvalue
 
-  template <DenseIndex DimId, typename ArgType, typename IV_Type, typename Device>
-    struct TensorEvaluator<TensorIndexByVecOp<DimId, ArgType, IV_Type>, Device>
-    : public TensorEvaluator<const TensorIndexByVecOp<DimId, ArgType, IV_Type>,
-    Device> {
-    typedef TensorEvaluator<const TensorIndexByVecOp<DimId, ArgType, IV_Type>,
-      Device> Base;
-    typedef TensorIndexByVecOp<DimId, ArgType, IV_Type> XprType;
+  template <DenseIndex DimId, typename ArgType, typename IV_Type, typename Device, bool Rindexing>
+    struct TensorEvaluator<TensorIndexByVecOp<DimId, ArgType, IV_Type, Rindexing>, Device>
+    : public TensorEvaluator<const TensorIndexByVecOp<DimId, ArgType, IV_Type, Rindexing>, Device> {
+    typedef TensorEvaluator<const TensorIndexByVecOp<DimId, ArgType, IV_Type, Rindexing>, Device> Base;
+    typedef TensorIndexByVecOp<DimId, ArgType, IV_Type, Rindexing> XprType;
     typedef typename XprType::Index Index;
     static const int NumDims = internal::array_size<typename TensorEvaluator<ArgType, Device>::Dimensions>::value;
     typedef DSizes<Index, NumDims> Dimensions;

nCompiler/tests/testthat/cpp/general_indexing_examples.cpp

@@ -174,6 +174,20 @@ Eigen::Tensor<double, 2> ex4p1(Eigen::Tensor<double, 2> x,
   return x;
 }
 
+// Assign to index vec of index vec with R indexing
+// Checks a bug fix 9/22/26 (Issue #215)
+// [[Rcpp::export]]
+Eigen::Tensor<double, 2> ex4p4(Eigen::Tensor<double, 2> x,
+                               Eigen::Tensor<int, 1> iv,
+                               Eigen::Tensor<int, 1> iv2,
+                               Eigen::Tensor<double, 2> v) {
+  // TRY MACRO VERSION
+  // nCompiler::IndexByVec<1>().op(iv2, nCompiler::IndexByVec<0>().op(iv,x)) = v;
+  IVEC_(1, iv2, IVEC_(0, iv, x, true), true) = v;
+  return x;
+}
+
+
 /////////////////////////////////////
 // INDEX VEC OF INDEX SCALAR AND VICE VERSA
 // Read

nCompiler/tests/testthat/cpp_tests/test-indexing-cpp.R

@@ -8,7 +8,7 @@ test_that("C++ code for indexing and chipping works", {
   cppfile <- system.file(
     file.path('tests', 'testthat', 'cpp', 'general_indexing_examples.cpp'),
     package = 'nCompiler')
-  `:::`("nCompiler", "QuietSourceCpp")(cppfile)
+  nCompiler:::QuietSourceCpp(cppfile)
 
   # warming up and making sure Rcpp works:
   # Should print: hello world.  first element is 10
@@ -88,6 +88,15 @@ test_that("C++ code for indexing and chipping works", {
   ans <- x; ans[c(2,4), c(4, 5)] <- v
   expect_equal(test, ans)
 
+  # Assign (using R-based indexing)
+  x <- matrix(1:20, nrow = 4)
+  iv <- c(2, 4) # 2, 4 in R
+  iv2 <- c(4, 5) # 4, 5 in R
+  v <- x[c(2,4), c(4, 5)] + 100
+  test <- ex4p4(x, iv, iv2, v)
+  ans <- x; ans[c(2,4), c(4, 5)] <- v
+  expect_equal(test, ans)
+
   ###### Index vec of index scalar and vice versa
   ## Access
   x <- matrix(1:20, nrow = 4)

nCompiler/tests/testthat/nCompile_tests/test-userOps.R

@@ -360,13 +360,13 @@ test_that("matchDef of user-defined op is used", {
            list()))
   test <- nCompile_nFunction(foo, control = list(endStage = "normalizeCalls"))
   expect_true(grepl("bar\\(B = 2, A = 1\\)", nDeparse(test$code)[2]))
-  
+
   registerOpDef(
     list(bar =
            list(
              matchDef = function(A, B) {}
            )))
-  
+
   test <- nCompile_nFunction(foo, control = list(endStage = "normalizeCalls"))
   expect_true(grepl("bar\\(A = 1, B = 2\\)", nDeparse(test$code)[2]))
 })
@@ -383,26 +383,30 @@ test_that("matchDef of another nFunction is used", {
   expect_true(grepl("bar\\(A = 1, B = 2\\)", nDeparse(test$code)[2]))
 })
 
-test_that("matchDef of method or user-defined op in an nClass is used", {
-  nc <- nClass(
-    classname = "nc",
-    Cpublic = list(
-      bar = nFunction(function(A = "numericScalar", B = "numericScalar") {})
-    )
-  )
-  foo <- nFunction(
-    fun = function() {
-      obj <- nc$new()
-      obj$bar(B = 2, A = 1) # See if this gets reordered
-    }
-  )
-
-  debug(nCompiler:::labelAbstractTypesEnv$DollarSign)
-  test <- nCompile(foo)
-
-  # Args can't be re-ordered here because normalizeCalls does not see type of obj.
-  test <- nCompile_nFunction(foo, control = list(endStage = "normalizeCalls"))
-
-  nOptions(pause_after_writing_files = TRUE)
-  test <- nCompile(foo)  
-})
+## ## The following DOES NOT WORK:
+## ## named arguments of a method of another class are not successfully reordered.
+## test_that("matchDef of method or user-defined op in an nClass is used", {
+##   nc <- nClass(
+##     classname = "nc",
+##     Cpublic = list(
+##       bar = nFunction(function(A = "numericScalar", B = "numericScalar") {
+##         return(A * 10 + B) # check which is A and which is B
+##         returnType(double())
+##       })
+##     )
+##   )
+##   foo <- nFunction(
+##     fun = function() {
+##       obj <- nc$new()
+##       return(obj$bar(B = 2, A = 1)) # See if this gets reordered
+##       returnType(double())
+##     }
+##   )
+
+##   test <- nCompile(foo)
+##   expect_equal(test(), 21)
+
+##   # Args can't be re-ordered here because normalizeCalls does not see type of obj.
+##   #test <- nCompile_nFunction(foo, control = list(endStage = "normalizeCalls"))
+##   #test <- nCompile(foo)
+## })

nCompiler/tests/testthat/specificOp_tests/test-indexing.R

@@ -451,6 +451,39 @@ test_that("3:3 style indexing arg doesn't drop dimension", {
   expect_silent(nfc(x))
 })
 
+test_that("LHS indexing by a variable or expression works", {
+  # Issue #215
+  nf <- nFunction(
+    fun = function(x = 'numericVector') {
+      x[c(2,3,5)] <- rep(1,3)
+      return(x)
+      returnType('numericVector')
+    }
+  )
+  cnf <- nCompile(nf)
+  x <- 1:10
+  check <- x
+  check[c(2, 3, 5)] <- rep(1, 3)
+  x <- nf(x)
+  expect_equal(x, check)
+
+  nf <- nFunction(
+    fun = function(x = 'numericVector') {
+      w <- c(2, 3, 5)
+      x[w + 1] <- rep(1,3)
+      return(x)
+      returnType('numericVector')
+    }
+  )
+  cnf <- nCompile(nf)
+  x <- 1:10
+  check <- x
+  check[c(2, 3, 5) + 1] <- rep(1, 3)
+  x <- nf(x)
+  expect_equal(x, check)
+
+})
+
 ## THESE TESTS WON'T PASS UNTIL SOME NEW ERROR-TRAPPING
 ## IS IMPLEMENTED.
 ## test_that("compilation of [ throws errors as expected ", {