Commit d5d791a0 authored by Radford Neal's avatar Radford Neal

more gradient tests

parent dd2401c7
......@@ -144,17 +144,28 @@ x1 <- 0.89472; x2 <- 0.49718
i1 <- 3
bindgrads <- function (r1,r2)
cbind (rbind(r1,r2), rbind(attr(r1,"gradient"),attr(r2,"gradient")))
cbind (rbind(r1,r2), rbind(attr(r1,"gradient"),unlist(attr(r2,"gradient"))))
test1 <- function (fun,...)
print (bindgrads (numericDeriv(quote(fun(x,...)),"x"),
with_gradient (x) fun(x,...)))
test1p1 <- function (fun,...)
print (bindgrads (numericDeriv(quote(fun(x+1,...)),"x"),
with_gradient (x) fun(x+1,...)))
test1r <- function (fun,...) {
f <- function (x) { set.seed(179); fun(1,x,...) }
print (bindgrads (numericDeriv(quote(f(x)),"x"),
with_gradient (x) f(x)))
}
test2 <- function (fun,...) {
print (bindgrads (numericDeriv(quote(fun(x1,x2,...)),"x1"),
with_gradient (x1) fun(x1,x2,...)))
print (bindgrads (numericDeriv(quote(fun(x1,x2,...)),"x2"),
with_gradient (x2) fun(x1,x2,...)))
print (bindgrads (numericDeriv(quote(fun(x1,x2,...)),c("x1","x2")),
with_gradient (x1,x2) fun(x1,x2,...)))
print (bindgrads (numericDeriv(quote(fun(x1,x2,...)),c("x1","x2")),
{ r <- with_gradient (x1) { s <- with_gradient (x2) fun(x1,x2,...);
g2 <<- attr(s,"gradient"); s }
......@@ -169,18 +180,44 @@ test2i <- function (fun,...) {
with_gradient (x2) fun(i1,x2,...)))
}
test1(sin)
test1(abs)
test1(sqrt)
test1(exp)
test1(expm1)
test1(log1p)
test1(log)
test1(log2)
test1(log10)
test1(cos)
test1(sin)
test1(tan)
test1(acos)
test1(asin)
test1(atan)
test1(cosh)
test1(sinh)
test1(tanh)
test1p1(acosh)
test1(asinh)
test1(atanh)
test1(gamma)
test1(lgamma)
test1(digamma)
test1(trigamma)
test2(atan2)
test2(dexp)
test2(dexp,log=TRUE)
test1r(rexp)
test2i(dgeom)
test2i(dgeom,log=TRUE)
......@@ -253,11 +253,20 @@ attr(,"gradient")
> i1 <- 3
>
> bindgrads <- function (r1,r2)
+ cbind (rbind(r1,r2), rbind(attr(r1,"gradient"),attr(r2,"gradient")))
+ cbind (rbind(r1,r2), rbind(attr(r1,"gradient"),unlist(attr(r2,"gradient"))))
>
> test1 <- function (fun,...)
+ print (bindgrads (numericDeriv(quote(fun(x,...)),"x"),
+ with_gradient (x) fun(x,...)))
> test1p1 <- function (fun,...)
+ print (bindgrads (numericDeriv(quote(fun(x+1,...)),"x"),
+ with_gradient (x) fun(x+1,...)))
>
> test1r <- function (fun,...) {
+ f <- function (x) { set.seed(179); fun(1,x,...) }
+ print (bindgrads (numericDeriv(quote(f(x)),"x"),
+ with_gradient (x) f(x)))
+ }
>
> test2 <- function (fun,...) {
+ print (bindgrads (numericDeriv(quote(fun(x1,x2,...)),"x1"),
......@@ -265,6 +274,8 @@ attr(,"gradient")
+ print (bindgrads (numericDeriv(quote(fun(x1,x2,...)),"x2"),
+ with_gradient (x2) fun(x1,x2,...)))
+ print (bindgrads (numericDeriv(quote(fun(x1,x2,...)),c("x1","x2")),
+ with_gradient (x1,x2) fun(x1,x2,...)))
+ print (bindgrads (numericDeriv(quote(fun(x1,x2,...)),c("x1","x2")),
+ { r <- with_gradient (x1) { s <- with_gradient (x2) fun(x1,x2,...);
+ g2 <<- attr(s,"gradient"); s }
+ attr(r,"gradient") <- cbind(g1=attr(r,"gradient"),g2=g2)
......@@ -278,20 +289,110 @@ attr(,"gradient")
+ with_gradient (x2) fun(i1,x2,...)))
+ }
>
> test1(abs)
[,1] [,2]
r1 0.32739 1
r2 0.32739 1
>
> test1(sqrt)
[,1] [,2]
r1 0.57218 0.8738508
r2 0.57218 0.8738508
>
> test1(exp)
[,1] [,2]
r1 1.387342 1.387342
r2 1.387342 1.387342
> test1(expm1)
[,1] [,2]
r1 0.3873424 1.387342
r2 0.3873424 1.387342
>
> test1(log1p)
[,1] [,2]
r1 0.2832146 0.7533581
r2 0.2832146 0.7533581
> test1(log)
[,1] [,2]
r1 -1.116603 3.054461
r2 -1.116603 3.054461
> test1(log2)
[,1] [,2]
r1 -1.610918 4.406656
r2 -1.610918 4.406656
> test1(log10)
[,1] [,2]
r1 -0.4849346 1.326536
r2 -0.4849346 1.326536
>
> test1(cos)
[,1] [,2]
r1 0.9468849 -0.3215728
r2 0.9468849 -0.3215728
> test1(sin)
[,1] [,2]
r1 0.3215728 0.9468849
r2 0.3215728 0.9468849
> test1(tan)
[,1] [,2]
r1 0.3396113 1.115336
r2 0.3396113 1.115336
>
> test1(log)
> test1(acos)
[,1] [,2]
r1 1.237256 -1.058325
r2 1.237256 -1.058325
> test1(asin)
[,1] [,2]
r1 0.33354 1.058325
r2 0.33354 1.058325
> test1(atan)
[,1] [,2]
r1 0.3163921 0.9031921
r2 0.3163921 0.9031921
>
> test1(cosh)
[,1] [,2]
r1 1.054073 0.3332699
r2 1.054073 0.3332699
> test1(sinh)
[,1] [,2]
r1 -1.116603 3.054461
r2 -1.116603 3.054461
r1 0.3332699 1.054073
r2 0.3332699 1.054073
> test1(tanh)
[,1] [,2]
r1 0.3161736 0.9000342
r2 0.3161736 0.9000342
>
> test1p1(acosh)
[,1] [,2]
r1 0.7885917 1.145599
r2 0.7885917 1.145599
> test1(asinh)
[,1] [,2]
r1 0.3218068 0.9503642
r2 0.3218068 0.9503642
> test1(atanh)
[,1] [,2]
r1 0.3399021 1.120052
r2 0.3399021 1.120052
>
> test1(gamma)
[,1] [,2]
r1 2.729765 -8.716212
r2 2.729765 -8.716212
> test1(lgamma)
[,1] [,2]
r1 1.004216 -3.193026
r2 1.004216 -3.193026
> test1(digamma)
[,1] [,2]
r1 -3.193026 10.43204
r2 -3.193026 10.43204
> test1(trigamma)
[,1] [,2]
r1 10.43204 -58.12982
r2 10.43204 -58.12982
>
> test2(atan2)
[,1] [,2]
......@@ -300,6 +401,9 @@ r2 1.063601 0.4745389
[,1] [,2]
r1 1.063601 -0.8539753
r2 1.063601 -0.8539753
x1 x2
r1 1.063601 0.4745389 -0.8539753
r2 1.063601 0.4745389 -0.8539753
g1 g2
r1 1.063601 0.4745389 -0.8539753
r2 1.063601 0.4745389 -0.8539753
......@@ -311,10 +415,12 @@ r2 0.318657 -0.1584299
[,1] [,2]
r1 0.318657 0.35582
r2 0.318657 0.35582
x1 x2
r1 0.318657 -0.1584299 0.35582
r2 0.318657 -0.1584299 0.35582
g1 g2
r1 0.318657 -0.1584299 0.35582
r2 0.318657 -0.1584299 0.35582
>
> test2(dexp,log=TRUE)
[,1] [,2]
r1 -1.14364 -0.49718
......@@ -322,15 +428,21 @@ r2 -1.14364 -0.49718
[,1] [,2]
r1 -1.14364 1.116624
r2 -1.14364 1.116624
x1 x2
r1 -1.14364 -0.49718 1.116624
r2 -1.14364 -0.49718 1.116624
g1 g2
r1 -1.14364 -0.49718 1.116624
r2 -1.14364 -0.49718 1.116624
> test1r(rexp)
[,1] [,2]
r1 0.7957275 -2.430519
r2 0.7957275 -2.430519
>
> test2i(dgeom)
[,1] [,2]
r1 0.06320498 -0.2499760
r2 0.06320498 -0.2499761
>
> test2i(dgeom,log=TRUE)
[,1] [,2]
r1 -2.761372 -3.955006
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment