Как получить все возможные деления поля в матрицу в R

Question

У меня есть это поле:

Я хочу получить все потенциальные исключения из этого поля. Но есть ограничение: делинация должна состоять только из соседних кварталов. Это означает, что у нас не может быть деления на 1-4 квартал и 2-3 квартал. Количество потенциальных делений определяется по формуле:

| N | = $$ (\ sum_ {i = 1} ^ {Width-MinWidth + 1} i) (\ sum_ {i = 1} ^ {Length-MinLength + 1} i) $$,

где Width равна ширине поля, длина равна длине поля (в этом случае оба равны 2), MinWidth равняется минимальной ширине зоны, а MinLength равняется минимальной длине зоны (в этом случае они могут быть 1 или 2 ).

Итак, если MinWidth = 1 и MinLength = 1, в этом примере | N | = 9.

Я бы хотел иметь прямоугольные angular зоны этого поля в соответствующей матрице. Эта соответствующая матрица для этого примера должна выглядеть следующим образом:

      [,1] [,2] [,3] [,4]
 [1,]    1    0    0    0
 [2,]    0    1    0    0
 [3,]    0    0    1    0
 [4,]    0    0    0    1
 [5,]    1    1    0    0
 [6,]    0    0    1    1
 [7,]    1    0    1    0
 [8,]    0    1    0    1
 [9,]    1    1    1    1

Интерпретация этой матрицы состоит в том, что первое разделение состоит только из 1-го квартала (и 2,3,4 вместе), второго разделение состоит только из 2-го квартала (и 1,3,4 вместе), ..., пятый разделение состоит из 1-го и 2-го квартала (и 3,4 вместе), и так продолжается. Матрица для поля 3x3 будет представлять собой матрицу 36x9, аналогичную приведенной выше.

Мне удалось построить al oop, который вычисляет | N | раз (число потенциальных границ), код приведен ниже:

z <- 0
  for (j in MinWidth:Width) {
    for (l in 0:(Width - 1)) {
      if ((j + l) <= Width) {
        for (i in MinLength:Length) {
          for (k in 0:(Length-1)) {
            if ((k + i) <= Length) {
              z <- z + 1
            }
          }
        }
      }
    }
  }

Что делает этот l oop:

Требуется четверти, а затем проверяется, остались ли пространство, сначала по ширине, а затем по длине, чтобы создать зону. j обозначает ширину, l обозначает оставшуюся доступную ширину, i обозначает длину и k обозначает оставшуюся доступную длину. Но я не могу получить правильные строки матрицы для каждого l oop.

Есть ли какие-либо иды, как я могу сделать это в R?

Answer 1

Это немного запутанное решение (оно, безусловно, может быть оптимизировано), если оно возвращает вашу матрицу только с основанием R. Просто введите mat (l, w), где l и w описывают длину и ширину вашего поля:

library(nnls)

expand <- function(x) {
  out = x
  index = which(is.na(x))
  for(i in 1:length(index)) {
    y = x[(index[i]+1):length(x)]
    add = length(x)-length(y)
    out = rbind(out,c(y,rep(NA,add)))
  }
  return(out)
}

check_split <- function(M) {
  check = c()
  for(i in 1:nrow(M)) {
    Y = ifelse(M[i,] == 1,0,1)
    mod = round(coef(nnls(t(M[-i,]),matrix(Y))),10)
    mod[is.na(mod)] = 0
    check = c(check,all(mod %in% c(1,0)))
  }
  return(check)
}

mat <- function(l,w,minL,minW) {
  print(matrix(1:(l*w),byrow=T,nrow=l))

  out = list()
  x=c()
  for(i in 1:(l*w)) {
    if(i%%w == 0){
      x = c(x,i,NA)
    } else {
      x = c(x,i)
    }
  }

  y = expand(x)
  for (m in 1:l) {
    y = expand(x)[1:m,]
    for (n in 0:w) {
      for (i in 1:length(x)) {
        if(m == 1) {
        out = c(out,list(y[i:(i+n)]))
        } else {
          out = c(out,list(y[,i:min((i+n),ncol(y))]))
        }
      }
    }
  }

allCombinations = out[unlist(lapply(out,function(x) !any(is.na(x))))]
allCombinations = lapply(allCombinations,as.matrix,byrow=T)
allCombinations = lapply(allCombinations,function(x) if(ncol(x)==1 & is.null(rownames(x))){t(x)}else{x})

## Account for restrictions
lengths = lapply(allCombinations, nrow)
widths = lapply(allCombinations, ncol)
simple = lapply(allCombinations, function(x) sort(as.vector(x)))[lengths >= minL & widths >= minW]

## Desired matrix
output = do.call(rbind, lapply(simple, function(x) ifelse(1:(l*w) %in% x, 1,0)))

output[check_split(output),]

}

С удовольствием отвечу на вопросы, если есть путаница.