使用数据帧的列参数计算R函数

Question

我有以下代码。

completemodel <- function(model, colnum) 
{ 
    modlst = c() 
    tuplenum = length(model) 
    if(tuplenum != 0) 
    for(i in 1:tuplenum) 
     modlst = c(modlst, model[[i]]) 
    index = seq(0, colnum-1) 
    inddiff = setdiff(index, modlst) 
    inddifflen = length(inddiff) 
    for(i in seq(length.out=inddifflen)) 
    model = append(model, inddiff[i]) 
    return(model) 
} 

## Calculate number of parameters in model. 
numparam <- function(mod, colnum) 
    { 
    library(RJSONIO) 
    mod = fromJSON(mod) 
    mod = completemodel(mod, colnum) 
    totnum = 0 
    for(tup in mod) 
     totnum = totnum +(4**length(tup)) 
    return(totnum) 
    } 

x = cbind.data.frame(rownum=c(100, 100), colnum=c(10, 20), modeltrue=c("[]", "[]"), modelresult=c("[[1,2]]","[[1,3]]"), stringsAsFactors=FALSE) 

> x 
    rows colnum modeltrue modelresult 
1 100  10  []  [[1,2]] 
2 100  20  []  [[1,3]] 

如何操作x为我提供一个如下所示的数据框？这里当然是 我的意思是， numparam("[]", 10)当我写numparam("[]", 10)。

rownum colnum numparam_modeltrue numparam_modelresult 
    100  10  numparam("[]", 10) numparam("[[1,2]]", 10) 
    100  20  numparam("[]", 20) numparam("[[1,3]]", 20) 

某些版本的apply函数可能有效，但我在找到正确的表达式时遇到了问题。

更新：看来，如果rownnum,colnum元组不是唯一的，那么可以执行以下操作。

x = cbind.data.frame(id=c(1, 2, 3), rownum=c(100, 100, 100), colnum=c(10, 20, 20), modeltrue=c("[]", "[]", "[]"), 
    modelresult=c("[[1,2]]","[[1,3]]","[[1,3, 4]]"), stringsAsFactors = FALSE) 

##Then, create a data.table and set the key 

library(data.table) 
xDT <- as.data.table(x) 
setkeyv(xDT, c("id", "rownum", "colnum") 

这是正确的方法吗？

Answer 1

替代方法使用sapply：使用vapply

numparamvec <- function(rownum, colnum, modeltrue, modelresult) 
    { 
    totnum1 = numparam(modeltrue, as.integer(colnum)) 
    totnum2 = numparam(modelresult, as.integer(colnum)) 
    return(c(rownum = rownum, colnum = colnum, 
     numparam_modeltrue = totnum1, numparam_modelresult = totnum2)) 
    } 

val <- sapply(seq_len(nrow(x)), 
    function(y) do.call(numparamvec, x[y, ])) 

> as.data.frame(t(val)) 
    rownum colnum numparam_modeltrue numparam_modelresult 
1 100  10     40     48 
2 100  20     80     88 

替代做法：

val <- t(vapply(seq_len(nrow(x)), function(y) do.call(numparamvec, x[y, ]), 
    c(rownum = 0, colnum = 0, numparam_modeltrue = 0, numparam_modelresult = 0))) 

> val 
     rownum colnum numparam_modeltrue numparam_modelresult 
[1,]    100     10                 40                   48 
[2,]    100     20                 80                   88 

Answer 2

如果您愿意，可以使用data.table软件包。

首先，创建一个data.table，添加一个唯一的标识符列id，并设置为关键

library(data.table) 
xDT <- as.data.table(x) 
xDT[, id := seq_len(nrow(xDT))] 
setkey(xDT, "id") 

然后，使用do.call，你可以在适当的列运行numparam功能：

res1 <- xDT[, list(numparam_modeltrue = do.call(numparam, unname(.SD))), 
    .SDcols = c(3, 2), by = key(xDT)] 
res2 <- xDT[, list(numparam_modelresult = do.call(numparam, unname(.SD))), 
    .SDcols = c(4, 2), by = key(xDT)] 

然后将结果合并为一个data.table

xDT[res1][res2][, c("modeltrue", "modelresult") := NULL, with = FALSE] 
    id rownum colnum numparam_modeltrue numparam_modelresult 
1: 1 100  10     40     48 
2: 2 100  20     80     88 

---

编辑：

马修Dowle建议，您可以通过以下末达到无mrege相同的结果：

xDT[,numparam_modeltrue := do.call(numparam, unname(.SD)), 
    .SDcols = c(3, 2), by = key(xDT)] 
xDT[,numparam_modelresult := do.call(numparam, unname(.SD)), 
    .SDcols = c(4, 2), by = key(xDT)] 

如果你想摆脱列modeltrue和modelresult，

xDT[,c("modeltrue", "modelresult") := NULL, with = FALSE] 
# NOTE that with = FALSE shouldn't be necessary with data.table 1.8.3 
# But I'm still with 1.8.2 

Answer 3

以下共同各种作品。虽然这不是很漂亮。欢迎提出改进建议。特别是， 这将是很好的，不必转置矩阵和添加列名称，而且，因为它返回一个矩阵，仍然存在这样的恼人的问题，其中整数转换为字符串。感谢flodel 的提示关于his answer to "Pass arguments to a function from each row of a matrix"。

completemodel <- function(model, colnum) 
{ 
    modlst = c() 
    tuplenum = length(model) 
    if(tuplenum != 0) 
    for(i in 1:tuplenum) 
     modlst = c(modlst, model[[i]]) 
    index = seq(0, colnum-1) 
    inddiff = setdiff(index, modlst) 
    inddifflen = length(inddiff) 
    for(i in seq(length.out=inddifflen)) 
    model = append(model, inddiff[i]) 
    return(model) 
} 

## Calculate number of parameters in model. 
numparam <- function(mod, colnum) 
    { 
    library(RJSONIO) 
    mod = fromJSON(mod) 
    print(paste("mod", mod)) 
    mod = completemodel(mod, colnum) 
    totnum = 0 
    for(tup in mod) 
     totnum = totnum +(4**length(tup)) 
    return(totnum) 
    } 

numparamvec <- function(rownum, colnum, modeltrue, modelresult) 
    { 
    totnum1 = numparam(modeltrue, as.integer(colnum)) 
    totnum2 = numparam(modelresult, as.integer(colnum)) 
    return(c(rownum, colnum, totnum1, totnum2)) 
    } 

x = cbind.data.frame(rownum=c(100, 100), colnum=c(10, 20), modeltrue=c("[]", "[]"), modelresult=c("[[1,2]]","[[1,3]]"), stringsAsFactors=FALSE) 
val = t(apply(x, 1, function(x)do.call(numparamvec, as.list(x)))) 
colnames(val) = c("rownum", "colnum", "numparam_modeltrue", "numparam_modelresult")