diff --git a/nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorIndexingOps.h b/nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorIndexingOps.h index 334ebdf9..29f5621e 100644 --- a/nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorIndexingOps.h +++ b/nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorIndexingOps.h @@ -290,7 +290,7 @@ namespace Eigen { array m_strides; Index m_stride_DimId, m_stride_DimId_plus_1_input, m_stride_DimId_plus_1; TensorEvaluator m_impl; - TensorEvaluator m_IV_impl; + TensorEvaluator m_IV_impl; const internal::IVDimensionId m_dim; bool DimId_is_first, DimId_is_last; }; @@ -298,13 +298,11 @@ namespace Eigen { // Eval as lvalue - template - struct TensorEvaluator, Device> - : public TensorEvaluator, - Device> { - typedef TensorEvaluator, - Device> Base; - typedef TensorIndexByVecOp XprType; + template + struct TensorEvaluator, Device> + : public TensorEvaluator, Device> { + typedef TensorEvaluator, Device> Base; + typedef TensorIndexByVecOp XprType; typedef typename XprType::Index Index; static const int NumDims = internal::array_size::Dimensions>::value; typedef DSizes Dimensions; diff --git a/nCompiler/tests/testthat/cpp/general_indexing_examples.cpp b/nCompiler/tests/testthat/cpp/general_indexing_examples.cpp index a0b783a3..834941a8 100644 --- a/nCompiler/tests/testthat/cpp/general_indexing_examples.cpp +++ b/nCompiler/tests/testthat/cpp/general_indexing_examples.cpp @@ -174,6 +174,20 @@ Eigen::Tensor ex4p1(Eigen::Tensor 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 ex4p4(Eigen::Tensor x, + Eigen::Tensor iv, + Eigen::Tensor iv2, + Eigen::Tensor 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 diff --git a/nCompiler/tests/testthat/cpp_tests/test-indexing-cpp.R b/nCompiler/tests/testthat/cpp_tests/test-indexing-cpp.R index 997beb8f..baf2e9f4 100644 --- a/nCompiler/tests/testthat/cpp_tests/test-indexing-cpp.R +++ b/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) diff --git a/nCompiler/tests/testthat/nCompile_tests/test-userOps.R b/nCompiler/tests/testthat/nCompile_tests/test-userOps.R index 7464a192..c1e74141 100644 --- a/nCompiler/tests/testthat/nCompile_tests/test-userOps.R +++ b/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) +## }) diff --git a/nCompiler/tests/testthat/specificOp_tests/test-indexing.R b/nCompiler/tests/testthat/specificOp_tests/test-indexing.R index 7fe52fd4..f93b6b7f 100644 --- a/nCompiler/tests/testthat/specificOp_tests/test-indexing.R +++ b/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 ", {