From 173d8c14cce3bd8be7dad14862d691c7a9eca454 Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Fri, 3 Jul 2026 13:55:10 -0700 Subject: [PATCH 1/3] Enforce column-major ordering when converting node/varRanges to char. --- nimbleModel/R/indexRange.R | 2 +- nimbleModel/R/varRange.R | 16 +-- nimbleModel/tests/testthat/test-nimbleModel.R | 120 ++++++++++++++++++ 3 files changed, 129 insertions(+), 9 deletions(-) diff --git a/nimbleModel/R/indexRange.R b/nimbleModel/R/indexRange.R index da6972b..f2fbb39 100644 --- a/nimbleModel/R/indexRange.R +++ b/nimbleModel/R/indexRange.R @@ -260,7 +260,7 @@ indexRangeMatrixClass <- R6Class( numColumns = numeric(), initialize = function(values, sort = TRUE) { if (sort) { - ord <- do.call(order, lapply(seq_len(ncol(values)), function(i) values[, i])) + ord <- do.call(order, lapply(rev(seq_len(ncol(values))), function(i) values[, i])) values <<- values[ord, , drop = FALSE] } else { values <<- values diff --git a/nimbleModel/R/varRange.R b/nimbleModel/R/varRange.R index 4fca2db..da6562a 100644 --- a/nimbleModel/R/varRange.R +++ b/nimbleModel/R/varRange.R @@ -242,15 +242,16 @@ varRangeClass <- R6Class( } else { externalMatrix <- crossIndexRanges(indexRanges)$values } # not ordered - tmp <- t(apply(externalMatrix, 1, as.character)) if (ncol(externalMatrix) == 1) { - tmp <- t(tmp) - } + externalMatrix <- t(externalMatrix) + } indicesList <- list() indices <- unlist(rangeToIndexSlot) for (i in seq_along(indices)) { - indicesList[[indices[i]]] <- tmp[, i] + indicesList[[indices[i]]] <- externalMatrix[, i] } + ord <- do.call(order, indicesList[sort(sapply(rangeToIndexSlot, \(x) x[1]), decreasing = TRUE)]) # Enforce column-major, but using only first index in nonseparable cases). + indicesList <- lapply(indicesList, \(x) x[ord]) return(paste0(varName, "[", do.call(pasteIndices, indicesList), "]")) } @@ -274,12 +275,11 @@ varRangeClass <- R6Class( } else { externalMatrix <- crossIndexRanges(indexRanges[boolMatrixIndexRanges])$values } # not ordered - tmp <- t(apply(externalMatrix, 1, as.character)) if (ncol(externalMatrix) == 1) { - tmp <- t(tmp) - } + externalMatrix <- t(externalMatrix) + } else for (i in seq_along(matrixIndices)) { - indicesList[[matrixIndices[i]]] <- tmp[, i] + indicesList[[matrixIndices[i]]] <- externalMatrix[, i] } } return(paste0(varName, "[", do.call(pasteIndices, indicesList), "]")) diff --git a/nimbleModel/tests/testthat/test-nimbleModel.R b/nimbleModel/tests/testthat/test-nimbleModel.R index 7bb3e7e..d73aaa7 100644 --- a/nimbleModel/tests/testthat/test-nimbleModel.R +++ b/nimbleModel/tests/testthat/test-nimbleModel.R @@ -1184,6 +1184,126 @@ test_that("simulation without data nodes", { set.seed(1) cm$simulate('y') expect_identical(y, cm$y) +}) + +test_that("column-major node/variable ordering when converted to chars", { + library(nimbleModel); library(testthat) + + code <- nimbleCode({ + for(i in 1:2) + for(j in 1:3) + y[i,j] ~ dnorm(0,1) + }) + + m <- nimbleModel(code) + grid <- expand.grid(1:2,1:3) + truth <- paste0('y[', apply(grid, 1, \(x) paste0(x[1], ", ", x[2])), ']') + expect_identical(m$getNodes(nodesAsChars=TRUE), truth) + expect_identical(m$getNodeNames(), truth) + expect_identical(m$expandNodeNames('y'), truth) + expect_identical(m$getDependencies('y', self=TRUE)[[1]]$toVarChars(expandScalars=TRUE), truth) + + code <- nimbleCode({ + for(i in 1:2) + for(j in 1:3) + y[j,i] ~ dnorm(0,1) + }) + + m <- nimbleModel(code) + grid <- expand.grid(1:3,1:2) + truth <- paste0('y[', apply(grid, 1, \(x) paste0(x[1], ", ", x[2])), ']') + expect_identical(m$getNodes(nodesAsChars=TRUE), truth) + expect_identical(m$getNodeNames(), truth) + expect_identical(m$expandNodeNames('y'), truth) + expect_identical(m$getDependencies('y', self=TRUE)[[1]]$toVarChars(expandScalars=TRUE), truth) + + code <- nimbleCode({ + for(i in 1:2) + for(j in 1:3) + y[i,k[j]] ~ dnorm(0,1) + }) + + m <- nimbleModel(code, constants = list(k=c(3,4,1))) + grid <- expand.grid(1:2,c(1,3,4)) + truth <- paste0('y[', apply(grid, 1, \(x) paste0(x[1], ", ", x[2])), ']') + + expect_identical(m$getNodes(nodesAsChars=TRUE), truth) + expect_identical(m$getDependencies('y', self=TRUE)[[1]]$toVarChars(expandScalars=TRUE), truth) + + code <- nimbleCode({ + for(i in 1:2) + for(j in 1:3) + y[k[i],l[j]] ~ dnorm(0,1) + }) + + m <- nimbleModel(code, constants = list(k=c(3,1), l = c(3,4,1))) + grid <- expand.grid(c(1,3),c(1,3,4)) + truth <- paste0('y[', apply(grid, 1, \(x) paste0(x[1], ", ", x[2])), ']') + + expect_identical(m$getNodes(nodesAsChars=TRUE), truth) + expect_identical(m$getDependencies('y', self=TRUE)[[1]]$toVarChars(expandScalars=TRUE), truth) + + code <- nimbleCode({ + for(i in 1:2) + for(j in 1:3) + y[k[j],i,k[j]+1] ~ dnorm(0,1) + }) + + m <- nimbleModel(code, constants = list(k=c(3,4,1))) + truth <- c("y[1, 1, 2]","y[3, 1, 4]","y[4, 1, 5]","y[1, 2, 2]","y[3, 2, 4]","y[4, 2, 5]") + expect_identical(m$getNodes(nodesAsChars=TRUE), truth) + expect_identical(m$getDependencies('y', self=TRUE)[[1]]$toVarChars(expandScalars=TRUE), truth) + + code <- nimbleCode({ + for(i in 1:2) + for(j in 1:3) + y[1:4,i,j] ~ dmnorm(z[1:4],pr[1:4,1:4]) + }) + + m <- nimbleModel(code) + grid <- expand.grid(1:2,1:3) + truth <- paste0('y[1:4, ', apply(grid, 1, \(x) paste0(x[1], ", ", x[2])), ']') + + expect_identical(m$getNodes('y',nodesAsChars=TRUE), truth) + grid <- expand.grid(1:4,1:2,1:3) + truth <- paste0('y[', apply(grid, 1, \(x) paste0(x[1], ", ", x[2], ", ", x[3])), ']') + expect_identical(m$getNodes('y',nodesAsChars=TRUE, returnScalarComponents=TRUE), truth) + expect_identical(m$getDependencies('y', self=TRUE)[[1]]$toVarChars(expandScalars=TRUE), truth) + + code <- nimbleCode({ + for(i in 1:2) + for(j in 1:3) + y[i,1:4,j] ~ dmnorm(z[1:4],pr[1:4,1:4]) + }) + + m <- nimbleModel(code) + grid <- expand.grid(1:2,1:3) + truth <- paste0('y[', apply(grid, 1, \(x) paste0(x[1], ", 1:4, ", x[2])), ']') + + expect_identical(m$getNodes('y',nodesAsChars=TRUE), truth) + + grid <- expand.grid(1:2,1:4,1:3) + truth <- paste0('y[', apply(grid, 1, \(x) paste0(x[1], ", ", x[2], ", ", x[3])), ']') + expect_identical(m$getNodes('y',nodesAsChars=TRUE, returnScalarComponents=TRUE), truth) + expect_identical(m$getDependencies('y', self=TRUE)[[1]]$toVarChars(expandScalars=TRUE), truth) + + code <- nimbleCode({ + for(i in 1:2) + for(j in 1:3) + y[i,j,1:4] ~ dmnorm(z[1:4],pr[1:4,1:4]) + }) + + m <- nimbleModel(code) + grid <- expand.grid(1:2,1:3) + truth <- paste0('y[', apply(grid, 1, \(x) paste0(x[1], ", ", x[2], ", 1:4")), ']') + + expect_identical(m$getNodes('y',nodesAsChars=TRUE), truth) + + grid <- expand.grid(1:2,1:3,1:4) + truth <- paste0('y[', apply(grid, 1, \(x) paste0(x[1], ", ", x[2], ", ", x[3])), ']') + expect_identical(m$getNodes('y',nodesAsChars=TRUE, returnScalarComponents=TRUE), truth) + expect_identical(m$getDependencies('y', self=TRUE)[[1]]$toVarChars(expandScalars=TRUE), truth) + }) From 1211fdbd2943bbee8bc53c1d7133be30a890a1d9 Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Wed, 2 Sep 2026 08:56:34 -0700 Subject: [PATCH 2/3] Fix bug introduced into toVarChars with single column matrix indexing. --- nimbleModel/R/varRange.R | 6 ------ 1 file changed, 6 deletions(-) diff --git a/nimbleModel/R/varRange.R b/nimbleModel/R/varRange.R index da6562a..10d1341 100644 --- a/nimbleModel/R/varRange.R +++ b/nimbleModel/R/varRange.R @@ -242,9 +242,6 @@ varRangeClass <- R6Class( } else { externalMatrix <- crossIndexRanges(indexRanges)$values } # not ordered - if (ncol(externalMatrix) == 1) { - externalMatrix <- t(externalMatrix) - } indicesList <- list() indices <- unlist(rangeToIndexSlot) for (i in seq_along(indices)) { @@ -275,9 +272,6 @@ varRangeClass <- R6Class( } else { externalMatrix <- crossIndexRanges(indexRanges[boolMatrixIndexRanges])$values } # not ordered - if (ncol(externalMatrix) == 1) { - externalMatrix <- t(externalMatrix) - } else for (i in seq_along(matrixIndices)) { indicesList[[matrixIndices[i]]] <- externalMatrix[, i] } From 5d1e4ab3046f045e196532fd486af9d15d32eb71 Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Thu, 3 Sep 2026 09:05:15 -0700 Subject: [PATCH 3/3] Fix up testing based on col-major ordering of node strings. --- .../tests/testthat/test-indexConstraint.R | 6 +- nimbleModel/tests/testthat/test-nimbleModel.R | 23 +++---- nimbleModel/tests/testthat/test-nodeChars.R | 63 +++++++++---------- nimbleModel/tests/testthat/test-nodeRules.R | 36 +++-------- nimbleModel/tests/testthat/test-varRange.R | 8 +-- 5 files changed, 54 insertions(+), 82 deletions(-) diff --git a/nimbleModel/tests/testthat/test-indexConstraint.R b/nimbleModel/tests/testthat/test-indexConstraint.R index 5081e02..69482e5 100644 --- a/nimbleModel/tests/testthat/test-indexConstraint.R +++ b/nimbleModel/tests/testthat/test-indexConstraint.R @@ -192,7 +192,7 @@ test_that("checkIndexConstraints", { ) - expResult <- c(rep(FALSE,4),TRUE,rep(FALSE,6),TRUE) + expResult <- c(FALSE, TRUE, rep(FALSE, 9), TRUE) ## Two input ranges on the matrix constraint; ranges are crossed and result duplicated. expect_identical( @@ -219,7 +219,7 @@ test_that("checkIndexConstraints", { rangeToIndexSlot <- list(c(1,3),2,4), varName = 'x'), constraints), - list(c(TRUE,FALSE), expResult, expResult) + list(c(FALSE,TRUE), expResult, expResult) ) ## Input multi-slot range covers two constraints, but only one of the slots in the matrix constraint. expect_error( @@ -232,7 +232,7 @@ test_that("checkIndexConstraints", { ) ## Input multi-slot range covers only one constraint (and an unconstrained slot). - expResult <- c(FALSE,FALSE,TRUE,rep(FALSE,5)) + expResult <- c(FALSE,TRUE,rep(FALSE,6)) expect_identical( nimbleModel:::checkIndexConstraints(varRangeClass$new(list(newIndexRange(2), newIndexRange(matrix(c(2,9,4,2,5,5,6,7), ncol = 2, byrow = TRUE)), diff --git a/nimbleModel/tests/testthat/test-nimbleModel.R b/nimbleModel/tests/testthat/test-nimbleModel.R index d73aaa7..b2965b1 100644 --- a/nimbleModel/tests/testthat/test-nimbleModel.R +++ b/nimbleModel/tests/testthat/test-nimbleModel.R @@ -264,8 +264,8 @@ test_that("two index slots", { ## Reverse indices inds <- matrix(c(1,3, 2,4, 3,2), ncol=2, byrow=TRUE) vr <- varRangeClass$new(list(newIndexRange(inds)), rangeToIndexSlot = list(c(2,1)), varName = 'y') - tmp <- vr$indexRanges[[1]]$values[,2:1] - inds <- tmp[order(tmp[,1]),] # Rows have been shuffled... + inds <- vr$indexRanges[[1]]$values[,2:1] + inds <- inds[order(inds[,2]), ] truth <- sum(dnorm(m$y[inds], log=TRUE)) expect_equal(m$calculate(vr), truth) expect_equal(cm$calculate(vr), truth) @@ -376,7 +376,7 @@ test_that("three index slots (plus different index variable ordering)", { inds <- matrix(c(5,3,1, 1,3,4, 4,1,2), ncol=3, byrow=TRUE) vr <- varRangeClass$new(list(newIndexRange(inds)), rangeToIndexSlot = list(c(3,1,2)), varName = 'y') tmp <- vr$indexRanges[[1]]$values[,c(2,3,1)] - inds <- tmp[order(tmp[,1],tmp[,2]),] # Rows have been shuffled... + inds <- tmp[order(tmp[,3],tmp[,2]),] # Rows have been shuffled... truth <- sum(dnorm(m$y[inds], log=TRUE)) expect_equal(m$calculate(vr), truth) expect_equal(cm$calculate(vr), truth) @@ -413,8 +413,7 @@ test_that("three index slots (plus different index variable ordering)", { ## matp-seq (matp first because of k,j,i in model code) vr <- varRangeClass$new(list(newIndexRange(quote(2:3)), newIndexRange(matrix(c(4,1,1,3,4,5),ncol=2,byrow=TRUE))), varName = 'y') - inds <- rbind(c(2,1,3),c(2,4,1),c(2,4,5),c(3,1,3),c(3,4,1),c(3,4,5)) - inds <- inds[order(inds[,2],inds[,3],inds[,1]),] + inds <- vr$extractIndexRange(1:3)$values truth <- sum(dnorm(m$y[inds], log=TRUE)) expect_equal(m$calculate(vr), truth) expect_equal(cm$calculate(vr), truth) @@ -431,8 +430,7 @@ test_that("three index slots (plus different index variable ordering)", { ## seq-matp vr <- varRangeClass$new(list(newIndexRange(matrix(c(1,4,3,1,2,4),ncol=2,byrow=TRUE)), newIndexRange(quote(4:5))), varName = 'y') - inds <- rbind(c(1,4,4),c(3,1,4),c(2,4,4),c(1,4,5),c(3,1,5),c(2,4,5)) - inds <- inds[order(inds[,3],inds[,1],inds[,2]),] + inds <- vr$extractIndexRange(1:3)$values truth <- sum(dnorm(m$y[inds], log=TRUE)) expect_equal(m$calculate(vr), truth) expect_equal(cm$calculate(vr), truth) @@ -449,8 +447,7 @@ test_that("three index slots (plus different index variable ordering)", { ## matp-matp (matp first because of k,j,i in model code) vr <- varRangeClass$new(list(newIndexRange(matrix(c(1,3),ncol=1)), newIndexRange(matrix(c(1,4,3,1,4,5),ncol=2,byrow=TRUE))), varName = 'y') - inds <- rbind(c(1,1,4),c(1,3,1),c(1,4,5),c(3,1,4),c(3,3,1),c(3,4,5)) - inds <- inds[order(inds[,2],inds[,1],inds[,3]),] + inds <- vr$extractIndexRange(1:3)$values truth <- sum(dnorm(m$y[inds], log=TRUE)) expect_equal(m$calculate(vr), truth) expect_equal(cm$calculate(vr), truth) @@ -467,8 +464,7 @@ test_that("three index slots (plus different index variable ordering)", { ## matp-matp with reordering vr <- varRangeClass$new(list(newIndexRange(matrix(c(1,4,3,1,3,2),ncol=2,byrow=TRUE)), newIndexRange(matrix(c(3,5),ncol=1))), varName = 'y') - inds <- rbind(c(1,4,3),c(3,1,3),c(3,2,3),c(1,4,5),c(3,1,5),c(3,2,5)) - inds <- inds[order(inds[,3],inds[,1]),] + inds <- vr$extractIndexRange(1:3)$values truth <- sum(dnorm(m$y[inds], log=TRUE)) expect_equal(m$calculate(vr), truth) expect_equal(cm$calculate(vr), truth) @@ -624,9 +620,8 @@ test_that("five index slots", { newIndexRange(matrix(c(1,3),ncol=1))), rangeToIndexSlot = list(1, c(2,4,5), 3), varName = 'y') - inds <- rbind(c(2,2,1,2,4),c(2,2,3,2,4),c(2,4,1,1,2),c(2,4,3,1,2), - c(3,2,1,2,4),c(3,2,3,2,4),c(3,4,1,1,2),c(3,4,3,1,2), - c(4,2,1,2,4),c(4,2,3,2,4),c(4,4,1,1,2),c(4,4,3,1,2)) + inds <- vr$extractIndexRange(1:5)$values + inds <- inds[order(inds[,1],inds[,5],inds[,3]),] # ordering is based on index sets truth <- sum(dnorm(m$y[inds], log=TRUE)) expect_equal(m$calculate(vr), truth) expect_equal(cm$calculate(vr), truth) diff --git a/nimbleModel/tests/testthat/test-nodeChars.R b/nimbleModel/tests/testthat/test-nodeChars.R index 6203eac..b287020 100644 --- a/nimbleModel/tests/testthat/test-nodeChars.R +++ b/nimbleModel/tests/testthat/test-nodeChars.R @@ -13,14 +13,14 @@ test_that("use of nodes as characters", { expect_true(all(sapply(nodeRanges, \(x) inherits(x, 'nodeRangeClass')))) setNimbleModelOption('nodesAsChars', TRUE) chars <- m$getNodes() - expect_identical(chars, c("y[1, 1]","y[1, 2]","y[1, 3]","y[2, 1]","y[2, 2]","y[2, 3]","mu")) + expect_identical(chars, c("y[1, 1]","y[2, 1]","y[1, 2]","y[2, 2]","y[1, 3]","y[2, 3]","mu")) chars <- m$getNodes(returnScalarComponents = TRUE) - expect_identical(chars, c("y[1, 1]","y[1, 2]","y[1, 3]","y[2, 1]","y[2, 2]","y[2, 3]","mu")) + expect_identical(chars, c("y[1, 1]","y[2, 1]","y[1, 2]","y[2, 2]","y[1, 3]","y[2, 3]","mu")) deps <- m$getDependencies('mu') expect_identical(deps, c("mu", "y[1:2, 1:3]")) deps <- m$getDependencies('mu',returnScalarComponents=TRUE) - expect_identical(deps, c("mu","y[1, 1]","y[1, 2]","y[1, 3]","y[2, 1]","y[2, 2]","y[2, 3]")) + expect_identical(deps, c("mu","y[1, 1]","y[2, 1]","y[1, 2]","y[2, 2]","y[1, 3]","y[2, 3]")) setNimbleModelOption('nodesAsChars', FALSE) varRanges <- m$getDependencies('mu') expect_true(all(sapply(varRanges, \(x) inherits(x, 'varRangeClass')))) @@ -40,18 +40,15 @@ test_that("use of nodes as characters", { chars <- m$getNodes() expect_identical(chars, c("lifted_chol_oPprec_oB1to2_comma_1to2_cB_cP[1:2, 1:2]","y[1, 1:2]","y[2, 1:2]", "y[3, 1:2]", "mu[1]", "mu[2]")) chars <- m$getNodes(returnScalarComponents = TRUE) - expect_identical(chars, c("lifted_chol_oPprec_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPprec_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPprec_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPprec_oB1to2_comma_1to2_cB_cP[2, 2]","y[1, 1]","y[1, 2]","y[2, 1]","y[2, 2]","y[3, 1]","y[3, 2]","mu[1]","mu[2]")) + expect_identical(chars, c("lifted_chol_oPprec_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPprec_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPprec_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPprec_oB1to2_comma_1to2_cB_cP[2, 2]","y[1, 1]","y[2, 1]","y[3, 1]","y[1, 2]","y[2, 2]","y[3, 2]","mu[1]","mu[2]")) deps <- m$getDependencies('mu') expect_identical(deps, c("mu[1:2]", "y[1:3, 1:2]")) deps <- m$getDependencies('mu',returnScalarComponents = TRUE) - expect_identical(deps, c("mu[1]","mu[2]","y[1, 1]","y[1, 2]","y[2, 1]","y[2, 2]","y[3, 1]","y[3, 2]")) + expect_identical(deps, c("mu[1]","mu[2]","y[1, 1]","y[2, 1]","y[3, 1]","y[1, 2]","y[2, 2]","y[3, 2]")) setNimbleModelOption('nodesAsChars', FALSE) }) test_that("old model API calls", { - library(nimbleModel) - library(testthat) - code <- nimbleCode({ for(i in 1:2) for(j in 1:3) @@ -62,31 +59,30 @@ test_that("old model API calls", { m <- nimbleModel(code, data = list(y=matrix(rnorm(6),2))) chars <- m$getNodes(nodesAsChars = TRUE) - expect_identical(chars, c("lifted_mu_plus_x", "y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]", "mu")) + expect_identical(chars, c("lifted_mu_plus_x", "y[1, 1]","y[2, 1]","y[1, 2]", "y[2, 2]", "y[1, 3]", "y[2, 3]", "mu")) chars <- m$getNodes(includeRHSonly = TRUE, nodesAsChars = TRUE) - expect_identical(chars, c("lifted_mu_plus_x", "y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]", "mu", "x")) + expect_identical(chars, c("lifted_mu_plus_x", "y[1, 1]","y[2, 1]","y[1, 2]", "y[2, 2]", "y[1, 3]", "y[2, 3]", "mu", "x")) chars <- m$getNodes(.sort = TRUE, nodesAsChars = TRUE) - expect_identical(chars, c("mu", "lifted_mu_plus_x", "y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]")) + expect_identical(chars, c("mu", "lifted_mu_plus_x", "y[1, 1]","y[2, 1]","y[1, 2]", "y[2, 2]", "y[1, 3]", "y[2, 3]")) chars <- m$getNodes(.sort=TRUE, includeRHSonly = TRUE, nodesAsChars = TRUE) - expect_identical(chars, c("x", "mu", "lifted_mu_plus_x", "y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]")) + expect_identical(chars, c("x", "mu", "lifted_mu_plus_x", "y[1, 1]","y[2, 1]","y[1, 2]", "y[2, 2]", "y[1, 3]", "y[2, 3]")) chars <- m$getNodeNames() - expect_identical(chars, c("mu", "lifted_mu_plus_x", "y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]")) + expect_identical(chars, c("mu", "lifted_mu_plus_x", "y[1, 1]","y[2, 1]","y[1, 2]", "y[2, 2]", "y[1, 3]", "y[2, 3]")) chars <- m$getNodeNames(includeRHSonly = TRUE) - expect_identical(chars, c("x", "mu", "lifted_mu_plus_x", "y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]")) + expect_identical(chars, c("x", "mu", "lifted_mu_plus_x", "y[1, 1]","y[2, 1]","y[1, 2]", "y[2, 2]", "y[1, 3]", "y[2, 3]")) chars <- m$expandNodeNames(c('mu','y','x')) - expect_identical(chars, c("mu", "y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]", "x")) + expect_identical(chars, c("mu", "y[1, 1]","y[2, 1]","y[1, 2]", "y[2, 2]", "y[1, 3]", "y[2, 3]", "x")) chars <- m$expandNodeNames(c('mu','y','x'), sort = TRUE) - expect_identical(chars, c("x", "mu", "y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]")) + expect_identical(chars, c("x", "mu", "y[1, 1]","y[2, 1]","y[1, 2]", "y[2, 2]", "y[1, 3]", "y[2, 3]")) chars <- m$expandNodeNames(c('y','y[2,1]')) - expect_identical(chars, c("y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]")) + expect_identical(chars, c("y[1, 1]","y[2, 1]","y[1, 2]", "y[2, 2]", "y[1, 3]", "y[2, 3]")) chars <- m$expandNodeNames(c('y','y[2,1]'), unique = FALSE) - expect_identical(chars, c("y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]", "y[2, 1]")) + expect_identical(chars, c("y[1, 1]","y[2, 1]","y[1, 2]", "y[2, 2]", "y[1, 3]", "y[2, 3]", "y[2, 1]")) # Check with y[i+1] type stuff to see if indexing is messed up. - library(nimbleModel) code <- nimbleCode({ for(i in 1:2) for(j in 1:3) @@ -96,18 +92,18 @@ test_that("old model API calls", { m <- nimbleModel(code, data =list(y=matrix(rnorm(9),3))) chars <- m$getNodes(nodesAsChars = TRUE) - expect_identical(chars, c("lifted_mu_plus_x", "y[2, 1]", "y[2, 2]", "y[2, 3]", "y[3, 1]", "y[3, 2]","y[3, 3]", "mu")) + expect_identical(chars, c("lifted_mu_plus_x", "y[2, 1]", "y[3, 1]", "y[2, 2]", "y[3, 2]", "y[2, 3]","y[3, 3]", "mu")) chars <- m$getNodes(nodesAsChars = TRUE, includeRHSonly = TRUE) - expect_identical(chars, c("lifted_mu_plus_x", "y[2, 1]", "y[2, 2]", "y[2, 3]", "y[3, 1]", "y[3, 2]","y[3, 3]", "mu", "x")) + expect_identical(chars, c("lifted_mu_plus_x", "y[2, 1]", "y[3, 1]", "y[2, 2]", "y[3, 2]", "y[2, 3]","y[3, 3]", "mu", "x")) chars <- m$getNodes(nodesAsChars = TRUE, .sort = TRUE) - expect_identical(chars, c("mu","lifted_mu_plus_x", "y[2, 1]", "y[2, 2]", "y[2, 3]", "y[3, 1]", "y[3, 2]","y[3, 3]")) + expect_identical(chars, c("mu","lifted_mu_plus_x", "y[2, 1]", "y[3, 1]", "y[2, 2]", "y[3, 2]", "y[2, 3]","y[3, 3]")) chars <- m$getNodes(nodesAsChars = TRUE, .sort=TRUE,includeRHSonly = TRUE) - expect_identical(chars, c("x","mu","lifted_mu_plus_x", "y[2, 1]", "y[2, 2]", "y[2, 3]", "y[3, 1]", "y[3, 2]","y[3, 3]")) + expect_identical(chars, c("x","mu","lifted_mu_plus_x", "y[2, 1]", "y[3, 1]", "y[2, 2]", "y[3, 2]", "y[2, 3]","y[3, 3]")) chars <- m$getNodeNames() - expect_identical(chars, c("mu","lifted_mu_plus_x", "y[2, 1]", "y[2, 2]", "y[2, 3]", "y[3, 1]", "y[3, 2]","y[3, 3]")) + expect_identical(chars, c("mu","lifted_mu_plus_x", "y[2, 1]", "y[3, 1]", "y[2, 2]", "y[3, 2]", "y[2, 3]","y[3, 3]")) chars <- m$getNodeNames(includeRHSonly = TRUE) - expect_identical(chars, c("x","mu","lifted_mu_plus_x", "y[2, 1]", "y[2, 2]", "y[2, 3]", "y[3, 1]", "y[3, 2]","y[3, 3]")) + expect_identical(chars, c("x","mu","lifted_mu_plus_x", "y[2, 1]", "y[3, 1]", "y[2, 2]", "y[3, 2]", "y[2, 3]","y[3, 3]")) # Check time series case where sortID varies amongst nodes in a single nodeRange. code <- nimbleCode({ @@ -139,19 +135,20 @@ test_that("old model API calls", { m <- nimbleModel(code, data =list(y=matrix(rnorm(6),3))) chars <- m$getNodes(returnScalarComponents=TRUE,nodesAsChars=TRUE) - expect_identical(chars, c("lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 2]", "y[1, 1]", "y[1, 2]", "y[2, 1]", "y[2, 2]", "y[3, 1]", "y[3, 2]", "mu[1]","mu[2]")) + expect_identical(chars, c("lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 2]", "y[1, 1]", "y[2, 1]", "y[3, 1]", "y[1, 2]", "y[2, 2]", "y[3, 2]", "mu[1]","mu[2]")) + chars <- m$getNodes(returnScalarComponents=TRUE,nodesAsChars=TRUE,.sort=TRUE) - expect_identical(chars, c("lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 2]", "mu[1]","mu[2]", "y[1, 1]", "y[1, 2]", "y[2, 1]", "y[2, 2]", "y[3, 1]", "y[3, 2]")) + expect_identical(chars, c("lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 2]", "mu[1]","mu[2]", "y[1, 1]", "y[1, 2]", "y[2, 1]", "y[2, 2]", "y[3, 1]", "y[3, 2]")) chars <- m$getNodeNames(returnScalarComponents=TRUE) - expect_identical(chars, c("lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 2]", "mu[1]","mu[2]", "y[1, 1]", "y[1, 2]", "y[2, 1]", "y[2, 2]", "y[3, 1]", "y[3, 2]")) + expect_identical(chars, c("lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 2]", "mu[1]","mu[2]", "y[1, 1]", "y[1, 2]", "y[2, 1]", "y[2, 2]", "y[3, 1]", "y[3, 2]")) chars <- m$expandNodeNames('y') expect_identical(chars, c("y[1, 1:2]", "y[2, 1:2]", "y[3, 1:2]")) chars <- m$expandNodeNames('y', sort=TRUE) expect_identical(chars, c("y[1, 1:2]", "y[2, 1:2]", "y[3, 1:2]")) chars <- m$expandNodeNames('y',returnScalarComponents=TRUE) - expect_identical(chars, c("y[1, 1]","y[1, 2]","y[2, 1]","y[2, 2]","y[3, 1]","y[3, 2]")) + expect_identical(chars, c("y[1, 1]","y[2, 1]","y[3, 1]","y[1, 2]","y[2, 2]","y[3, 2]")) chars <- m$expandNodeNames('y',returnScalarComponents=TRUE,sort=TRUE) expect_identical(chars, c("y[1, 1]","y[1, 2]","y[2, 1]","y[2, 2]","y[3, 1]","y[3, 2]")) @@ -163,12 +160,12 @@ test_that("old model API calls", { m <- nimbleModel(code, data =list(y=matrix(rnorm(8),4))) chars <- m$getNodes(returnScalarComponents=TRUE,nodesAsChars=TRUE) - expect_identical(chars, c("lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 2]", "y[1, 1]", "y[1, 2]", "y[2, 1]", "y[2, 2]", "y[3, 1]", "y[3, 2]")) + expect_identical(chars, c("lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 2]", "y[1, 1]", "y[2, 1]", "y[3, 1]", "y[1, 2]", "y[2, 2]", "y[3, 2]")) chars <- m$getNodes(returnScalarComponents=TRUE,nodesAsChars=TRUE,.sort=TRUE) - expect_identical(chars, c("lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 2]", "y[3, 1]", "y[3, 2]", "y[2, 1]", "y[2, 2]", "y[1, 1]", "y[1, 2]")) + expect_identical(chars, c("lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 2]", "y[3, 1]", "y[3, 2]", "y[2, 1]", "y[2, 2]", "y[1, 1]", "y[1, 2]")) chars <- m$getNodeNames(returnScalarComponents=TRUE) - expect_identical(chars, c("lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 2]","y[3, 1]", "y[3, 2]", "y[2, 1]", "y[2, 2]", "y[1, 1]", "y[1, 2]")) + expect_identical(chars, c("lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 1]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[1, 2]","lifted_chol_oPpr_oB1to2_comma_1to2_cB_cP[2, 2]","y[3, 1]", "y[3, 2]", "y[2, 1]", "y[2, 2]", "y[1, 1]", "y[1, 2]")) chars <- m$expandNodeNames('y') # This (and additional results below) is not the same as what nimble would give (it would have `y[4, 1:2]`) @@ -178,7 +175,7 @@ test_that("old model API calls", { chars <- m$expandNodeNames('y', sort=TRUE) expect_identical(chars, c("y[4, 1]","y[4, 2]","y[3, 1:2]","y[2, 1:2]","y[1, 1:2]")) chars <- m$expandNodeNames('y',returnScalarComponents=TRUE) - expect_identical(chars, c("y[1, 1]","y[1, 2]","y[2, 1]","y[2, 2]","y[3, 1]","y[3, 2]", "y[4, 1]", "y[4, 2]")) + expect_identical(chars, c("y[1, 1]","y[2, 1]","y[3, 1]","y[1, 2]","y[2, 2]","y[3, 2]", "y[4, 1]", "y[4, 2]")) chars <- m$expandNodeNames('y',returnScalarComponents=TRUE,sort=TRUE) expect_identical(chars, c("y[4, 1]","y[4, 2]","y[3, 1]","y[3, 2]", "y[2, 1]","y[2, 2]","y[1, 1]","y[1, 2]")) }) diff --git a/nimbleModel/tests/testthat/test-nodeRules.R b/nimbleModel/tests/testthat/test-nodeRules.R index ab5d22c..1c2fe5e 100644 --- a/nimbleModel/tests/testthat/test-nodeRules.R +++ b/nimbleModel/tests/testthat/test-nodeRules.R @@ -771,7 +771,7 @@ test_that("calcRule fracturing works", { } - ## two external indices, both fractured: mu[1:3, j ,2, i] + ## two external indices, both fractured: mu[1:3,j,i,2] LHS <- quote(mu[1:3,j,i,2]) LHSrule <- nodeRuleClass$new(LHS, 1, context_ij) calcRule <- calcRuleClass$new(LHSrule, NULL, NULL, context_ij) @@ -791,25 +791,23 @@ test_that("calcRule fracturing works", { } context_tmp <- modelContextClass$new(list(singleContextClass$new(forCode = quote(for(i in 1:4){})))) - idx1 <- as.integer(c(2,2,3,3)) - idx2 <- as.integer(c(2,3,2,3)) + idx1 <- as.integer(c(2,3,2,3)) + idx2 <- as.integer(c(2,2,3,3)) expr <- quote(mu[idx1[i],idx2[i]]) expected <- nodeRuleClass$new(expr, 1, context_tmp, constants = list(idx1 = idx1, idx2 = idx2)) expect_equal(result[[1]]$externalRule$indexRules[[1]]$setupResults, expected$externalRule$indexRules[[1]]$setupResults) + context_tmp <- modelContextClass$new(list(singleContextClass$new(forCode = quote(for(i in 1:24){})))) idx1 <- as.integer(c(1,4,1,4,rep(1:4, 5))) idx2 <- as.integer(c(2,2,3,3,rep(4:8, each = 4))) - ord <- order(idx1, idx2) - idx1 <- idx1[ord] - idx2 <- idx2[ord] expr <- quote(mu[idx1[i],idx2[i]]) expected <- nodeRuleClass$new(expr, 1, context_tmp, constants = list(idx1 = idx1, idx2 = idx2)) expect_equal(result[[2]]$externalRule$indexRules[[1]]$setupResults, expected$externalRule$indexRules[[1]]$setupResults) - ## two external indices fractured: mu[1:3, j ,2, i] , based on 2-d matrix + ## two external indices fractured: mu[1:3,j,i,2], based on 2-d matrix LHS <- quote(mu[1:3,j,i,2]) LHSrule <- nodeRuleClass$new(LHS, 1, context_ij) calcRule <- calcRuleClass$new(LHSrule, NULL, NULL, context_ij) @@ -841,9 +839,6 @@ test_that("calcRule fracturing works", { wh <- (idx1 == 2 & idx2 == 3) | (idx1 == 3 & idx2 == 7) idx1 <- idx1[!wh] idx2 <- idx2[!wh] - ord <- order(idx1, idx2) - idx1 <- idx1[ord] - idx2 <- idx2[ord] expr <- quote(mu[idx1[i],idx2[i]]) expected <- nodeRuleClass$new(expr, 1, context_tmp, constants = list(idx1 = idx1, idx2 = idx2)) expect_equal(result[[2]]$externalRule$indexRules[[1]]$setupResults, @@ -994,9 +989,6 @@ test_that("RHS exclusion works", { context_tmp <- modelContextClass$new(list(singleContextClass$new(forCode = quote(for(i in 1:5){})))) idx1 <- c(11,11,12,13,5) idx2 <- c(2,5,6,7,13) - ord <- order(idx1, idx2) - idx1 <- idx1[ord] - idx2 <- idx2[ord] expected <- rhsRuleClass$new(RHS, 1, context_tmp, constants = list(idx1 = idx1,idx2=idx2)) expect_equal(result[[1]]$externalRule$indexRules[[1]]$setupResults, expected$externalRule$indexRules[[1]]$setupResults) @@ -1015,9 +1007,6 @@ test_that("RHS exclusion works", { context_tmp <- modelContextClass$new(list(singleContextClass$new(forCode = quote(for(i in 1:26){})))) idx1 <- c(2,3,5,6,7,8,2,4:8,rep(2:8, 2)) idx2 <- c(rep(1,6),rep(2,6),rep(3,7), rep(4,7)) - ord <- order(idx1, idx2) - idx1 <- idx1[ord] - idx2 <- idx2[ord] expected <- rhsRuleClass$new(LHS, 1, context_tmp, constants = list(idx1 = idx1,idx2=idx2)) expect_equal(result[[1]]$externalRule$indexRules[[1]]$setupResults, expected$externalRule$indexRules[[1]]$setupResults) @@ -1116,9 +1105,6 @@ test_that("RHS exclusion works", { context_tmp <- modelContextClass$new(list(singleContextClass$new(forCode = quote(for(i in 1:17){})))) idx1 <- c(2:6,2:6,2:8) idx2 <- c(rep(1,5), rep(2,5), rep(3, 7)) - ord <- order(idx1, idx2) - idx1 <- idx1[ord] - idx2 <- idx2[ord] RHS <- quote(mu[idx1[i], idx2[i]]) expected <- rhsRuleClass$new(RHS, 1, context_tmp, constants = list(idx1 = idx1,idx2=idx2)) expect_equal(result[[1]]$externalRule$indexRules[[1]]$setupResults, @@ -1135,9 +1121,6 @@ test_that("RHS exclusion works", { context_tmp <- modelContextClass$new(list(singleContextClass$new(forCode = quote(for(i in 1:20){})))) idx1 <- c(2:8,2:8,2,4:8) idx2 <- c(rep(1,7), rep(2,7), rep(3, 6)) - ord <- order(idx1, idx2) - idx1 <- idx1[ord] - idx2 <- idx2[ord] RHS <- quote(mu[idx1[i], idx2[i]]) expected <- rhsRuleClass$new(RHS, 1, context_tmp, constants = list(idx1 = idx1,idx2=idx2)) expect_equal(result[[1]]$externalRule$indexRules[[1]]$setupResults, @@ -1193,9 +1176,6 @@ test_that("RHS exclusion works", { singleContextClass$new(forCode = quote(for(j in 1:4){})))) idx1 <- c(2:6,2:6,2:8) idx2 <- c(rep(1,5), rep(2,5), rep(3, 7)) - ord <- order(idx1, idx2) - idx1 <- idx1[ord] - idx2 <- idx2[ord] expr <- quote(mu[idx1[i], j, idx2[i]]) expected <- rhsRuleClass$new(expr, 1, context_tmp, constants = list(idx1 = idx1,idx2=idx2)) expect_equal(result[[1]]$externalRule$indexRules[[2]]$setupResults, @@ -1363,9 +1343,9 @@ test_that("nodeRange::toNodeChars works correctly", { expect_identical(nodeRanges[[2]]$toNodeChars(), "lifted_chol_oPpr_oB1to3_comma_1to3_cB_cP[1:3, 1:3]") expect_identical(nodeRanges[[3]]$toNodeChars(), - c("y[1, 3, 1, 1, 2:4]", "y[1, 3, 2, 1, 2:4]", "y[2, 3, 1, 2, 2:4]", - "y[2, 3, 2, 2, 2:4]", "y[3, 3, 1, 3, 2:4]", "y[3, 3, 2, 3, 2:4]", - "y[4, 3, 1, 4, 2:4]", "y[4, 3, 2, 4, 2:4]")) + c("y[1, 3, 1, 1, 2:4]", "y[2, 3, 1, 2, 2:4]", "y[3, 3, 1, 3, 2:4]", + "y[4, 3, 1, 4, 2:4]", "y[1, 3, 2, 1, 2:4]", "y[2, 3, 2, 2, 2:4]", + "y[3, 3, 2, 3, 2:4]", "y[4, 3, 2, 4, 2:4]")) expect_identical(nodeRanges[[4]]$toNodeChars(), c("w[1]", "w[2]", "w[3]")) expect_identical(nodeRanges[[5]]$toNodeChars(), c("v[1, 1]", "v[2, 2]", "v[3, 3]")) diff --git a/nimbleModel/tests/testthat/test-varRange.R b/nimbleModel/tests/testthat/test-varRange.R index 14ba7a2..841a527 100644 --- a/nimbleModel/tests/testthat/test-varRange.R +++ b/nimbleModel/tests/testthat/test-varRange.R @@ -192,7 +192,7 @@ test_that("toVarChars works correctly", { vr <- varRangeClass$new(list(newIndexRange(matrix(c(2,4,5), ncol = 1)), newIndexRange(quote(3:4))), varName = "y") expect_identical(vr$toVarChars(), paste0("y[", c(2,4,5), ", 3:4]")) - gr <- expand.grid(3:4, c(2,4,5))[c(2,1)] + gr <- expand.grid(c(2,4,5), 3:4) expect_identical(vr$toVarChars(expandScalars = TRUE), paste0("y[", gr[,1], ", ", gr[,2], "]")) @@ -206,11 +206,11 @@ test_that("toVarChars works correctly", { md <- modelDefClass$new(code, constants = list(idx = c(2,5,4))) vr <- getDependencies(md, 'z', self=FALSE)[[1]] expect_identical(vr$toVarChars(), - c("y[2, 2, 3, 1:2, 1, 2:4]", "y[2, 3, 3, 1:2, 2, 2:4]", "y[2, 4, 3, 1:2, 3, 2:4]", "y[2, 5, 3, 1:2, 4, 2:4]", "y[4, 2, 3, 1:2, 1, 2:4]", "y[4, 3, 3, 1:2, 2, 2:4]", "y[4, 4, 3, 1:2, 3, 2:4]", "y[4, 5, 3, 1:2, 4, 2:4]", "y[5, 2, 3, 1:2, 1, 2:4]", "y[5, 3, 3, 1:2, 2, 2:4]", "y[5, 4, 3, 1:2, 3, 2:4]", "y[5, 5, 3, 1:2, 4, 2:4]")) + c("y[2, 2, 3, 1:2, 1, 2:4]", "y[4, 2, 3, 1:2, 1, 2:4]", "y[5, 2, 3, 1:2, 1, 2:4]", "y[2, 3, 3, 1:2, 2, 2:4]", "y[4, 3, 3, 1:2, 2, 2:4]", "y[5, 3, 3, 1:2, 2, 2:4]", "y[2, 4, 3, 1:2, 3, 2:4]", "y[4, 4, 3, 1:2, 3, 2:4]", "y[5, 4, 3, 1:2, 3, 2:4]", "y[2, 5, 3, 1:2, 4, 2:4]", "y[4, 5, 3, 1:2, 4, 2:4]", "y[5, 5, 3, 1:2, 4, 2:4]")) tmp <- vr$toVarChars() result <- unlist(lapply(tmp, function(x) varRangeClass$new(x)$toVarChars(expandScalars = TRUE))) - expect_identical(vr$toVarChars(expandScalars = TRUE), result) + expect_identical(sort(vr$toVarChars(expandScalars = TRUE)), sort(result)) code <- quote({ @@ -220,7 +220,7 @@ test_that("toVarChars works correctly", { }) md <- modelDefClass$new(code) vr <- getDependencies(md, 'y')[[1]] - gr <- expand.grid(1:2, 1:3)[c(2,1)] + gr <- expand.grid(1:3, 1:2) expect_identical(vr$toVarChars(expandScalars = TRUE), paste0("y[", gr[,1], ", ", gr[,2], "]"))