R_Language 板


LINE

[关键字]: R, differentiation, calculas, algebraic computation [出处]: http://rpubs.com/wush978/differentiation [重点摘要]: ps. 好读版请参考上面的link。 最近笔者有计算一个函数的Gradient和Hessian的需求,所以研究了一下R 中 进行这类计算的功能和套件。 以下我会介绍R 中进行数值微分和代数微分的功能。 # numDeriv 我第一个介绍的是数值微分套件:`numDeriv`。他的用法很简单: ## `grad` `grad`函数可以拿来计算函数在指定点的gradient: ```{r} library(numDeriv) f <- function(x) x^2 grad(f, 2) ``` `grad`也可以计算向量函数的gradient: ```{r} f <- function(x) x[1] * x[2] grad(f, c(1,2)) ``` ## hessian `hessian`可以计算函数在指定点的hessian ```{r} hessian(f, 1:2) ``` 由於是数值解的关系,所以可以看到二阶微分会算出很小的值。 # `deriv` 接下来我要介绍一个做代数微分的功能。 首先我们把刚刚的`f <- function(x) x^2`写成expression: ```{r} f <- function(x) x^2 f.exp <- expression(x^2) ``` 接着使用内建的`deriv`: ```{r} deriv(f.exp, namevec="x") ``` R 就会回传出计算gradient的方式。将它复制贴上建立函数,并且修改内容 让它是vectorized: ```{r} g <- function(x) { .value <- x^2 .grad <- 2 * x .grad } ``` 和`numDeriv`的结果做个比较: ```{r} all.equal(g(2), grad(f, 2)) ``` `deriv`的另一个参数`hessian`设为`TRUE`的时候,回传值会附加hessian的 算式。 # 范例 根据`r citet(bib["bowling2009logistic"])`,以下函数是standard normal cdf的logistic approximation: $$F(x) = \frac{1}{1+e^{-0.07056 x^3 - 1.5976 x}}$$ ```{r} F.0 <- function(x) 1/(1 + exp(-0.07056 * x^3 - 1.5976 * x)) curve(pnorm, -3, 3, lty = 1) curve(F.0, add = TRUE, col = 2, lty = 2) ``` 肉眼根本分不出来差异! 如果我们用它来取代某些Likelihood中的standard normal cdf(当资料有 censoring的时候),在计算MLE的时候就会需要计算$F'(x)$和$F''(x)$。他 们分别是: - $$F'(x) = -{{\left(-0.21168\,x^2-1.5976\right)\,e^{-0.07056\,x^3-1.5976\,x} }\over{\left(e^{-0.07056\,x^3-1.5976\,x}+1\right)^2}}$$ - $$F''(x) = -{{\left(-0.21168\,x^2-1.5976\right)^2\,e^{-0.07056\,x^3-1.5976\,x } }\over{\left(e^{-0.07056\,x^3-1.5976\,x}+1\right)^2}} + \frac{0.42336\,x\, e^{-0.07056\,x^3-1.5976\,x}}{\left(e^{-0.07056\,x^3-1.5976\,x} + 1\right)^2} + {{2\,\left(-0.21168\,x^2-1.5976\right)^2\,e^{-0.14112\, x^3-3.1952\,x}}\over{\left(e^{-0.07056\,x^3-1.5976\,x}+1\right)^3} }$$ 好丑好难写。 这时候就可以利用`deriv`来建立gradient and hessian。先建立gradient: ```{r} F.exp <- expression(1/(1 + exp(-0.07056 * x^3 - 1.5976 * x))) deriv(F.exp, namevec="x") ``` 稍作修改就可以得到: ```{r} F.1 <- function(x) { .expr6 <- exp(-0.07056 * x^3 - 1.5976 * x) .expr7 <- 1 + .expr6 .value <- 1/.expr7 .expr6 * (0.07056 * (3 * x^2) + 1.5976)/.expr7^2 } ``` 再参考`deriv`的hessian算式: ```{r} deriv(F.exp, namevec="x", hessian=TRUE) ``` 可以写出: ```{r} F.2 <- function(x) { .expr6 <- exp(-0.07056 * x^3 - 1.5976 * x) .expr7 <- 1 + .expr6 .expr12 <- 0.07056 * (3 * x^2) + 1.5976 .expr13 <- .expr6 * .expr12 .expr14 <- .expr7^2 1/.expr7 (.expr6 * (0.07056 * (3 * (2 * x))) - .expr13 * .expr12)/.expr14 + .expr13 * (2 * (.expr13 * .expr7))/.expr14^2 } ``` 和`numDeriv`比较一下: ```{r} x <- rnorm(1) grad(F.0, x) F.1(x) hessian(F.0, x) F.2(x) ``` 完全一致! 但是用`deriv`建立的函数效能绝对比较好: ```{r} library(microbenchmark) microbenchmark(grad(F.0, x), F.1(x)) microbenchmark(hessian(F.0, x), F.2(x)) ``` 以上内容给大家参考罗! # Reference ```{r, results='asis', echo=FALSE} bibliography() ``` --



※ 发信站: 批踢踢实业坊(ptt.cc)
◆ From: 1.34.138.85
1F:推 maninblue:推~ 01/16 11:11







like.gif 您可能会有兴趣的文章
icon.png[问题/行为] 猫晚上进房间会不会有憋尿问题
icon.pngRe: [闲聊] 选了错误的女孩成为魔法少女 XDDDDDDDDDD
icon.png[正妹] 瑞典 一张
icon.png[心得] EMS高领长版毛衣.墨小楼MC1002
icon.png[分享] 丹龙隔热纸GE55+33+22
icon.png[问题] 清洗洗衣机
icon.png[寻物] 窗台下的空间
icon.png[闲聊] 双极の女神1 木魔爵
icon.png[售车] 新竹 1997 march 1297cc 白色 四门
icon.png[讨论] 能从照片感受到摄影者心情吗
icon.png[狂贺] 贺贺贺贺 贺!岛村卯月!总选举NO.1
icon.png[难过] 羡慕白皮肤的女生
icon.png阅读文章
icon.png[黑特]
icon.png[问题] SBK S1安装於安全帽位置
icon.png[分享] 旧woo100绝版开箱!!
icon.pngRe: [无言] 关於小包卫生纸
icon.png[开箱] E5-2683V3 RX480Strix 快睿C1 简单测试
icon.png[心得] 苍の海贼龙 地狱 执行者16PT
icon.png[售车] 1999年Virage iO 1.8EXi
icon.png[心得] 挑战33 LV10 狮子座pt solo
icon.png[闲聊] 手把手教你不被桶之新手主购教学
icon.png[分享] Civic Type R 量产版官方照无预警流出
icon.png[售车] Golf 4 2.0 银色 自排
icon.png[出售] Graco提篮汽座(有底座)2000元诚可议
icon.png[问题] 请问补牙材质掉了还能再补吗?(台中半年内
icon.png[问题] 44th 单曲 生写竟然都给重复的啊啊!
icon.png[心得] 华南红卡/icash 核卡
icon.png[问题] 拔牙矫正这样正常吗
icon.png[赠送] 老莫高业 初业 102年版
icon.png[情报] 三大行动支付 本季掀战火
icon.png[宝宝] 博客来Amos水蜡笔5/1特价五折
icon.pngRe: [心得] 新鲜人一些面试分享
icon.png[心得] 苍の海贼龙 地狱 麒麟25PT
icon.pngRe: [闲聊] (君の名は。雷慎入) 君名二创漫画翻译
icon.pngRe: [闲聊] OGN中场影片:失踪人口局 (英文字幕)
icon.png[问题] 台湾大哥大4G讯号差
icon.png[出售] [全国]全新千寻侘草LED灯, 水草

请输入看板名称,例如:Soft_Job站内搜寻

TOP