add swap option in pREP function

R/utils_pREP.R

@@ -67,6 +67,7 @@ pREP <- function(nrows = NULL, ncols = NULL, RepChecks = NULL, checks = NULL,
 
  ######################some review on the data entry##########################
  #my_REPS <- subset(gen_list_order, REPS > 1)
+ optim <- FALSE
  if (prep == TRUE) {
  freq_reps <- table(my_REPS[,3])
  nREPS <- as.vector(as.numeric((names(freq_reps))))
@@ -185,13 +186,15 @@ pREP <- function(nrows = NULL, ncols = NULL, RepChecks = NULL, checks = NULL,
  ###################################################
 
  layout <- apply(layout1, c(1,2), as.numeric)
-
+ #print(sqrt(sum(dim(layout)^2)) / 3)
+ # min_dist <- floor(sqrt(sum(dim(layout)^2)) / 3.5)
+ # print(min_dist)
+ new_layout <- swap_pairs(X = layout, min_dist = 7)
  return(list(
- field.map = layout, 
+ field.map = new_layout, 
  gen.entries = entries, 
  gen.list = gen.list,
  reps.checks = reps.checks,
  entryChecks = entry.checks, 
  binary.field = binary_field))
-
 }

R/utils_swap_pairs.R

@@ -0,0 +1,48 @@
+swap_pairs <- function(X, min_dist) {
+ while (TRUE) {
+ # Keep track of whether any swaps were made in this iteration
+ any_swaps <- FALSE
+ # Loop through each integer in the matrix
+ for (value in unique(X)) {
+ indices <- which(X == value, arr.ind = TRUE)
+ if (nrow(indices) > 1) {
+ # Calculate the pairwise distances between the indices
+ distances <- proxy::dist(indices)
+ # distances <- matrix(data = c(0, distances, distances, 0), 
+ # nrow = nrow(indices), 
+ # ncol = nrow(indices),
+ # byrow = TRUE)
+ for (i in seq_len(nrow(indices))) {
+ #for (j in nrow(indices):1) {
+ if (distances < min_dist) {
+ other_values <- setdiff(unique(X), value)
+ other_indices <- matrix(
+ data = c(rep(1:dim(X)[1], each = dim(X)[2]), rep(1:dim(X)[2], times = dim(X)[1])), 
+ nrow = prod(dim(X)),
+ ncol = 2, 
+ byrow = FALSE
+ )
+ other_indices <- cbind(other_indices, as.vector(t(X)) %in% other_values)
+ colnames(other_indices) <- c("i", "j", "value")
+ other_indices <- other_indices[other_indices[,3] != 0, ][, 1:2]
+ dists <- apply(other_indices, 1, function(x) sum((x - as.vector(indices[i,]))^2))
+ valid_indices <- other_indices[sqrt(dists) >= min_dist, ]
+ if (nrow(valid_indices) > 0) {
+ k <- sample(nrow(valid_indices), size = 1)
+ # Swap the two occurrences
+ X[indices[i,1], indices[i,2]] <- X[valid_indices[k,1], valid_indices[k,2]]
+ X[valid_indices[k,1], valid_indices[k,2]] <- value
+ any_swaps <- TRUE
+ }
+ }
+ # }
+ }
+ }
+ }
+ # If no swaps were made in this iteration, break out of the loop
+ if (!any_swaps) {
+ break
+ }
+ }
+ return(X)
+}