基于Mathematica UUPDE database中给出的公式 我在R中绘制了标准正态分布的危险函数。
在某些范围内似乎是正确的;对于较大的值,会出现数值问题,请参见附图。以下是完整的R代码。
任何评论都会非常感激。
PDF = function(x) { 1/(sqrt(2*pi))*exp(-x^2/2) }
erf <- function(x) 2 * pnorm(x * sqrt(2)) - 1
erfc <- function(x) 2 * pnorm(x * sqrt(2), lower = FALSE)
CDF = function(x) { 1/2 * (1 + erf(x/(sqrt(2)))) }
HF = function(x) { sqrt(2/pi)/(exp(x^2/2)*(2-erfc(-x/sqrt(2)))) }
SF = function(x) { 1 - 1/2 *erfc(-x/sqrt(2)) }
par(mar=c(3,3,1.5,0.5), oma=c(0,0,0,0), mgp=c(2,1,0))
par(mfrow = c(2, 2))
x = seq(from = -4,to = 10,by = .001)
##### PDF
a = PDF(x)
plot(x,a,'l',main='',ylab="PDF",xlab="x")
grid(nx = NULL,ny = NULL,col = "grey",lty = "dotted",lwd = par("lwd"),equilogs = TRUE)
##### CDF
a = CDF(x)
plot(x,a,'l',main='',ylab="CDF",xlab="x")
grid(nx = NULL,ny = NULL,col = "grey",lty = "dotted",lwd = par("lwd"),equilogs = TRUE)
##### HF
a = HF(x)
plot(x,a,'l',main='',ylab="HF",xlab="x")
grid(nx = NULL,ny = NULL,col = "grey",lty = "dotted",lwd = par("lwd"),equilogs = TRUE)
##### SF
a = SF(x)
plot(x,a,'l',main='',ylab="SF",xlab="x")
grid(nx = NULL,ny = NULL,col = "grey",lty = "dotted",lwd = par("lwd"),equilogs = TRUE)
答案 0 :(得分:10)
危险函数是密度函数除以幸存函数。您的代码的问题在于您将此定义用于面值并执行简单的除法运算;当分子和分母都是非常小的值(大约1e-300),这发生在分布的尾部时,该操作变得在数值上不稳定。对于这类问题,更合适的解决方案是计算分子和分母的对数(它们是中等大小的负数而不是微小的数字),从对数中减去对数分母 - 分子,然后取幂。
R提供了完成此计算所需的所有部分。你可以通过pnorm(x,lower=FALSE)
获得幸存者的功能;您可以分别使用log=TRUE
和log.p=TRUE
中的dnorm()
和pnorm()
来获取日志范围内的密度和幸存函数。所以:
HF <- function(x) {
exp(dnorm(x,log=TRUE)-pnorm(x,lower=FALSE,log.p=TRUE))
}
curve(HF,from=-4,to=10)
如果可以使用对数密度和对数幸存函数,则可以推广此策略以计算任何分布的危险函数(通常用于分布foo
R提供密度函数dfoo
和CDF可以在上面替换的pfoo
。