我希望在R中生成一个随机的n乘n矩阵，其离散值范围为1至n。麻烦的部分是我想要确保每个值在行和列中都是唯一的。
例如，如果n = 3，则该矩阵可能如下所示：
或者它可能看起来像这样：
例如，如果n = 3，则该矩阵可能如下所示：
1 2 3
2 3 1
3 1 2
或者它可能看起来像这样：
2 3 1
1 2 3
3 1 2
有人知道如何生成这种矩阵吗？
4个回答
5
你需要的是一个拉丁方阵。下面是一个函数(来自R菜谱; 可以在这里和其他在线搜索结果中查看)可以生成它们：
latinsquare <- function(len, reps=1, seed=NA, returnstrings=FALSE) {
# Save the old random seed and use the new one, if present
if (!is.na(seed)) {
if (exists(".Random.seed")) { saved.seed <- .Random.seed }
else { saved.seed <- NA }
set.seed(seed)
}
# This matrix will contain all the individual squares
allsq <- matrix(nrow=reps*len, ncol=len)
# Store a string id of each square if requested
if (returnstrings) { squareid <- vector(mode = "character", length = reps) }
# Get a random element from a vector (the built-in sample function annoyingly
# has different behavior if there's only one element in x)
sample1 <- function(x) {
if (length(x)==1) { return(x) }
else { return(sample(x,1)) }
}
# Generate each of n individual squares
for (n in 1:reps) {
# Generate an empty square
sq <- matrix(nrow=len, ncol=len)
# If we fill the square sequentially from top left, some latin squares
# are more probable than others. So we have to do it random order,
# all over the square.
# The rough procedure is:
# - randomly select a cell that is currently NA (call it the target cell)
# - find all the NA cells sharing the same row or column as the target
# - fill the target cell
# - fill the other cells sharing the row/col
# - If it ever is impossible to fill a cell because all the numbers
# are already used, then quit and start over with a new square.
# In short, it picks a random empty cell, fills it, then fills in the
# other empty cells in the "cross" in random order. If we went totally randomly
# (without the cross), the failure rate is much higher.
while (any(is.na(sq))) {
# Pick a random cell which is currently NA
k <- sample1(which(is.na(sq)))
i <- (k-1) %% len +1 # Get the row num
j <- floor((k-1) / len) +1 # Get the col num
# Find the other NA cells in the "cross" centered at i,j
sqrow <- sq[i,]
sqcol <- sq[,j]
# A matrix of coordinates of all the NA cells in the cross
openCell <-rbind( cbind(which(is.na(sqcol)), j),
cbind(i, which(is.na(sqrow))))
# Randomize fill order
openCell <- openCell[sample(nrow(openCell)),]
# Put center cell at top of list, so that it gets filled first
openCell <- rbind(c(i,j), openCell)
# There will now be three entries for the center cell, so remove duplicated entries
# Need to make sure it's a matrix -- otherwise, if there's just
# one row, it turns into a vector, which causes problems
openCell <- matrix(openCell[!duplicated(openCell),], ncol=2)
# Fill in the center of the cross, then the other open spaces in the cross
for (c in 1:nrow(openCell)) {
# The current cell to fill
ci <- openCell[c,1]
cj <- openCell[c,2]
# Get the numbers that are unused in the "cross" centered on i,j
freeNum <- which(!(1:len %in% c(sq[ci,], sq[,cj])))
# Fill in this location on the square
if (length(freeNum)>0) { sq[ci,cj] <- sample1(freeNum) }
else {
# Failed attempt - no available numbers
# Re-generate empty square
sq <- matrix(nrow=len, ncol=len)
# Break out of loop
break;
}
}
}
# Store the individual square into the matrix containing all squares
allsqrows <- ((n-1)*len) + 1:len
allsq[allsqrows,] <- sq
# Store a string representation of the square if requested. Each unique
# square has a unique string.
if (returnstrings) { squareid[n] <- paste(sq, collapse="") }
}
# Restore the old random seed, if present
if (!is.na(seed) && !is.na(saved.seed)) { .Random.seed <- saved.seed }
if (returnstrings) { return(squareid) }
else { return(allsq) }
}
- Julius Vainora
2
mats 是这些矩阵的列表。它使用 r2dtable 生成 N 个随机的 n x n 矩阵，其元素从0、1、...、n-1中选择，每个边缘都由 margin 给出。然后过滤掉那些所有列都有0:(n-1)的矩阵，并添加一个矩阵以得到结果。返回的矩阵数量可能会有所不同，当n变大时，您需要生成大量的矩阵 N 才能得到很少的矩阵。当我尝试将 n <- 3 以下时，mats 是100个矩阵中的24个矩阵列表，但当 n <- 4 时，它只找到了100个矩阵中的1个。
set.seed(123)
N <- 100 # no of tries
n <- 3 # rows of matrix (= # cols)
check <- function(x) all(apply(x, 2, sort) == seq_len(nrow(x))-1)
margin <- sum(seq_len(n))-n
margins <- rep(margin, n)
L <- r2dtable(N, r = margins, c = margins)
mats <- lapply(Filter(check, L), "+", 1)
- G. Grothendieck
1
这是一份尝试：
这是：
对于一般情况：
如果我没错的话，这就是预期的结果：
翻译：更短：
在此处插入HTML代码
x <- c(1,2,3)
out <- NULL
for(i in 1:3){
y <- c(x[1 + (i+0) %% 3], x[1 + (i+1) %% 3], x[1 + (i+2) %% 3])
out <- rbind(out,y)
}
这是：
> out
[,1] [,2] [,3]
y 2 3 1
y 3 1 2
y 1 2 3
对于一般情况：
n <- 4
x <- 1:n
out <- NULL
for(i in 1:n){
y <- x[1 + ((i+0:(n-1))%%n)]
out <- rbind(out,y)
}
如果我没错的话，这就是预期的结果：
> out
[,1] [,2] [,3] [,4]
y 2 3 4 1
y 3 4 1 2
y 4 1 2 3
y 1 2 3 4
翻译：更短：
n < 4
x <- 1:n
vapply(x, function(i) x[1 + ((i+0:(n-1))%%n)], numeric(n))
- Stéphane Laurent
0
这里有一个版本，它生成了这种矩阵的所有可能行，然后逐个取出它们，每次都限制选择有效的选项：
n <- 9
allrows <- combinat::permn(n)
takerows <- function(taken, all) {
available <- rep(TRUE, length(all))
for(i in 1:nrow(taken)) {
available <- sapply(all, function(x) all((x-taken[i,])!=0)) & available
}
matrix(all[[which(available)[sample(sum(available), 1)]]], nrow=1)
}
magicMat <- takerows(matrix(rep(0, n), ncol=n), allrows)
for(i in 1:(n-1)) {
magicMat <- rbind(magicMat, takerows(magicMat, allrows))
}
> magicMat
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 5 3 1 4 2 8 6 7 9
[2,] 9 8 6 2 1 3 7 4 5
[3,] 4 5 7 8 9 2 3 6 1
[4,] 3 9 2 1 6 7 5 8 4
[5,] 1 6 5 3 8 4 2 9 7
[6,] 7 2 4 9 3 5 8 1 6
[7,] 6 4 8 5 7 1 9 3 2
[8,] 8 1 9 7 5 6 4 2 3
[9,] 2 7 3 6 4 9 1 5 8
- Karolis Koncevičius
网页内容由stack overflow 提供, 点击上面的可以查看英文原文，
原文链接
原文链接