Question

我编写了一个本地函数，它似乎在某些重复项中运行良好，但在其他一些重复项中出现错误消息。我很沮丧地想出来，所以我会在这里发帖以获得一些帮助。

#function
impmatch<-function(data, margprob, commonprob, rep, seed=NULL){

  if (!is.null(seed)){set.seed(seed)}

  data<-as.matrix(data)
  n<-nrow(data)
  m<-ncol(data)
  cdata<-data[complete.cases(data), ]

  impi<-function(){
    sdata<-rmvbin(n, margprob=margprob, commonprob=commonprob)
    datai<-matrix(NA, ncol=m, nrow=n)
    for (i in 1:n){
            nna<-sum(is.na(data[i, ]))
            if(nna==0){
              datai[i, ]<-data[i, ]
            } else if(nna==m){
              datai[i, ]<-cdata[sample(nrow(cdata), 1), ]
            } else{
              a<-data[i, ]
              a[is.na(a)]<-"."
              srow<-grepl(paste(a, collapse="-"), apply(sdata, 1, paste, collapse="-"))
              mdata<-sdata[srow,]
              datai[i, ]<-mdata[sample(nrow(mdata), 1), ]
            }
    }
  outi<-apply(datai, 1, sum)
  outi<-ifelse(outi>=1, 1, 0)
  return(outi)
  }
  out<-replicate(rep, impi())
  return(out)
}

#package & foo data
require(bindata)
margprob<-c(0.1, 0.4, 0.3)
cp<-c(0.015, 0.005, 0.003, 0.005, 0.3, 0.07, 0.003, 0.07, 0.1)
commonprob<-matrix(cp, 3,3) 
data<-data.frame(y1=rbinom(100,1,0.2),
                 y2=rbinom(100,1,0.4),
                 y3=rbinom(100,1,0.3))
data$y1[sample(1:100, 10)]<-NA
data$y2[sample(1:100, 20)]<-NA
data$y3[sample(1:100, 15)]<-NA

#test function
#without error
test<-impmatch(data, margprob, commonprob, rep=2, seed=123) 
#with error
test<-impmatch(data, margprob, commonprob, rep=10, seed=123)
Error in sample.int(length(x), size, replace, prob) : 
  invalid first argument

我敢打赌错误来自sample函数，但我不知道是什么导致它以及如何解决它。

Answer 1

嗨，看起来代码本身还可以，但R每次都找不到解决方案！当我用test<-impmatch(data, margprob, commonprob, rep=5, seed=123)运行它时，它有时会产生同样的错误，有时它的工作正常。 test<-impmatch(data, margprob, commonprob, rep=10, seed=123)也是如此。

作为一种解决方法，您可以在代码中使用try函数。这将重复该过程，直到找到工作解决方案。我在下面的函数中添加了它。希望这有帮助！

impmatch<-function(data, margprob, commonprob, rep, seed=NULL){

  if (!is.null(seed)){set.seed(seed)}

  data<-as.matrix(data)
  n<-nrow(data)
  m<-ncol(data)
  cdata<-data[complete.cases(data), ]

  impi<-function(){
    sdata<-rmvbin(n, margprob=margprob, commonprob=commonprob)
    datai<-matrix(NA, ncol=m, nrow=n)
    for (i in 1:n){
      nna<-sum(is.na(data[i, ]))
      if(nna==0){
        datai[i, ]<-data[i, ]
      } else if(nna==m){
        datai[i, ]<-cdata[sample(nrow(cdata), 1), ]
      } else{
        a<-data[i, ]
        a[is.na(a)]<-"."
        srow<-grepl(paste(a, collapse="-"), apply(sdata, 1, paste, collapse="-"))
        mdata<-sdata[srow,]
        datai[i, ]<-mdata[sample(nrow(mdata), 1), ]
      }
    }
    outi<-apply(datai, 1, sum)
    outi<-ifelse(outi>=1, 1, 0)
    return(outi)
  }
# editted code starts here.
  cll <- 0
  while(cll==0){

    out<-try(replicate(rep, impi()),silent=T)

    if(class(out)=="matrix"){

      cll=1

    }

  }

  return(out)
}

Answer 2

我终于明白了。 sum(srow)==1导致nrow(mdata)==NULL时出错。我修改了这个功能，现在工作正常。

impmatch<-function(data, margprob, commonprob, rep, seed=NULL){

  if (!is.null(seed)){set.seed(seed)}

  data<-as.matrix(data)
  n<-nrow(data)
  m<-ncol(data)
  cdata<-data[complete.cases(data), ]

  impi<-function(){
    sdata<-rmvbin(n, margprob=margprob, commonprob=commonprob)
    datai<-matrix(NA, ncol=m, nrow=n)
    for (i in 1:n){
            nna<-sum(is.na(data[i, ]))
            if(nna==0){
              datai[i, ]<-data[i, ]
            } else if(nna==m){
              datai[i, ]<-cdata[sample(nrow(cdata), 1), ]
            } else{
              a<-data[i, ]
              a[is.na(a)]<-"."
              srow<-grepl(paste(a, collapse="-"), apply(sdata, 1, paste, collapse="-"))
              #edited
              if(sum(srow)<=1){
                datai[i, ]<-cdata[sample(nrow(cdata), 1), ]
              } else{
                mdata<-sdata[srow,]
                datai[i, ]<-mdata[sample(nrow(mdata), 1), ]
              }
            }
    }
  outi<-apply(datai, 1, sum)
  outi<-ifelse(outi>=1, 1, 0)
  return(outi)
  }
  out<-replicate(rep, impi())
  return(out)
}

复制R函数时出错

2 个答案: