Merge branch 'devel' of github.com:nimble-dev/nimble into devel

Author: paciorek

packages/nimble/R/genCpp_generateCpp.R

@@ -196,7 +196,7 @@ cppOutputNimDerivsPrependType <- function(code, symTab){
     for(i in seq_along(code$args)){
       iArg <- code$args[[i]]
       iName <- names(code$args)[i]
-      if(iName == 'log' && (is.numeric(iArg) | is.logical(iArg))){
+      if(isTRUE(iName == 'log' && (is.numeric(iArg) || is.logical(iArg)))) {
         logFixedString <- '_logFixed'
         argList[[length(argList) + 1]] <- nimGenerateCpp(iArg, symTab,
                                                          asArg = TRUE)

packages/nimble/R/genCpp_sizeProcessing.R

@@ -577,6 +577,9 @@ sizeConcatenate <- function(code, symTab, typeEnv) { ## This is two argument ver
     ## overall strategy is to separate runs of scaalrs and non-scalars
     ## also in C++ we don't take arbitrary arguments.  Instead we chain together calls in groups of 4
     ##     e.g. c(a1, a2, a3, a4, a5) will become c( c(a1, a2, a3, a4), a5)
+
+    if(!length(code$args))
+        stop("`c()` must have at least one argument")
 
     ## first puzzle is with nimC(scalar1, scalar2, vector1, scalar3)
     ## we need to extract the runs of scalars like (scalar1, scalar2), so they can be packed up in an object together.
@@ -2719,6 +2722,12 @@ sizeIndexingBracket <- function(code, symTab, typeEnv) {
     ## This is deprecated:
     if(code$args[[1]]$type == 'symbolNumericList') return(c(asserts, sizemvAccessBracket(code, symTab, typeEnv)))
 
+    minuses <- sapply(code$args, function(x) inherits(x, 'exprClass') &&
+                                             exists('name', x) && x$name == "-")
+    if(any(minuses)) 
+        if(any(sapply(code$args[minuses], function(x) length(x$args) == 1)))
+            stop("use of 'minus' indexing found in `", safeDeparse(code$expr), "` cannot be compiled")
+    
     ## Iterate over arguments,  lifting any logical indices into which()
     ## e.g. X[i, bool] becomes X[i, Interm1], with Interm1 <- which(bool) as an assert.
     for(i in seq_along(code$args)) {

packages/nimble/R/parameterTransform.R

@@ -245,6 +245,7 @@ parameterTransform <- nimbleFunction(
             ## argument values(model, nodes), return vector on unconstrained scale
             transformed <- nimNumeric(tLength)
             if(nNodes == 0)   return(transformed)
+            iNode <- 1L; i <- 1L; j <- 1L; dd <- 1L; pp <- 1L   ## integer types
             for(iNode in 1:nNodes) {
                 theseValues <- nodeValuesFromModel[transformData[iNode,NIND1]:transformData[iNode,NIND2]]
                 thisType <- transformType[iNode]
@@ -263,14 +264,14 @@ parameterTransform <- nimbleFunction(
                               ## DT: there has to be a better way to do this procedure, below,
                               ## creating the vector of the log-Cholesky transformed values.
                               theseTransformed <- nimNumeric(transformData[iNode,DATA2])
-                              tInd <- 1
+                              tInd <- 1L
                               for(j in 1:dd) {
                                   for(i in 1:dd) {
-                                      if(i==j) { theseTransformed[tInd] <- log(U[i,j]); tInd <- tInd+1 }
-                                      if(i< j) { theseTransformed[tInd] <-     U[i,j];  tInd <- tInd+1 } } }
+                                      if(i==j) { theseTransformed[tInd] <- log(U[i,j]); tInd <- tInd+1L }
+                                      if(i< j) { theseTransformed[tInd] <-     U[i,j];  tInd <- tInd+1L } } }
                           },
                           {                                        ## 8: multivariate dirichlet
-                              dd <- transformData[iNode,DATA1] - 1
+                              dd <- transformData[iNode,DATA1] - 1L
                               theseTransformed <- nimNumeric(dd)
                               theseTransformed[1] <- logit( theseValues[1] )
                               if(dd > 1) {
@@ -287,21 +288,21 @@ parameterTransform <- nimbleFunction(
                               theseTransformed <- nimNumeric(pp)
                               theseValuesMatrix <- nimArray(theseValues, dim = c(dd, dd))  # U in matrix form
                               if(dd > 1) {
-                                  cnt <- 1
+                                  cnt <- 1L
                                   ## Length of each column of U is 1.
                                   ## We first produce the canonical partial correlations and then apply atanh()
                                   ## to make the unconstrained parameters..
                                   for(j in 2:dd) {
                                       theseTransformed[cnt] <- atanh(theseValuesMatrix[1, j])
-                                      cnt <- cnt + 1
+                                      cnt <- cnt + 1L
                                       if(j > 2) {
                                           partialSum <- 1
                                           for(i in 2:(j-1)) {
                                               partialSum <- partialSum - theseValuesMatrix[i-1, j]^2
                                               ## Transformed value is atanh of the proportion of the
                                               ## remaining correlation (which is in 'partialSum').
                                               theseTransformed[cnt] <- atanh(theseValuesMatrix[i, j] / sqrt(partialSum))
-                                              cnt <- cnt + 1
+                                              cnt <- cnt + 1L
                                           }
                                       }
                                   }
@@ -470,6 +471,6 @@ parameterTransform <- nimbleFunction(
             return(lp)
         }
     ),
-    buildDerivs = list(inverseTransform = list(),
+    buildDerivs = list(inverseTransform = list(), transform = list(),
                        logDetJacobian = list(ignore = c('iNode','j','dd','ddm1','i')))
 )

packages/nimble/tests/testthat/test-user.R

@@ -1110,6 +1110,25 @@ test_that("conflicted nimbleFunction names trapped", {
 
 })
 
+test_that("Error trap 'minus' indexing.", {
+    testMinusIdx <- nimbleFunction(
+        run = function(x = double(0)) {
+            ans <- x[-3]
+            return(ans)
+            returnType(double(1))
+        } )
+    expect_error(cf <- compileNimble(testMinusIdx), "use of 'minus' indexing")
+    
+    testMinusIdx <- nimbleFunction(
+        run = function(x = double(2)) {
+            ans <- x[5, -c(1,4)]
+            return(ans)
+            returnType(double(1))
+        } )
+    expect_error(cf <- compileNimble(testMinusIdx), "use of 'minus' indexing")
+})
+
+
 nimbleOptions(allowNFobjInModel = currentOption)
 
 nimbleOptions(verbose = nimbleVerboseSetting)