Last updated on 2025-05-10 16:53:08 CEST.
| Package | ERROR | OK |
|---|---|---|
| SFDesign | 1 | 8 |
Current CRAN status: ERROR: 1, OK: 8
Version: 0.1.0
Check: examples
Result: ERROR
Running examples in ‘SFDesign-Ex.R’ failed
The error most likely occurred in:
> ### Name: customLHD
> ### Title: Generate a Latin-hypercube design (LHD) based on a custom
> ### criterion.
> ### Aliases: customLHD
>
> ### ** Examples
>
> # Below is an example showing how to create functions needed to generate
> # MaxPro LHD manually by customLHD without using the maxproLHD function in
> # the package.
> compute.distance.matrix <- function(A){
+ s = 2
+ log_prod_metric = function(x, y) s * sum(log(abs(x-y)))
+ return (c(proxy::dist(A, log_prod_metric)))
+ }
> compute.criterion <- function(n, p, d) {
+ s = 2
+ dim <- as.integer(n * (n - 1) / 2)
+ # Find the minimum distance
+ Dmin <- min(d)
+ # Compute the exponential summation
+ avgdist <- sum(exp(Dmin - d))
+ # Apply the logarithmic transformation and scaling
+ avgdist <- log(avgdist) - Dmin
+ avgdist <- exp((avgdist - log(dim)) * (p * s) ^ (-1))
+ return(avgdist)
+ }
>
> update.distance.matrix <- function(A, col, selrow1, selrow2, d) {
+ s = 2
+ n = nrow(A)
+ # transform from c++ idx to r idx
+ selrow1 = selrow1 + 1
+ selrow2 = selrow2 + 1
+ col = col + 1
+ # A is the updated matrix
+ row1 <- min(selrow1, selrow2)
+ row2 <- max(selrow1, selrow2)
+
+ compute_position <- function(row, h, n) {
+ n * (h-1) - h*(h-1)/2 + row-h
+ }
+
+ # Update for rows less than row1
+ if (row1 > 1) {
+ for (h in 1:(row1-1)) {
+ position1 <- compute_position(row1, h, n)
+ position2 <- compute_position(row2, h, n)
+ for (c in col){
+ d[position1] <- d[position1] + s * log(abs(A[row1, c] - A[h, c])) -
+ s * log(abs(A[row2, c] - A[h, c]))
+ d[position2] <- d[position2] + s * log(abs(A[row2, c] - A[h, c])) -
+ s * log(abs(A[row1, c] - A[h, c]))
+ }
+ }
+ }
+
+ # Update for rows between row1 and row2
+ if ((row2-row1) > 1){
+ for (h in (row1+1):(row2-1)) {
+ position1 <- compute_position(h, row1, n)
+ position2 <- compute_position(row2, h, n)
+ for (c in col){
+ d[position1] <- d[position1] + s * log(abs(A[row1, c] - A[h, c])) -
+ s * log(abs(A[row2, c] - A[h, c]))
+ d[position2] <- d[position2] + s * log(abs(A[row2, c] - A[h, c])) -
+ s * log(abs(A[row1, c] - A[h, c]))
+ }
+ }
+ }
+
+ # Update for rows greater than row2
+ if (row2 < n) {
+ for (h in (row2+1):n) {
+ position1 <- compute_position(h, row1, n)
+ position2 <- compute_position(h, row2, n)
+ for (c in col){
+ d[position1] <- d[position1] + s * log(abs(A[row1, c] - A[h, c])) -
+ s * log(abs(A[row2, c] - A[h, c]))
+ d[position2] <- d[position2] + s * log(abs(A[row2, c] - A[h, c])) -
+ s * log(abs(A[row1, c] - A[h, c]))
+ }
+ }
+ }
+ return (d)
+ }
>
> n = 10
> p = 2
> # Find an appropriate initial temperature
> crit1 = 1 / (n-1)
> crit2 = (1 / ((n-1)^(p-1) * (n-2))) ^ (1/p)
> delta = crit2 - crit1
> temp = - delta / log(0.99)
> result_custom = customLHD(compute.distance.matrix,
+ function(d) compute.criterion(n, p, d),
+ update.distance.matrix, n, p, temp = temp)
*** caught segfault ***
address 0x30, cause 'memory not mapped'
Traceback:
1: nrow(A)
2: (function (A, col, selrow1, selrow2, d) { s = 2 n = nrow(A) selrow1 = selrow1 + 1 selrow2 = selrow2 + 1 col = col + 1 row1 <- min(selrow1, selrow2) row2 <- max(selrow1, selrow2) compute_position <- function(row, h, n) { n * (h - 1) - h * (h - 1)/2 + row - h } if (row1 > 1) { for (h in 1:(row1 - 1)) { position1 <- compute_position(row1, h, n) position2 <- compute_position(row2, h, n) for (c in col) { d[position1] <- d[position1] + s * log(abs(A[row1, c] - A[h, c])) - s * log(abs(A[row2, c] - A[h, c])) d[position2] <- d[position2] + s * log(abs(A[row2, c] - A[h, c])) - s * log(abs(A[row1, c] - A[h, c])) } } } if ((row2 - row1) > 1) { for (h in (row1 + 1):(row2 - 1)) { position1 <- compute_position(h, row1, n) position2 <- compute_position(row2, h, n) for (c in col) { d[position1] <- d[position1] + s * log(abs(A[row1, c] - A[h, c])) - s * log(abs(A[row2, c] - A[h, c])) d[position2] <- d[position2] + s * log(abs(A[row2, c] - A[h, c])) - s * log(abs(A[row1, c] - A[h, c])) } } } if (row2 < n) { for (h in (row2 + 1):n) { position1 <- compute_position(h, row1, n) position2 <- compute_position(h, row2, n) for (c in col) { d[position1] <- d[position1] + s * log(abs(A[row1, c] - A[h, c])) - s * log(abs(A[row2, c] - A[h, c])) d[position2] <- d[position2] + s * log(abs(A[row2, c] - A[h, c])) - s * log(abs(A[row1, c] - A[h, c])) } } } return(d)})(NULL, 1L, 0L, 2L, c(-6.43775164973638, -3.42959685618383, -1.73500113540941, -5.31852007386554, -6.43775164973633, -1.8325814637483, -5.05145728861645, -3.79423996977173, -6.43775164973639, -5.05145728861647, -3.12129549652933, -2.85423271128023, -5.62682143352001, -4.81589121730369, -5.05145728861645, -5.62682143352002, -2.77258872223967, -7.01311579463991, -3.21887582486816, -6.43775164973636, -5.99146454710792, -6.43775164973637, -5.62682143352002, -5.31852007386549, -5.62682143352004, -3.21887582486818, -6.43775164973637, -5.99146454710796, -6.43775164973637, -3.66516292749658, -5.99146454710796, -6.43775164973638, -1.73500113540939, -6.43775164973636, -5.62682143352003, -3.42959685618382, -5.62682143352006, -7.01311579463997, -5.62682143352004, -3.12129549652932, -5.6268214335201, -2.85423271128025, -3.21887582486817, -2.61866663996748, -6.43775164973637))
3: customLHDOptimizer_cpp(compute.distance.matrix, compute.criterion, update.distance.matrix, design, num.passes, max.sa.iter, temp, decay, no.update.iter.max, "sa")
4: customLHD(compute.distance.matrix, function(d) compute.criterion(n, p, d), update.distance.matrix, n, p, temp = temp)
An irrecoverable exception occurred. R is aborting now ...
Flavor: r-oldrel-macos-x86_64