在R中向量化此函数

时间:2018-05-15 02:30:38

标签: 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)
}

我想在不使用任何for循环或应用语句的情况下对其进行矢量化,似乎无法绕过这样做。帮助将不胜感激。谢谢。

编辑:鉴于回复,以下是我对提出的问题的回答。

鉴于要求澄清,我将详细说明函数输入和给定函数内的用户定义函数。因此,这里的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)。

2 个答案:

答案 0 :(得分:0)

以下是使用sapply

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

答案 1 :(得分:0)

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

sapply的替代方案,您可以尝试Vectorize()。您可以在堆栈溢出时找到一些示例。

Vectorize() vs apply()

这是一个例子

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

和第二个例子

f1 <- function(x) 
{
 new.vector<-c()  
 for (i in 1:length(x)) 
 {
  new.vector[i]<-sum(x[i] + x[-i])
 }
 return(sum(new.vector))
}

f2<-function(x)
{
 f3<-function(y, i)
 {
  u<-sum(y[i]+y[-i])
  return(u)
 }
 f3.v<-Vectorize(function(i) f3(y = x, i=i))
 new.value<-f3.v(1:length(x))
 return(sum(new.value))
}

f1(1:3) 
[1] 24

f2(1:3) 
[1] 24

注意:Vectorize是mapply

的包装器

编辑1

根据回复,我编辑了您的kde.cv功能。

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

编辑2

嗯,我认为以下功能可能符合您的要求。顺便说一句,因为你的x中没有使用kde.cv,我只编辑了两个函数

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