Adjust function for log(0)

问题

I wrote a function for a poisson regression. The data set discoveris have some count data where 5 entries are y = 0. I want compute the deviance residuals, acroding to the formula in my function :

devianceResiduals <- sign(y - fittedValuesFullModell) * sqrt(2 * y *
                           log(y / fittedValuesFullModell) - 2 *
                            (y - fittedValuesFullModell))

My problem ist that i get NaN because log(y = 0) = -inf. So tried to write a loop that use 2 different forumals to compute the deviance residuals. If y = 0 the formula simplifies to - 2 * (y - fittedValuesFullModell)) because of log rules. If y > 0 i want use my regular formula. How can i adjust my function that i dont get the NaN in the computation of the devianceResiduals? ( Sry for the german comments)

data(discoveries)
disc <- data.frame(count=as.numeric(discoveries),
                   year=seq(0,(length(discoveries)-1),1))

yearSqr <- disc$year^2


poisMod<-function(formula, data){

  # Definiere Regressionsformel
  form <- formula(formula)

  # DataFrame wird erzeugt
  model <- model.frame(formula, data = data)

  #  Designmatrix wird erzeugt
  x <- model.matrix(formula, data = data)

  # Response Variable erzeugt
  y <- model.response(model)

  # Designmatrix f?r "Nullmodell-Sch?tzung" (nur Intercept wird gesch?tzt)
  # wird erzeugt
  xNull <- as.matrix(x[, 1])

  # Parameteranzahl die es zu sch?tzen gilt im "Nullmodell"
  # (nur Intercept gesch?tzt)
  parNullModell <- rep(0, 1)

  # Parameteranzahl die es zu sch?tzen gilt im im "Fullmodell" (Fullmodell
  # hei?t, dass Koeffizienten f?r jede erkl?rende Variable aus der Formula
  # gesch?tzt werden)
  parFullModell <- rep(0, ncol(x))

  # Funktionaufruf wird gespeichert
  call <- match.call()

  # Maximierung der Loglikelihood durch Sch?tzung der Koeffzienten, Hessematrix
  # soll ebenfalls mit angegeben werden
  optimierung <- optim(par =  parFullModell, fn = logLike,
                       x = x, y = y, hessian = TRUE)
  # Hessematix aus Optimierung
  hesseMatrix <- optimierung$hessian

  # Koeffizienten aus der Sch?tzung des "Fullmodells"
  koefFullModell <- round(optimierung$par, 4)

  # Koeffizienten aus der Sch?tzung des "Nullmodells"
  koefNullModell <- round(optim(par = parNullModell, fn = logLike,x = xNull,
                                y = y, method = "Brent", lower = -1000 ,
                                upper = 1000)$par, 4)

  # Bennenung der Koeffizienten entsprechend ihrer erkl?renden Variablen
  names(koefFullModell) <- colnames(x)

  # Loglikelihood des "FUllmodells" bestimmt
  logLikeFullModell <- logLike(y, x, koefFullModell)

  # Loglikelihood des "NullModells"
  logLikeNullModell <- logLike(y, xNull, koefNullModell)

  # AIC Kriterium f?r das "FullModell"
  aic <- round(2 * (logLikeFullModell) + 2 * length(koefFullModell), 1)

  # Degrees of freedom vom "Fullmodell"
  dofFullModell <- nrow(x) - ncol(x)

  #Degrees of freedom vom "Nullmodell"
  dofNullModell<- nrow(xNull) - ncol(xNull)

  # Fitted values des "Nullmodells"
  fittedValuesNullModell <- exp(xNull %*% koefNullModell)

  # Fitted values des "Fullmodells"
  fittedValuesFullModell <- exp(x %*% koefFullModell)

  # Residual deviance bestimmt
  residualDeviance <- round(2 * sum(y * log(y / fittedValuesFullModell) -
                           (y - fittedValuesFullModell),na.rm = TRUE), 1)

  # Null deviance bestimmt
  nullDeviance <- round(2 * sum(y * log(y / fittedValuesNullModell) -
                       (y - fittedValuesNullModell),na.rm = TRUE), 1)

  # Deviance residuals bestimmt
  devianceResiduals <- sign(y - fittedValuesFullModell) * sqrt(2 * y *
                           log(y / fittedValuesFullModell) - 2 *
                            (y - fittedValuesFullModell))

  # y und fitted values des "Fullmodells" in dataframe gepackt, damit ggplo2
  # sp?ter darauf angwendet werden kann, da ggplot2 nicht auf diese Klasse
  # poisMod angewendet werden kann
  ggPlotData <- data.frame(obs = y, fitted = fittedValuesFullModell)

  # Liste mit allen Kennzahlen
  result <- list("coefficients" = koefFullModell,
                 "call" = call,
                 "aic" = aic,
                 "dofNullModell" = dofNullModell,
                 "dofFullModell" = dofFullModell,
                 "x" = x,
                 "y" = y,
                 "fittedValuesNullModell" = fittedValuesNullModell,
                 "fittedValuesFullModell" = fittedValuesFullModell,
                 "residualDeviance" = residualDeviance,
                 "nullDeviance" = nullDeviance,
                 "hesseMatrix" = hesseMatrix,
                 "optimierung" = optimierung,
                 "devianceResiduals" = devianceResiduals,
                 "ggPlotData" = ggPlotData,
                 "model" = model)

  # poisMod Klasse erzeugt
  class(result) <- "poisMod"

  # Result liste ausgegeben
  return(result)
}


p2 <- poisMod(count~year+yearSqr,data=disc)

回答1:

This is not a solution, just a comment . Fundamentally log(0) = Inf . So you can define how big/small infinity you want . so as for example you can replace 0 by 0.000000001 or more less value , which is close to zero. As for example log(1E-99) = -227.9559

来源：https://stackoverflow.com/questions/49095725/adjust-function-for-log0

标签

loops

regression

poisson