使用自定义函数有条件地折叠矩阵行

时间:2016-08-17 07:46:55

标签: r matrix

我想要折叠矩阵中的行,以便特定列的值不会低于20.我想将自定义函数应用于行以折叠/求和...

以下是一个示例矩阵:

k=2

看起来像这样:

d <- matrix(data = c(0,105,1,21,2,11,4,5,5,15,7,21,9,1), 
   ncol = 2, 
   byrow = TRUE
)

colnames(d) <- c('val','freq')

单元格必须为20或以上的列是&#34; freq&#34;。因此第1行和第2行都很好,但我需要折叠第3行:5行。我想用这个函数中的单行替换第3行:5行:

d
     val freq
[1,]   0  105
[2,]   1   21
[3,]   2   11
[4,]   4    5
[5,]   5   15
[6,]   7   21
[7,]   9    1

函数调用:

library(reshape)

replacement <- function(x){

  mat <- d[x, ]
  mat.res <- untable(mat[ ,c(1, 2)], 
    num = mat[ ,2]
  )

  res <- c(mean(mat.res[ ,1]), length(mat.res[ ,1]))
  return(res)
}

完成矩阵;第6行很好,但由于第7行将留有replacement(3:5) [1] 3.774194 31.000000 ,因此需要使用第6行折叠该行。再次调用函数:

freq=1

结果矩阵应为:

replacement(6:7)
[1]  7.090909 22.000000

最后一行编号并不重要。

我感觉 val freq [1,] 0 105 [2,] 1 21 [3,] 3.774194 31.000000 [4,] 7.090909 22.000000 的窗口函数可能会解决问题,但我需要帮助了解具体方法。它不一定是dplyr。我接受任何工作; - )

1 个答案:

答案 0 :(得分:1)

为了将来参考,这不是很优雅,但它有效...

rows <- dim(d)[1]
tmp <- NULL
inc <- 1
tmpSum <- 0

for(i in 1:rows){

    if(d[i, 2] > 19){
      tmp <- rbind(tmp, c(d[i, ], inc))
      inc <- inc + 1
      tmpSum <- 0

  } else {
    tmp <- rbind(tmp, c(d[i, ], inc))
    tmpSum <- d[i,2] + tmpSum 

    if(tmpSum > 19){
      inc <- inc + 1
    }
  }
}

if(sum(tmp[tmp[ ,3] == max(tmp[ ,3]), 2]) < 19){
  tmp[tmp[ ,3] == max(tmp[ ,3]), 3] <- tmp[tmp[ ,3] == max(tmp[ ,3]), 3]-1 
}

res <- NULL

for(i in 1:max(tmp[ ,3])){
  val <- mean(rep(tmp[tmp[ ,3] == i, 1], tmp[tmp[ ,3] == i, 2]))
  freq <- length(rep(tmp[tmp[ ,3] == i, 1], tmp[tmp[ ,3] == i, 2]))
  res <- rbind(res, c(val, freq))
}

res