Question

我正在为poisson glms中常用的指数函数设置替代响应函数，该函数称为softplus，并定义为$ \ frac {1} {c} \ log（1+ \ exp（c \ eta））$，其中$ \ eta $对应于线性预测变量$ X \ beta $

我已经通过将参数$ c $设置为任意固定值并仅搜索$ \ hat {\ beta} $来管理优化。

现在，下一步，我还必须优化此参数$ c $（在更新的$ \ beta $和当前的$ c $之间进行迭代更改）。

我尝试编写对数函数，得分函数，然后设置牛顿拉夫森优化（使用while循环）但是我不知道如何在外部将c的更新与在内部的\ beta分开。.

有什么建议吗？

# Response function:
sp <- function(eta, c = 1 ) {  
  return(log(1 + exp(abs(c * eta)))/ c) 
} 

# Log Likelihood
l.lpois <- function(par, y, X){
  beta <- par[1:(length(par)-1)]
  c <- par[length(par)]
  l <- rep(NA, times = length(y))
  for (i in 1:length(l)){
    l[i] <- y[i] * log(sp(X[i,]%*%beta, c)) - sp(X[i,]%*%beta, c) 
  }
  l <- sum(l)
  return(l)
}

# Score function
score <- function(y, X, par){
  beta <- par[1:(length(par)-1)]
  c <- par[length(par)]

  s <- matrix(rep(NA, times = length(y)*length(par)), ncol = length(y))
  for (i in 1:length(y)){
    s[,i] <- c(X[i,], 1) * (y[i] * plogis(c * X[i,]%*%beta) / sp(X[i,]%*%beta, c) -     plogis(c * X[i,]%*%beta))
  }
  score <- rep(NA, times = nrow(s))
  for (j in 1:length(score)){
    score[j] <- sum(s[j,])
  }
  return(score)
}

# Optimization function
opt <- function(y, X, b.start, eps=0.0001, maxiter = 1e5){
  beta <- b.start[1:(length(b.start)-1)]
  c <- b.start[length(b.start)]

  b.old <- b.start
  i <- 0
  conv <- FALSE

  while(conv == FALSE){ 

    eta <- X%*%b.old[1:(length(b.old)-1)]
    s <- score(y, X, b.old)
    h <- numDeriv::hessian(l.lpois,b.old,y=y,X=X)

    invh <- solve(h)

    # update 
    b.new <- b.old + invh %*% s                                                         

    i <- i + 1

    # Test 
    if(any(is.nan(b.new))){                                                             
      b.new <- b.old                                                                
      warning("convergence failed")
      break 
    } 

    # convergence reached?
    if(sqrt(sum((b.new - b.old)^2))/sqrt(sum(b.old^2)) < eps | i >= maxiter){ 
      conv <- TRUE
    }
    b.old <- b.new
  }
  eta <- X%*%b.new[1:(length(b.new)-1)]

  # covariance
  invh  <- solve(numDeriv::hessian(l.lpois,b.new,y=y,X=X)) 


  fitted <- sp(eta, b.new[length(b.new)])

  result <- list("coefficients" = c(beta = b.new),
                 "fitted.values" = fitted,
                 "covariance" = invh)
}

# Running fails ..
n <- 100
x <- runif(n, 0, 1)
Xdes <- cbind(1, x) 
eta <- 1 + 2 * x
y <- rpois(n, sp(eta, c = 1))



opt(y,Xdes,c(0,1,1))

Answer 1

您有2个错误：

第25行：

(y[i] * plogis(c * X[i,]%*%beta) / sp(X[i,]%*%beta, c) - plogis(c * X[i,]%*%beta))

这将返回matrix，因此您必须转换为numeric：

as.numeric(y[i] * plogis(c * X[i,]%*%beta) / sp(X[i,]%*%beta, c) - plogis(c * X[i,]%*%beta))

第23行： )丢失：

您有：

s <- matrix(rep(NA, times = length(y)*length(par), ncol = length(y))

应为：

s <- matrix(rep(NA, times = length(y)*length(par)), ncol = length(y))

替代性glm系列的迭代优化

1 个答案: