Векторизация этой функции в R

Question

Привет, поэтому у меня есть следующая функция:

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 также является тем же скалярным значением 0,2, используемым в kde.cv. x - вектор оценочных точек для функции, я использовал seq (-2,5, -0,5, = 0,1).

Answer 1

Для удобства приведите более полный пример. Например, функция 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

и второй пример

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

Answer 2

Вот вариант с использованием sapply

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