Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/74.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
在R中矢量化此函数_R - Fatal编程技术网

在R中矢量化此函数

在R中矢量化此函数,r,R,嗨,我有以下功能: kde.cv = function(X,s) { l = length(X) log.fhat.vector = c() for (i in 1:l) { current.log.fhat = log ( kde(X[i],X[-i],s) ) log.fhat.vector[i] = current.log.fhat } CV.score = sum(log.fhat.vector) return(CV.score) }

嗨,我有以下功能:

kde.cv = function(X,s)    {
  l = length(X)

  log.fhat.vector = c()
  for (i in 1:l) {
    current.log.fhat = log ( kde(X[i],X[-i],s) )
    log.fhat.vector[i] = current.log.fhat
  }

  CV.score = sum(log.fhat.vector)

  return(CV.score)
}
我想在不使用任何for循环或apply语句的情况下将其矢量化,但似乎无法回避这样做。我们将不胜感激。谢谢

编辑:根据回答,以下是我对提出的问题的回答

如果需要澄清,我将详细说明函数输入和给定函数中的用户定义函数。这里的X是一个向量形式的数据集,具体来说,是数据集中长度为7的向量,我用它作为这个函数的输入。我用这个函数计算的X是c(-1.1653,-0.7538,-1.3218,-2.3394,-1.9766,-1.8718,-1.5041)。s是使用此函数时设置为0.2的单个标量点。kde是我编写的一个用户定义函数。以下是实施方案:

kde = function(x,X,s){
  l = length(x)   
  b = matrix(X,l,length(X),byrow = TRUE)
  c = x - b 
  phi.matrix = dnorm(c,0,s)
  d = rowMeans(phi.matrix)

  return(d)
}

在该函数中,X与kde.cv中使用的数据点向量相同。s也是kde.cv中使用的0.2的相同标量值。x是函数的评估点向量,我使用了seq(-2.5,-0.5,by=0.1)。

这里有一个使用
sapply的选项

kde.cv = function(X,s) 
    sum(sapply(1:length(X), function(i) log(kde(X[i], X[-i], s))))

为方便起见,请提供一个更完整的示例。例如,
kde()
函数。这是定制功能吗

除了
sapply
,您还可以尝试
Vectorize()
。这里有一些关于堆栈溢出的例子

这里有一个例子

f1 <- function(x,y) return(x+y) 
f2 <- Vectorize(f1) 

f1(1:3, 2:4) 
[1] 3 5 7
f2(1:3, 2:4) 
[1] 3 5 7
编辑2

嗯,我想下面的功能可能符合你的要求。顺便说一句,由于您的
kde.cv
中没有使用小的
x
,所以我只编辑了这两个函数

kde.cv.2 <- function(X,s)    
{
 log.fhat.vector<-log(kde.2(X, s))
 CV.score = sum(log.fhat.vector)
 return(CV.score)
}

kde.2<-function(X, s)
{
 l <- length(X)  
 b <- matrix(rep(X, l), l, l, byrow = T)
 c <- X - b
 diag(c) <- NA
 phi.matrix <- dnorm(c, 0, s)
 d <- rowMeans(phi.matrix, na.rm = T)
 return(d)
}

X<-c(-1.1653, -0.7538, -1.3218, -2.3394, -1.9766, -1.8718, -1.5041)
s<-0.2 

kde.cv(X,s)
[1] -10.18278

kde.cv.2(X, s)
[1] -10.18278

kde.cv.2请提供一个可复制的更完整的示例。包括X和s的值,以便我们可以使用它来测试您的函数。另外,关于你试图实现的目标的文档将有助于社区。@Juan Zamora我编辑了我的原始帖子,以提供更多细节。就我用这段代码所做的来说:kde是一个函数,通过一个标准核,在一个数据集上拟合一个非参数密度,该数据集由X给出,使用一个评估点X和带宽s的向量。kde.cv是一个进行交叉验证以选择最佳带宽s的函数。OP请求“我想在不使用任何for循环或apply语句的情况下对此进行矢量化”@symbolXau,而无需更多信息(特别是关于
kde
的功能),很难优化代码。我的答案应该比原始代码更快,在原始代码中,
log.fhat.vector
在每个步骤中动态扩展;另一个答案也使用了apply方法(
mapply
Vectorize
)。Yes Kde()是我编写的一个用户定义函数。我编辑了我的原始帖子以提供更多细节。@JaimeMelaraSosa因此,在
kde.cv
函数中,您输入的
kde
的第一个参数是
X[I]
,它是一个单一值,而
kde
的第一个参数应该是向量。@JaimeMelaraSosa我假设
kde.cv
可能符合您的要求。谢谢您的回复。我知道X[I]是一个单一的值,但单一的值不就是一个长度为1的向量吗?我不认为这太重要,因为函数给出了正确的答案。关于您使用vectorize()重写的kde.cv函数,我不确定这是否是我想要的。当我说“向量化”函数时,我的意思是只使用向量/矩阵运算编写它,而不使用循环或apply语句。我对vectorize()不太熟悉,但它与apply()不同,因为它也是使用循环预先编写的?@JaimeMelaraSosa在我看来只是有点奇怪。顺便说一句,不使用小的
x
,而
kde
函数只能使用两个参数。
kde.cv = function(X,s)    {
 l = length(X)

 log.fhat.vector = c()
 for (i in 1:l) {
  current.log.fhat = log ( kde(X[i],X[-i],s) )
  log.fhat.vector[i] = current.log.fhat
 }

 CV.score = sum(log.fhat.vector)

 return(CV.score)
}

kde = function(x,X,s){
 l = length(x)   
 b = matrix(X,l,length(X),byrow = TRUE)
 c = x - b 
 phi.matrix = dnorm(c,0,s)
 d = rowMeans(phi.matrix)

 return(d)
}


##### Vectorize kde.cv ######

kde.cv.v = function(X,s)   
{
 log.fhat.vector = c()

 kde.v<-Vectorize(function(i) kde(X[i], X[-i], s))

 CV.score <- sum(log(kde.v(1:length(X))))

 return(CV.score)
}

X<-c(-1.1653, -0.7538, -1.3218, -2.3394, -1.9766, -1.8718, -1.5041)
s<-0.2
x<-seq(-2.5, -0.5, by = 0.1)

kde.cv(X, s)
[1] -10.18278

kde.cv.v(X, s)
[1] -10.18278
kde.cv.2 <- function(X,s)    
{
 log.fhat.vector<-log(kde.2(X, s))
 CV.score = sum(log.fhat.vector)
 return(CV.score)
}

kde.2<-function(X, s)
{
 l <- length(X)  
 b <- matrix(rep(X, l), l, l, byrow = T)
 c <- X - b
 diag(c) <- NA
 phi.matrix <- dnorm(c, 0, s)
 d <- rowMeans(phi.matrix, na.rm = T)
 return(d)
}

X<-c(-1.1653, -0.7538, -1.3218, -2.3394, -1.9766, -1.8718, -1.5041)
s<-0.2 

kde.cv(X,s)
[1] -10.18278

kde.cv.2(X, s)
[1] -10.18278