1 2R version 2.13.1 (2011-07-08) 3Copyright (C) 2011 The R Foundation for Statistical Computing 4ISBN 3-900051-07-0 5Platform: x86_64-pc-linux-gnu (64-bit) 6 7R is free software and comes with ABSOLUTELY NO WARRANTY. 8You are welcome to redistribute it under certain conditions. 9Type 'license()' or 'licence()' for distribution details. 10 11R is a collaborative project with many contributors. 12Type 'contributors()' for more information and 13'citation()' on how to cite R or R packages in publications. 14 15Type 'demo()' for some demos, 'help()' for on-line help, or 16'help.start()' for an HTML browser interface to help. 17Type 'q()' to quit R. 18 19> library(mcmc) 20> isotropic <- mcmc:::isotropic 21> isotropic.logjacobian <- mcmc:::isotropic.logjacobian 22> 23> # make sure morph identity works properly 24> TestMorphIdentity <- function(m.id) { 25+ ident.func <- function(x) x 26+ if (!all.equal(m.id$transform(1:10), 1:10)) 27+ return(FALSE) 28+ if (!all.equal(m.id$inverse(1:10), 1:10)) 29+ return(FALSE) 30+ x <- seq(-1,1, length.out=15) 31+ if (!all.equal(sapply(x, m.id$lud(function(x) dnorm(x, log=TRUE))), 32+ dnorm(x, log=TRUE))) 33+ return(FALSE) 34+ if (!all.equal(m.id$outfun(ident.func)(x), x)) 35+ return(FALSE) 36+ return(TRUE) 37+ } 38> 39> TestMorphIdentity(morph()) 40[1] TRUE 41> TestMorphIdentity(morph.identity()) 42[1] TRUE 43> 44> TestMorphIdentityOutfun <- function(m) { 45+ f <- m$outfun(NULL) 46+ x <- 1:20 47+ if (!identical(x, f(x))) 48+ return(FALSE) 49+ f <- m$outfun(c(6, 8)) 50+ if (!identical(x[c(6, 8)], f(x))) 51+ return(FALSE) 52+ i <- rep(FALSE, 20) 53+ i[c(1, 3, 5)] <- TRUE 54+ f <- m$outfun(i) 55+ if (!identical(x[i], f(x))) 56+ return(FALSE) 57+ return(TRUE) 58+ } 59> 60> TestMorphIdentityOutfun(morph()) 61[1] TRUE 62> TestMorphIdentityOutfun(morph.identity()) 63[1] TRUE 64> 65> # make sure that morph and morph.identity give back the same things 66> all.equal(sort(names(morph.identity())), sort(names(morph(b=1)))) 67[1] TRUE 68> 69> # test center parameter, univariate version 70> zero.func <- function(x) 0 71> center <- 2 72> x <- seq(-1,1, length.out=15) 73> morph.center <- morph(center=center) 74> all.equal(sapply(x, morph.center$transform), x-center) 75[1] TRUE 76> all.equal(sapply(x, morph.center$inverse), x+center) 77[1] TRUE 78> all.equal(sapply(x, morph.center$lud(function(y) dnorm(y, log=TRUE))), 79+ dnorm(x, log=TRUE, mean=-2)) 80[1] TRUE 81> 82> # test center parameter, multivariate version 83> center <- 1:4 84> x <- rep(0, 4) 85> morph.center <- morph(center=center) 86> lud.mult.dnorm <- function(x) prod(dnorm(x, log=TRUE)) 87> all.equal(morph.center$transform(x), x-center) 88[1] TRUE 89> all.equal(morph.center$inverse(x), x+center) 90[1] TRUE 91> all.equal(morph.center$lud(lud.mult.dnorm)(x), 92+ lud.mult.dnorm(x - center)) 93[1] TRUE 94> # test 'r'. 95> r <- 1 96> morph.r <- morph(r=r) 97> x <- seq(-1, 1, length.out=20) 98> all.equal(sapply(x, morph.r$lud(function(x) dnorm(x, log=TRUE))), 99+ dnorm(x, log=TRUE)) 100[1] TRUE 101> x <- seq(1.1, 2, length.out=10) 102> all(sapply(x, morph.r$lud(function(x) dnorm(x, log=TRUE))) 103+ != 104+ dnorm(x, log=TRUE)) 105[1] TRUE 106> 107> TestExponentialEvenPWithRInverse <- function() { 108+ r <- 0.3 109+ p <- 2.2 110+ morph.r <- morph(r=r, p=p) 111+ x <- seq(0, r, length.out=20) 112+ all.equal(x, sapply(x, morph.r$inverse)) 113+ } 114> 115> TestExponentialEvenPWithRInverse() 116[1] TRUE 117> 118> # make sure morph$lud passes '...' arguments. 119> mean <- 2 120> ident.morph <- morph() 121> dnorm.morph <- ident.morph$lud(function(x, mean=0) 122+ dnorm(x, mean=mean, log=TRUE)) 123> all.equal(dnorm.morph(2, mean), dnorm(2, mean=mean, log=TRUE)) 124[1] TRUE 125> x <- seq(-3, 3, length.out=20) 126> m2 <- morph(r=10) 127> dnorm.morph <- m2$lud(function(x, mean) 128+ dnorm(x, mean=mean, log=TRUE)) 129> all.equal(sapply(x, function(y) dnorm.morph(y, 2)), 130+ dnorm(x, mean=2, log=TRUE)) 131[1] TRUE 132> 133> # make sure morph$outfun passes '...' arguments. 134> outfun.orig <- function(x, mean) x + mean 135> ident.morph <- morph() 136> mean <- 1 137> outfun.morph <- ident.morph$outfun(outfun.orig) 138> all.equal(outfun.morph(1:10, mean), 1:10+mean) 139[1] TRUE 140> 141> m2 <- morph(r=10) 142> outfun.morph <- m2$outfun(outfun.orig) 143> all.equal(sapply(1:10, function(x) outfun.morph(x, mean)), 1:10+mean) 144[1] TRUE 145> 146> ########################################################################### 147> # test built-in exponential and polynomial transformations. 148> f <- morph(b=3) 149> x <- seq(0, 10, length.out=100) 150> all.equal(x, sapply(sapply(x, f$transform), f$inverse)) 151[1] TRUE 152> 153> f <- morph(p=3) 154> all.equal(x, sapply(sapply(x, f$transform), f$inverse)) 155[1] TRUE 156> 157> f <- morph(p=3, r=10) 158> all.equal(-10:10, Vectorize(f$transform)(-10:10)) 159[1] TRUE 160> 161> f <- morph(p=3, b=1) 162> all.equal(x, sapply(sapply(x, f$transform), f$inverse)) 163[1] TRUE 164> 165