构建具有指定数量单元格的square-ish矩阵

时间:2014-01-18 14:25:41

标签: r matrix sequence

我想编写一个函数,将整数n(指定矩阵中的单元格数)转换为包含序列1:n的square-ish矩阵。目标是使矩阵尽可能“正方形”。

这需要考虑几个因素:

  1. 如何最大化“方形”性?我在想一个等于矩阵尺寸差异的惩罚,例如: penalty <- abs(dim(mat)[1]-dim(mat)[2]),当矩阵为正方形时为penalty==0,否则为正。理想情况下,例如,这将导致n==12导致偏好3x4而不是2x6矩阵。但我不确定最好的方法。

  2. 考虑n的奇数值。 n的奇数值不一定会产生明显的矩阵选择(除非它们有一个整数平方根,如n==9。我想只需将{1}添加到n,然后处理为偶数并允许一个空白单元格,但我不确定这是否是最好的方法。我想可能通过添加多于1来获得更多方形矩阵(通过1中的定义) n

  3. 允许函数权衡平方(如#1中所述)和空白单元格数(如#2中所述),因此函数应该有某种参数来解决这个问题交易。例如,对于n==11,3x4矩阵非常方形,但不像4x4那样正方形,但4x4的空白单元格比3x4多。

  4. 该函数需要选择性地生成更宽或更高的矩阵,以便n==12可以生成3x4或4x3矩阵。但是使用t()得到的矩阵很容易处理。


  5. 这是一些预期的输出:

    > makemat(2)
         [,1]
    [1,]    1
    [2,]    2
    
    > makemat(3)
         [,1] [,2]
    [1,]    1    3
    [2,]    2    4
    
    > makemat(9)
         [,1] [,2] [,3]
    [1,]    1    4    7
    [2,]    2    5    8
    [3,]    3    6    9
    
    > makemat(11)
         [,1] [,2] [,3] [,4]
    [1,]    1    4    7    10
    [2,]    2    5    8    11
    [3,]    3    6    9    12
    

    这个问题基本上是一个非常可怕的开始。

    makemat <- function(n) {
        n <- abs(as.integer(n))
        d <- seq_len(n)
        out <- d[n %% d == 0]
        if(length(out)<2)
            stop('n has fewer than two factors')
        dim1a <- out[length(out)-1]
        m <- matrix(1:n, ncol=dim1a)
        m
    }
    

    正如您所见,我无法真正考虑n的奇数值(请查看#{1}}或makemat(7)的输出,如#2中所述,或强制执行#1中描述的“方形”规则,或执行#3中所述的权衡。

3 个答案:

答案 0 :(得分:12)

我认为您想要的逻辑已经在效用函数n2mfrow()中,顾名思义就是创建mfrow图形参数的输入并获取整数输入并返回面板数在行和列中将显示拆分为:

> n2mfrow(11)
[1] 4 3

它支持高布局而不是宽布局,但可以通过输出上的rev()t()的结果生成的矩阵n2mfrow()轻松修复。

makemat <- function(n, wide = FALSE) {
  if(isTRUE(all.equal(n, 3))) {
    dims <- c(2,2)
  } else {
    dims <- n2mfrow(n)
  }
  if(wide)
    dims <- rev(dims)
  m <- matrix(seq_len(prod(dims)), nrow = dims[1], ncol = dims[2])
  m
}

注意我必须使用特殊情况n = 3,因为我们滥用了一个用于其他用途的函数,并且绘图上的3x1布局比具有空白空间的2x2更有意义。

在使用中我们有:

> makemat(2)
     [,1]
[1,]    1
[2,]    2
> makemat(3)
     [,1] [,2]
[1,]    1    3
[2,]    2    4
> makemat(9)
     [,1] [,2] [,3]
[1,]    1    4    7
[2,]    2    5    8
[3,]    3    6    9
> makemat(11)
     [,1] [,2] [,3]
[1,]    1    5    9
[2,]    2    6   10
[3,]    3    7   11
[4,]    4    8   12
> makemat(11, wide = TRUE)
     [,1] [,2] [,3] [,4]
[1,]    1    4    7   10
[2,]    2    5    8   11
[3,]    3    6    9   12

编辑:

原始函数用seq_len(n)填充NA,但我意识到OP希望有一个从1到prod(nrows, ncols)的序列,这就是上面的版本。下面的一个用NA填充。

makemat <- function(n, wide = FALSE) {
  if(isTRUE(all.equal(n, 3))) {
    dims <- c(2,2)
  } else {
    dims <- n2mfrow(n)
  }
  if(wide)
    dims <- rev(dims)
  s <- rep(NA, prod(dims))
  ind <- seq_len(n)
  s[ind] <- ind
  m <- matrix(s, nrow = dims[1], ncol = dims[2])
  m
}

答案 1 :(得分:6)

我认为这个函数隐含地满足了你的约束。参数范围为0到Inf。该函数始终返回边长为ceiling(sqrt(n))的方形矩阵,或带有行floor(sqrt(n))的(可能)矩形矩阵,并且只有足够的列来“填充”。该参数对两者之间的选择进行折衷:如果它小于1,则优选第二个更矩形的矩阵,如果大于1,则优选第一个,总是正方形的矩阵。 param为1的权重。

makemat<-function(n,param=1,wide=TRUE){
  if (n<1) stop('n must be positive')
  s<-sqrt(n)
  bottom<-n-(floor(s)^2)
  top<-(ceiling(s)^2)-n
  if((bottom*param)<top) {
      rows<-floor(s)
      cols<-rows + ceiling(bottom / rows) 
  } else {
    cols<-rows<-ceiling(s)
  }
  if(!wide) {
    hold<-rows
    rows<-cols
    cols<-hold
  }
  m<-seq.int(rows*cols)
  dim(m)<-c(rows,cols)
  m
}

这是一个将参数设置为默认值的示例,同样平均距离:

lapply(c(2,3,9,11),makemat)

# [[1]]
#      [,1] [,2]
# [1,]    1    2
# 
# [[2]]
#      [,1] [,2]
# [1,]    1    3
# [2,]    2    4
# 
# [[3]]
#      [,1] [,2] [,3]
# [1,]    1    4    7
# [2,]    2    5    8
# [3,]    3    6    9
# 
# [[4]]
#      [,1] [,2] [,3] [,4]
# [1,]    1    4    7   10
# [2,]    2    5    8   11
# [3,]    3    6    9   12

以下是使用带有11的param来获得4x4矩阵的示例。

makemat(11,3)
#      [,1] [,2] [,3] [,4]
# [1,]    1    5    9   13
# [2,]    2    6   10   14
# [3,]    3    7   11   15
# [4,]    4    8   12   16   

答案 2 :(得分:4)

如果事情相当简单,你可以在包装器中处理异常和其他请求吗?

library(taRifx)
neven <- 8
nodd <- 11
nsquareodd <- 9
nsquareeven <- 16

makemat <- function(n) {
  s <- seq(n)
  if( odd(n) ) {
    s[ length(s)+1 ] <- NA
    n <- n+1
  }
  sq <- sqrt( n )
  dimx <- ceiling( sq )
  dimy <- floor( sq )
  if( dimx*dimy < length(s) )  dimy <- ceiling( sq )
  l <- dimx*dimy
  ldiff <- l - length(s)
  stopifnot( ldiff >= 0 )
  if( ldiff > 0 )  s[ seq( length(s) + 1, length(s) + ldiff ) ] <- NA
  matrix( s, nrow = dimx, ncol = dimy )
}

> makemat(neven)
     [,1] [,2] [,3]
[1,]    1    4    7
[2,]    2    5    8
[3,]    3    6   NA
> makemat(nodd)
     [,1] [,2] [,3]
[1,]    1    5    9
[2,]    2    6   10
[3,]    3    7   11
[4,]    4    8   NA
> makemat(nsquareodd)
     [,1] [,2] [,3]
[1,]    1    5    9
[2,]    2    6   NA
[3,]    3    7   NA
[4,]    4    8   NA
> makemat(nsquareeven)
     [,1] [,2] [,3] [,4]
[1,]    1    5    9   13
[2,]    2    6   10   14
[3,]    3    7   11   15
[4,]    4    8   12   16