tgp/0000755000176200001440000000000013731677333011061 5ustar liggesuserstgp/NAMESPACE0000644000176200001440000000171313531032535012265 0ustar liggesusers# Load the shared object useDynLib(tgp) # Exports export(blm, btlm, bcart, bgp, bgpllm, btgp, btgpllm, default.itemps, dopt.gp, exp2d.Z, exp2d.rand, friedman.1.data, fried.bool, interp.loess, itemps.barplot, hist2bar, lhs, mapT, optim.step.tgp, optim.ptgpf, partition, sens, tgp.default.params, tgp.design, tgp.trees, mean0.range1) # Import all packages listed as Imports or Depends importFrom(maptree, draw.tree) ## required for new CRAN checks importFrom("grDevices", "rainbow", "terrain.colors") importFrom("graphics", "abline", "axis", "barplot", "boxplot", "contour", "image", "legend", "lines", "mtext", "par", "persp", "plot", "points", "segments", "text", "title") importFrom("stats", "loess", "optim", "optimize", "predict", "proj", "rnorm", "runif") importFrom("utils", "data", "read.table") # S3 S3method(print, tgp) S3method(plot, tgp) S3method(predict, tgp) S3method(print, tgptraces) tgp/demo/0000755000176200001440000000000013531032535011770 5ustar liggesuserstgp/demo/traces.R0000644000176200001440000000605113531032535013376 0ustar liggesusers################################################### ### chunk number 1: ################################################### library(tgp) ##options(width=65) seed <- 0; set.seed(seed) ################################################### ### chunk number 2: ################################################### exp2d.data <- exp2d.rand(n2=150, lh=0, dopt=10) X <- exp2d.data$X Z <- exp2d.data$Z XX <- rbind(c(0,0),c(2,2),c(4,4)) ################################################### ### chunk number 3: ################################################### out <- btgpllm(X=X, Z=Z, XX=XX, corr="exp", bprior="b0", pred.n=FALSE, Ds2x=TRUE, R=10, #BTE=c(2000,5000,10), trace=TRUE, verb=0) ################################################### ### chunk number 4: ################################################### out$trace ################################################### ### chunk number 5: XXd ################################################### trXX <- out$trace$XX; ltrXX <- length(trXX) y <- trXX[[1]]$d for(i in 2:ltrXX) y <- c(y, trXX[[i]]$d) plot(log(trXX[[1]]$d), type="l", ylim=range(log(y)), ylab="log(d)", main="range (d) parameter traces") names <- "XX[1,]" for(i in 2:ltrXX) { lines(log(trXX[[i]]$d), col=i, lty=i) names <- c(names, paste("XX[", i, ",]", sep="")) } legend("bottomleft", names, col=1:ltrXX, lty=1:ltrXX) ################################################### ### chunk number 6: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 7: ################################################### linarea <- mean(out$trace$linarea$la) linarea ################################################### ### chunk number 8: la ################################################### hist(out$trace$linarea$la) ################################################### ### chunk number 9: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 10: ################################################### m <- matrix(0, nrow=length(trXX), ncol=3)#ncol=5) for(i in 1:length(trXX)) m[i,] <- as.double(c(out$XX[i,], mean(trXX[[i]]$b))) m <- data.frame(cbind(m, 1-m[,3])) names(m)=c("XX1","XX2","b","pllm") m ################################################### ### chunk number 11: alc ################################################### trALC <- out$trace$preds$Ds2x y <- trALC[,1] for(i in 2:ncol(trALC)) y <- c(y, trALC[,i]) plot(log(trALC[,1]), type="l", ylim=range(log(y)), ylab="Ds2x", main="ALC: samples from Ds2x") names <- "XX[1,]" for(i in 2:ncol(trALC)) { lines(log(trALC[,i]), col=i, lty=i) names <- c(names, paste("XX[", i, ",]", sep="")) } legend("bottomright", names, col=1:ltrXX, lty=1:ltrXX) ################################################### ### chunk number 12: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() tgp/demo/linear.R0000644000176200001440000000377313531032535013377 0ustar liggesusers################################################### ### chunk number 1: ################################################### library(tgp) ##options(width=65) seed <- 0; set.seed(seed) ################################################### ### chunk number 2: ################################################### # 1-d linear data input and predictive data X <- seq(0,1,length=50) # inputs XX <- seq(0,1,length=99) # predictive locations Z <- 1 + 2*X + rnorm(length(X),sd=0.25) # responses ################################################### ### chunk number 3: ################################################### lin.blm <- blm(X=X, XX=XX, Z=Z) ################################################### ### chunk number 4: blm ################################################### plot(lin.blm, main='Linear Model,', layout='surf') abline(1,2,lty=3,col='blue') ################################################### ### chunk number 5: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 6: ################################################### lin.gpllm <- bgpllm(X=X, XX=XX, Z=Z) ################################################### ### chunk number 7: gplm ################################################### plot(lin.gpllm, main='GP LLM,', layout='surf') abline(1,2,lty=4,col='blue') ################################################### ### chunk number 8: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 9: ################################################### lin.gpllm.tr <- bgpllm(X=X, XX=0.5, Z=Z, pred.n=FALSE, trace=TRUE, verb=0) mla <- mean(lin.gpllm.tr$trace$linarea$la) mla ################################################### ### chunk number 10: ################################################### 1-mean(lin.gpllm.tr$trace$XX[[1]]$b1) tgp/demo/fried.R0000644000176200001440000000346613531032535013215 0ustar liggesusers################################################### ### chunk number 1: ################################################### library(tgp) ##options(width=65) seed <- 0; set.seed(seed) ################################################### ### chunk number 2: ################################################### f <- friedman.1.data(200) ff <- friedman.1.data(1000) X <- f[,1:10]; Z <- f$Y XX <- ff[,1:10] ################################################### ### chunk number 3: ################################################### fr.btlm <- btlm(X=X, Z=Z, XX=XX, tree=c(0.95,2), pred.n=FALSE, verb=0) fr.btlm.mse <- sqrt(mean((fr.btlm$ZZ.mean - ff$Ytrue)^2)) fr.btlm.mse ################################################### ### chunk number 4: ################################################### fr.bgpllm <- bgpllm(X=X, Z=Z, XX=XX, pred.n=FALSE, verb=0) fr.bgpllm.mse <- sqrt(mean((fr.bgpllm$ZZ.mean - ff$Ytrue)^2)) fr.bgpllm.mse ################################################### ### chunk number 5: ################################################### XX1 <- matrix(rep(0,10), nrow=1) fr.bgpllm.tr <- bgpllm(X=X, Z=Z, XX=XX1, pred.n=FALSE, trace=TRUE, m0r1=FALSE, verb=0) ################################################### ### chunk number 6: ################################################### trace <- fr.bgpllm.tr$trace$XX[[1]] apply(trace[,27:36], 2, mean) ################################################### ### chunk number 7: ################################################### mean(fr.bgpllm.tr$trace$linarea$ba) ################################################### ### chunk number 8: ################################################### summary(trace[,9:10]) ################################################### ### chunk number 9: ################################################### apply(trace[,11:15], 2, mean) tgp/demo/cat.R0000644000176200001440000000644713531032535012675 0ustar liggesusers################################################### ### chunk number 1: ################################################### library(tgp) library(maptree) #options(width=65) seed <- 0; set.seed(seed) ################################################### ### chunk number 2: ################################################### fb.train <- fried.bool(500) X <- fb.train[,1:13]; Z <- fb.train$Y fb.test <- fried.bool(1000) XX <- fb.test[,1:13]; ZZ <- fb.test$Ytrue ################################################### ### chunk number 3: ################################################### names(X) ################################################### ### chunk number 4: ################################################### fit1 <- bcart(X=X, Z=Z, XX=XX, verb=0) rmse1 <- sqrt(mean((fit1$ZZ.mean - ZZ)^2)) rmse1 ################################################### ### chunk number 5: cat-fbcart-mapt ################################################### tgp.trees(fit1, "map") ################################################### ### chunk number 6: ################################################### graphics.off() ################################################### ### chunk number 7: ################################################### fit2 <- btlm(X=X, Z=Z, XX=XX, verb=0) rmse2 <- sqrt(mean((fit2$ZZ.mean - ZZ)^2)) rmse2 ################################################### ### chunk number 8: cat-fbtlm-trees ################################################### tgp.trees(fit2, "map") ################################################### ### chunk number 9: ################################################### graphics.off() ################################################### ### chunk number 10: ################################################### fit3 <- btlm(X=X, Z=Z, XX=XX, basemax=10, verb=0) rmse3 <- sqrt(mean((fit3$ZZ.mean - ZZ)^2)) rmse3 ################################################### ### chunk number 11: cat-fbtlm-mapt ################################################### tgp.trees(fit3, "map") ################################################### ### chunk number 12: ################################################### graphics.off() ################################################### ### chunk number 13: ################################################### fit4 <- btgpllm(X=X, Z=Z, XX=XX, verb=0) rmse4 <- sqrt(mean((fit4$ZZ.mean - ZZ)^2)) rmse4 ################################################### ### chunk number 14: ################################################### fit4$gpcs ################################################### ### chunk number 15: ################################################### fit5 <- btgpllm(X=X, Z=Z, XX=XX, basemax=10, verb=0) rmse5 <- sqrt(mean((fit5$ZZ.mean - ZZ)^2)) rmse5 ################################################### ### chunk number 16: cat-fb-mapt ################################################### h <- fit1$post$height[which.max(fit1$posts$lpost)] tgp.trees(fit5, "map") ################################################### ### chunk number 17: ################################################### graphics.off() ################################################### ### chunk number 18: ################################################### fit6 <- btgpllm(X=X, Z=Z, XX=XX, basemax=10, splitmin=11, verb=0) rmse6 <- sqrt(mean((fit6$ZZ.mean - ZZ)^2)) rmse6 tgp/demo/optim.R0000644000176200001440000000677413531032535013261 0ustar liggesusers################################################### ### chunk number 1: ################################################### library(tgp) seed <- 0; set.seed(seed) ################################################### ### chunk number 2: ################################################### rosenbrock <- function(x){ x <- matrix(x, ncol=2) 100*(x[,1]^2 - x[,2])^2 + (x[,1] - 1)^2 } ################################################### ### chunk number 3: ################################################### rosenbrock(c(1,1)) ################################################### ### chunk number 4: ################################################### rect <- cbind(c(-1,-1),c(5,5)) X <- lhs(40, rect) Z <- rosenbrock(X) ################################################### ### chunk number 5: ################################################### XX <- lhs(200, rect) rfit <- bgp(X,Z,XX,improv=c(1,10), verb=0) ################################################### ### chunk number 6: ################################################### cbind(rfit$improv,XX)[rfit$improv$rank <= 10,] ################################################### ### chunk number 7: optim-fit1 ################################################### plot(rfit, as="improv") ################################################### ### chunk number 8: ################################################### graphics.off() ################################################### ### chunk number 9: optim-fit2 ################################################### rfit2 <- predict(rfit, XX=XX, BTE=c(1,1000,1), improv=c(5,20), verb=0) plot(rfit2, layout="as", as="improv") ################################################### ### chunk number 10: ################################################### graphics.off() ################################################### ### chunk number 11: ################################################### f <- function(x) { exp2d.Z(x)$Z } ################################################### ### chunk number 12: ################################################### rect <- rbind(c(-2,6), c(-2,6)) X <- lhs(20, rect) Z <- f(X) ################################################### ### chunk number 13: ################################################### out <- progress <- NULL for(i in 1:20) { ## get recommendations for the next point to sample out <- optim.step.tgp(f, X=X, Z=Z, rect=rect, prev=out, verb=0) ## add in the inputs, and newly sampled outputs X <- rbind(X, out$X) Z <- c(Z, f(out$X)) ## keep track of progress and best optimum progress <- rbind(progress, out$progress) } ################################################### ### chunk number 14: optim-progress ################################################### par(mfrow=c(1,2)) matplot(progress[,1:2], main="x progress", xlab="rounds", ylab="x[,1:2]", type="l", lwd=2) plot(log(progress$improv), type="l", main="max log improv", xlab="rounds", ylab="max log(improv)") ################################################### ### chunk number 15: ################################################### graphics.off() ################################################### ### chunk number 16: ################################################### out$progress[1:2] ################################################### ### chunk number 17: ################################################### formals(optim)$method ################################################### ### chunk number 18: ################################################### formals(optim.ptgpf)$method tgp/demo/it.R0000644000176200001440000002171713531032535012537 0ustar liggesusers################################################### ### chunk number 1: ################################################### library(tgp) library(maptree) #options(width=65) seed <- 0; set.seed(seed) ################################################### ### chunk number 2: ################################################### geo <- default.itemps(type="geometric") har <- default.itemps(type="harmonic") sig <- default.itemps(type="sigmoidal") ################################################### ### chunk number 3: it-itemps ################################################### par(mfrow=c(2,1)) all <- cbind(geo$k, har$k, sig$k) matplot(all, pch=21:23, main="inv-temp ladders", xlab="indx", ylab="itemp") legend("topright", pch=21:23, c("geometric","harmonic","sigmoidal"), col=1:3) matplot(log(all), pch=21:23, main="log(inv-temp) ladders", xlab="indx", ylab="itemp") ################################################### ### chunk number 4: ################################################### graphics.off() ################################################### ### chunk number 5: ################################################### ESS <- function(w) { mw <- mean(w) cv2 <- sum((w-mw)^2)/((length(w)-1)*mw^2) ess <- length(w)/(1+cv2) return(ess) } ################################################### ### chunk number 6: ################################################### exp2d.data<-exp2d.rand() X<-exp2d.data$X Z<-exp2d.data$Z ################################################### ### chunk number 7: ################################################### its <- default.itemps(m=10) exp.btlm <- btlm(X=X,Z=Z, bprior="b0", R=2, itemps=its, pred.n=FALSE, BTE=c(1000,3000,2)) ################################################### ### chunk number 8: ################################################### exp.btlm$ess ################################################### ### chunk number 9: ################################################### library(MASS) moto.it <- btgpllm(X=mcycle[,1], Z=mcycle[,2], BTE=c(2000,52000,10), bprior="b0", R=3, itemps=geo, trace=TRUE, pred.n=FALSE, verb=0) ################################################### ### chunk number 10: ################################################### moto.it$ess$combined ################################################### ### chunk number 11: ################################################### p <- moto.it$trace$post ESS(p$wlambda) ################################################### ### chunk number 12: ################################################### ESS(p$w) ################################################### ### chunk number 13: ################################################### as.numeric(c(sum(p$itemp == 1), moto.it$ess$each[1,2:3])) ################################################### ### chunk number 14: ################################################### moto.reg <- btgpllm(X=mcycle[,1], Z=mcycle[,2], BTE=c(2000,52000,10), R=3, bprior="b0", trace=TRUE, pred.n=FALSE, verb=0) ################################################### ### chunk number 15: ################################################### L <- length(p$height) hw <- suppressWarnings(sample(p$height, L, prob=p$wlambda, replace=TRUE)) b <- hist2bar(cbind(moto.reg$trace$post$height, p$height, hw)) ################################################### ### chunk number 16: it-moto-height ################################################### barplot(b, beside=TRUE, col=1:3, xlab="tree height", ylab="counts", main="tree heights encountered") legend("topright", c("reg MCMC", "All Temps", "IT"), fill=1:3) ################################################### ### chunk number 17: ################################################### graphics.off() ################################################### ### chunk number 18: it-moto-ktrace ################################################### plot(log(moto.it$trace$post$itemp), type="l", ylab="log(k)", xlab="samples", main="trace of log(k)") ################################################### ### chunk number 19: ################################################### graphics.off() ################################################### ### chunk number 20: it-moto-khist ################################################### b <- itemps.barplot(moto.it, plot.it=FALSE) barplot(t(cbind(moto.it$itemps$counts, b)), col=1:2, beside=TRUE, ylab="counts", xlab="itemps", main="inv-temp observation counts") legend("topleft", c("observation counts", "posterior samples"), fill=1:2) ################################################### ### chunk number 21: ################################################### graphics.off() ################################################### ### chunk number 22: ################################################### moto.it.sig <- btgpllm(X=mcycle[,1], Z=mcycle[,2], BTE=c(2000,52000,10), R=3, bprior="b0", krige=FALSE, itemps=sig, verb=0) ################################################### ### chunk number 23: ################################################### moto.it.sig$ess$combined ################################################### ### chunk number 24: it-moto-pred ################################################### plot(moto.it.sig) ################################################### ### chunk number 25: ################################################### graphics.off() ################################################### ### chunk number 26: ################################################### Xcand <- lhs(10000, rbind(c(-6,6),c(-6,6))) X <- dopt.gp(400, X=NULL, Xcand)$XX Z <- exp2d.Z(X)$Z ################################################### ### chunk number 27: ################################################### exp.reg <- btgpllm(X=X, Z=Z, BTE=c(2000,52000,10), bprior="b0", trace=TRUE, krige=FALSE, R=10, verb=0) ################################################### ### chunk number 28: it-exp-pred ################################################### plot(exp.reg) ################################################### ### chunk number 29: ################################################### graphics.off() ################################################### ### chunk number 30: ################################################### h <- exp.reg$post$height[which.max(exp.reg$posts$lpost)] h ################################################### ### chunk number 31: it-exp-mapt ################################################### tgp.trees(exp.reg, "map") ################################################### ### chunk number 32: ################################################### graphics.off() ################################################### ### chunk number 33: ################################################### its <- default.itemps(k.min=0.02) exp.it <- btgpllm(X=X, Z=Z, BTE=c(2000,52000,10), bprior="b0", trace=TRUE, krige=FALSE, itemps=its, R=10, verb=0) ################################################### ### chunk number 34: ################################################### exp.it$gpcs exp.reg$gpcs ################################################### ### chunk number 35: ################################################### p <- exp.it$trace$post data.frame(ST=sum(p$itemp == 1), nIT=ESS(p$w), oIT=exp.it$ess$combined) ################################################### ### chunk number 36: ################################################### L <- length(p$height) hw <- suppressWarnings(sample(p$height, L, prob=p$wlambda, replace=TRUE)) b <- hist2bar(cbind(exp.reg$trace$post$height, p$height, hw)) ################################################### ### chunk number 37: it-exp-height ################################################### barplot(b, beside=TRUE, col=1:3, xlab="tree height", ylab="counts", main="tree heights encountered") legend("topright", c("reg MCMC", "All Temps", "IT"), fill=1:3) ################################################### ### chunk number 38: ################################################### graphics.off() ################################################### ### chunk number 39: it-exp-trace-height ################################################### ylim <- range(p$height, exp.reg$trace$post$height) plot(p$height, type="l", main="trace of tree heights", xlab="t", ylab="height", ylim=ylim) lines(exp.reg$trace$post$height, col=2) legend("topright", c("tempered", "reg MCMC"), lty=c(1,1), col=1:2) ################################################### ### chunk number 40: ################################################### graphics.off() ################################################### ### chunk number 41: it-expit-pred ################################################### plot(exp.it) ################################################### ### chunk number 42: it-expit-trees ################################################### tgp.trees(exp.it, "map") ################################################### ### chunk number 43: ################################################### graphics.off() tgp/demo/moto.R0000644000176200001440000000500513531032535013071 0ustar liggesusers################################################### ### chunk number 1: ################################################### library(tgp) ##options(width=65) seed <- 0; set.seed(seed) ################################################### ### chunk number 2: ################################################### library(MASS) X <- data.frame(times=mcycle[,1]) Z <- data.frame(accel=mcycle[,2]) ################################################### ### chunk number 3: ################################################### moto.bgp <- bgp(X=X, Z=Z, verb=0) ################################################### ### chunk number 4: bgp ################################################### plot(moto.bgp, main='GP,', layout='surf') ################################################### ### chunk number 5: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 6: ################################################### moto.btlm <- btlm(X=X, Z=Z, verb=0) ################################################### ### chunk number 7: btlm ################################################### plot(moto.btlm, main='Bayesian CART,', layout='surf') ################################################### ### chunk number 8: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 9: ################################################### moto.btgpllm <- btgpllm(X=X, Z=Z, bprior="b0", verb=0) moto.btgpllm.p <- predict(moto.btgpllm) ## using MAP ################################################### ### chunk number 10: btgp ################################################### par(mfrow=c(1,2)) plot(moto.btgpllm, main='treed GP LLM,', layout='surf') plot(moto.btgpllm.p, center='km', layout='surf') ################################################### ### chunk number 11: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 12: btgpq ################################################### par(mfrow=c(1,2)) plot(moto.btgpllm, main='treed GP LLM,', layout='as') plot(moto.btgpllm.p, as='ks2', layout='as') ################################################### ### chunk number 13: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() tgp/demo/sens.R0000644000176200001440000001060513531032535013065 0ustar liggesusers################################################### ### chunk number 1: ################################################### library(tgp) seed <- 0; set.seed(seed) ################################################### ### chunk number 2: ################################################### f <- friedman.1.data(250) ################################################### ### chunk number 3: ################################################### Xf <- f[, 1:6] Zf <- f$Y sf <- sens(X=Xf, Z=Zf, nn.lhs=600, model=bgpllm, verb=0) ################################################### ### chunk number 4: ################################################### names(sf$sens) ################################################### ### chunk number 5: sens-full ################################################### plot(sf, layout="sens", legendloc="topleft") ################################################### ### chunk number 6: ################################################### graphics.off() ################################################### ### chunk number 7: sens-mains ################################################### par(mar=c(4,2,4,2), mfrow=c(2,3)) plot(sf, layout="sens", maineff=t(1:6)) ################################################### ### chunk number 8: ################################################### graphics.off() ################################################### ### chunk number 9: sens-indices ################################################### plot(sf, layout="sens", maineff=FALSE) ################################################### ### chunk number 10: ################################################### graphics.off() ################################################### ### chunk number 11: ################################################### X <- airquality[,2:4] Z <- airquality$Ozone rect <- t(apply(X, 2, range, na.rm=TRUE)) mode <- apply(X , 2, mean, na.rm=TRUE) shape <- rep(2,3) ################################################### ### chunk number 12: sens-udraw ################################################### Udraw <- lhs(300, rect=rect, mode=mode, shape=shape) par(mfrow=c(1,3), mar=c(4,2,4,2)) for(i in 1:3){ hist(Udraw[,i], breaks=10,xlab=names(X)[i], main="",ylab="", border=grey(.9), col=8) } ################################################### ### chunk number 13: ################################################### graphics.off() ################################################### ### chunk number 14: ################################################### s.air <- suppressWarnings(sens(X=X, Z=Z, nn.lhs=300, rect=rect, shape=shape, mode=mode, verb=0)) ################################################### ### chunk number 15: sens-air1 ################################################### plot(s.air, layout="sens") ################################################### ### chunk number 16: ################################################### graphics.off() ################################################### ### chunk number 17: ################################################### rect[2,] <- c(0,5) mode[2] <- 2 shape[2] <- 2 ################################################### ### chunk number 18: ################################################### sens.p <- suppressWarnings(sens(X=X,Z=Z,nn.lhs=300, model=NULL, rect=rect, shape=shape, mode=mode)) ################################################### ### chunk number 19: sens-air2 ################################################### s.air2 <- predict(s.air, BTE=c(1,1000,1), sens.p=sens.p, verb=0) plot(s.air2, layout="sens") ################################################### ### chunk number 20: ################################################### graphics.off() ################################################### ### chunk number 21: ################################################### X$Temp[X$Temp >70] <- 1 X$Temp[X$Temp >1] <- 0 rect <- t(apply(X, 2, range, na.rm=TRUE)) mode <- apply(X , 2, mean, na.rm=TRUE) shape <- c(2,2,0) s.air <- suppressWarnings(sens(X=X, Z=Z, nn.lhs=300, rect=rect, shape=shape, mode=mode, verb=0, basemax=2)) ################################################### ### chunk number 22: sens-air3 ################################################### plot(s.air, layout="sens") ################################################### ### chunk number 23: ################################################### graphics.off() tgp/demo/exp.R0000644000176200001440000000605613531032535012716 0ustar liggesusers################################################### ### chunk number 1: ################################################### library(tgp) library(maptree) ##options(width=65) seed <- 0; set.seed(seed) ################################################### ### chunk number 2: ################################################### exp2d.data <- exp2d.rand() X <- exp2d.data$X; Z <- exp2d.data$Z XX <- exp2d.data$XX ################################################### ### chunk number 3: ################################################### exp.bgp <- bgp(X=X, Z=Z, XX=XX, corr="exp", verb=0) ################################################### ### chunk number 4: bgp ################################################### plot(exp.bgp, main='GP,') ################################################### ### chunk number 5: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 6: ################################################### exp.btgp <- btgp(X=X, Z=Z, XX=XX, corr="exp", verb=0) ################################################### ### chunk number 7: btgp ################################################### plot(exp.btgp, main='treed GP,') ################################################### ### chunk number 8: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 9: btgptrees ################################################### tgp.trees(exp.btgp) ################################################### ### chunk number 10: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 11: ################################################### exp.btgpllm <- btgpllm(X=X, Z=Z, XX=XX, corr="exp", R=2) ################################################### ### chunk number 12: btgpllm ################################################### plot(exp.btgpllm, main='treed GP LLM,') ################################################### ### chunk number 13: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 14: 1dbtgpllm1 ################################################### plot(exp.btgpllm, main='treed GP LLM,', proj=c(1)) ################################################### ### chunk number 15: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 16: 1dbtgpllm2 ################################################### plot(exp.btgpllm, main='treed GP LLM,', proj=c(2)) ################################################### ### chunk number 17: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() tgp/demo/00Index0000644000176200001440000000161113531032535013121 0ustar liggesuserslinear Bayesian LM and GP LLM on linear data from vignette 1 sin Bayesian linear CART, GP, treed GP on sinusoidal data from vignette 1 exp Bayesian GP, treed GP, and treed GP LLM on exponential data from vignette 1 moto Bayesian GP, treed GP, and treed GP LLM on motorcycle accident data from vignette 1 fried Bayesian linear CART and GP LLM on first Friedman data from vignette 1 as adaptive sampling on exponential data from vignette 1 traces demonstration, visualization and interpretation of parameter traces from vignette 1 pred example of a collaborative tgp with predict.tgp from vignette 1 cat using tgp with categorical (i.e., non-real-valued) inputs from vignette 2 sens sensitivity analysis for inputs/covariates from vignette 2 optim sequential optimization of black-box functions from vignette 2 it importance tempering improved mixing in the RJ-MCMC for tgp from vignette 2 tgp/demo/as.R0000644000176200001440000000435313531032535012523 0ustar liggesusers################################################### ### chunk number 1: ################################################### library(tgp) library(maptree) #options(width=65) seed <- 0; set.seed(seed) ################################################### ### chunk number 2: ################################################### exp2d.data <- exp2d.rand(lh=0, dopt=10) X <- exp2d.data$X Z <- exp2d.data$Z Xcand <- lhs(1000, rbind(c(-2,6),c(-2,6))) ################################################### ### chunk number 3: ################################################### exp1 <- btgpllm(X=X, Z=Z, pred.n=FALSE, corr="exp", verb=0) ################################################### ### chunk number 4: mapt ################################################### tgp.trees(exp1) ################################################### ### chunk number 5: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 6: ################################################### XX <- tgp.design(200, Xcand, exp1) XX <- rbind(XX, c(-sqrt(1/2),0)) ################################################### ### chunk number 7: cands ################################################### plot(exp1$X, pch=19, cex=0.5) points(XX) mapT(exp1, add=TRUE) ################################################### ### chunk number 8: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 9: ################################################### exp.as <- btgpllm(X=X, Z=Z, XX=XX, corr="exp", improv=TRUE, Ds2x=TRUE, verb=0) ################################################### ### chunk number 10: expas ################################################### par(mfrow=c(1,3), bty="n") plot(exp.as, main="tgpllm,", layout="as", as="alm") plot(exp.as, main="tgpllm,", layout='as', as='alc') plot(exp.as, main="tgpllm,", layout='as', as='improv') ################################################### ### chunk number 11: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() tgp/demo/pred.R0000644000176200001440000000431013531032535013043 0ustar liggesusers################################################### ### chunk number 1: ################################################### library(tgp) library(maptree) ##options(width=65) seed <- 0; set.seed(seed) ################################################### ### chunk number 2: ################################################### library(MASS) out <- btgpllm(X=mcycle[,1], Z=mcycle[,2], bprior="b0", pred.n=FALSE, verb=0) save(out, file="out.Rsave") out <- NULL ################################################### ### chunk number 3: ################################################### load("out.Rsave") XX <- seq(2.4, 56.7, length=200) out.kp <- predict(out, XX=XX, pred.n=FALSE) ################################################### ### chunk number 4: ################################################### out.p <- predict(out, XX=XX, pred.n=FALSE, BTE=c(0,1000,1)) ################################################### ### chunk number 5: ################################################### out2 <- predict(out, XX, pred.n=FALSE, BTE=c(0,2000,2), krige=FALSE) ################################################### ### chunk number 6: kp ################################################### plot(out.kp, center="km", as="ks2") ################################################### ### chunk number 7: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 8: p ################################################### plot(out.p) ################################################### ### chunk number 9: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 10: 2 ################################################### plot(out2) ################################################### ### chunk number 11: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 12: ################################################### unlink("out.Rsave") tgp/demo/sin.R0000644000176200001440000000457413531032535012716 0ustar liggesusers################################################### ### chunk number 1: ################################################### library(tgp) ##options(width=65) seed <- 0; set.seed(seed) ################################################### ### chunk number 2: ################################################### X <- seq(0,20,length=100) XX <- seq(0,20,length=99) Z <- (sin(pi*X/5) + 0.2*cos(4*pi*X/5)) * (X <= 9.6) lin <- X>9.6; Z[lin] <- -1 + X[lin]/10 Z <- Z + rnorm(length(Z), sd=0.1) ################################################### ### chunk number 3: ################################################### sin.bgp <- bgp(X=X, Z=Z, XX=XX, verb=0) ################################################### ### chunk number 4: bgp ################################################### plot(sin.bgp, main='GP,', layout='surf') ################################################### ### chunk number 5: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 6: ################################################### sin.btlm <- btlm(X=X, Z=Z, XX=XX) ################################################### ### chunk number 7: btlm ################################################### plot(sin.btlm, main='Linear CART,', layout='surf') ################################################### ### chunk number 8: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 9: btlmtrees ################################################### tgp.trees(sin.btlm) ################################################### ### chunk number 10: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() ################################################### ### chunk number 11: ################################################### sin.btgp <- btgp(X=X, Z=Z, XX=XX, verb=0) ################################################### ### chunk number 12: btgp ################################################### plot(sin.btgp, main='treed GP,', layout='surf') ################################################### ### chunk number 13: ################################################### rl <- readline("press RETURN to continue: ") graphics.off() tgp/README0000644000176200001440000000414313531032535011726 0ustar liggesusersThis is the R-package: tgp. It has been tested on Linux, FreeBSD, OSX, and Windows. This README is a sub. Please see the R-package documentation or vignette for more information. It should be possible to install this source package via "R CMD INSTALL tgp", where "tgp" is this directory, from "../". Below are some comments on compiling with support for pthreads, and linking with ATLAS, or other linear algebra library (different than the one already used by R). SUPPORT FOR PTHREADS -------------------- 1.) Add "-DPARALLEL" to PKG_CXXFLAGS of src/Makevars 2.) You may need to add "-pthread" to PKG_LIBS of src/Makevars, or whatever is needed by your compiler in order to correctly link code with pthreads functions. SUPPORT FOR ATLAS ----------------- ATLAS is supported as an alternative to standard BLAS and LAPACK for fast, automatically tuned, linear algebra routines. There are three easy steps to enable ATLAS support (assuming, of course, you have already installed it -- http://math-atlas.sourceforge.net) which need to be done before you install the package from source: Note that this is not the recommended method for getting fast linear algebra routines for tgp. The best way to do this is to compile R with ATLAS (or other libraries) support. See the R installation manual: http://cran.r-project.org/doc/manuals/R-admin.html under A.2.2 -- Begin ATLAS Instructions 1.: Edit src/Makevars. Comment out the existing PKG_LIBS line, and replace it with: PKG_LIBS = -L/path/to/ATLAS/lib -llapack -lcblas -latlas you may need replace "-llapack -lcblas -latlas" with whatever ATLAS recommends for your OS. (see ATLAS README.) For example, if your ATLAS compilation included F77 support, you would might need to add "-lF77blas", of if you compiled with pthreads, you would might use "-llapack -lptcblas -lptf77blas -latlas". 2.: Continue editing src/Makevars. Add: PKG_CFLAGS = -I/path/to/ATLAS/include 3.: Edit src/linalg.h and commend out lines 40 & 41: /*#define FORTPACK #define FORTBLAS*/ --- End ATLAS Instructions -- Reverse the above instructions to disable ATLAS. Don't forget to re-install. tgp/ChangeLog0000644000176200001440000003663413726652677012657 0ustar liggesusers2.4-17 (11 Sep 2020) ------ Fixed clang-11 issue with linalg.h and CXX headers pointed out by Brian 2.4-16 (05 Sep 2020) ------ put all btgp and tgp.design examples in donttest 2.4-15 (02 Sep 2020) ------ updated for modern R requirements implemented drop=FALSE in tgp.partition for Jan simplified BLAS and Lapack headers in linalg.c/.h for monomvn now using R_PosInf and R_NegInf 2.4-14 (06 Feb 2016) ------ forgot to do compact vignettes 2.4-13 (06 Feb 2016) ------ removed Rinterface.h; not sure where it came from 2.4-12 (05 Feb 2016) ------ new web page on bobby.gramacy.com, and title case moved R.h and Rmath.h outside of rhelp.h to be compatible with new C++ headers inside of newest R removed beta functionality comment from old vignette 2.4-11 (28 November 2014) ------ removed akima from package 2.4-10 (27 November 2014) ------ added mean0.range1 to NAMESPACE for use in the plgp package cleaned up some warnings in new pedantic gcc compile moved akima and maptree to Imports 2.4-9 (01 April 2013) ----- Changed printed tables to 15 digits to comply with new read.table checks removed zzz.R and moved LICENSE to License global exp2d and data call made fancy to pass checks 2.4-8 (13 Oct 2012) ----- fixed bimprov/improv bug overlooked in NULL issue updates removeed bessel_k.c and assocated functions; now using built-in bessel_k_ex function which didn't exist before 2.4-7 (18 April 2012) ----- fixed NULL issue in lh_sample 2.4-6 (14 April 2012) ----- Added check that E divides T-B Corrected bug in slice grid causing overflow Corrected NULL problems pointed out by BR 2.4-5 (30 January 2012) ----- fixes to vigneetes after NAMESPACE change, and removing direct references to stdout and stderr 2.4-4 (23 January 2012) ----- Added NAMESPACE file 2.4-3 (18 December 2011) ----- Checked for assert problems with NDEBUG and updated R version (2.14) and email addresses 2.4-2 (30 March 2011) ----- added dp.sim to tgp.default.params so that MVN proposal covariance matrix can be specified by the user in GP-SIM models 2.4-1 (23 Feb 2011) ----- Changed my_r_process_events to always ProcessEvents and check for interrupts (every second) Made new sobol_indices function to clean up tgp::Sens, and using shape to drive categorical calculations rather than bmax minor edit to tgp2 doc to correct fried.bool description, and edit to fried.bool to fix fried.bool(1) problem 2.4 (20 Sept 2010) --- added sim (single index model) rank 1 correlation structure overlooked fixing nugget in treed split proposals; now fixed 2.3-4 (19 July 2010) ----- allowed the entire $tree component from tgp.default.params to be written over by the tree argument to b* functions fixed a bug in the linear initialization of correlation functions (for non-LLM models) 2.3-3 (23 April 2010) ----- fixed another bug pointed out by Ripley 2.3-2 (21 April 2010) ----- replace isinf by R_FINITE as suggested by Brian Ripley 2.3-1 (8 Feb 2010) ----- Added reference to second JSS paper 2.3 (23 Dec 2009) --- final version of the tgp2 vignette, accepted at JSS removed mrtgp documentation 2.2-4 (20 Nov 2009) ----- added a check for a full rank design matrix in the pre-processing of inputs corrected some syntax errors in .Rd files caught by new checks on CRAN changed sens warning to check for nn > 0 instead of null XX which was causing a warning to be printed every time regardless of whether or not there was a violation 2.2-3 (22 Jul 2009) ----- added nug.p=0 option to cause the nugget to stay fixed at the params$gd[1] value. bcart, btlm, and blm now automatically use nug.p=0 since the nugget is not identified in these models 2.2-2 (27 May 2009) ----- caught a signifigant typo/bug in Xsplit pre-processing in R which was causing the bounding rectangle to be computed improperly removed combinat dependency 2.2-1 (20 Feb 2009) ----- added Tree::Clear() to rejected prunes in Tree::Prune() tgp.default.params and tgp.check.params now allow the min partition size to depend on basemax rather than d the bounding rectangle and the valid tree-split locations are now governed by an Xsplit automatically generated in the tgp R function, and gathered from the tgp object in predict.tgp 2.2 (16 Jan 2009) --- added lower bound for s2_g0, and added DEFAULT CPP macros to help prevent assertions which would have backed out of bad parameterizations anyways. This more liberal approach essentially prevents assertions in the no-noise regression case now allow basemax != d for constant mean functions added categorical LHS for sensitivity analyses finished draft of second vignette, to be submitted to JSS 2.1-6 (25 Nov 2008) ----- caught important bug in b0-prior pre-processing in R that was causing the emperical Bayes prior to be used when the b0 hierarchical one is requested 2.1-5 (24 Oct 2008) ----- added check for >= d+1 unique rows of X in Tree::Singular changed how d an nug are printed in the progress meter for mrtgp added par(mfrow=c(1,1)) to default 1-d mrtgp plots 2.1-4 (17 Oct 2008) ----- made it possible to cap the number of input locations which are ranked by the expected improvement statistic by allowing the improv argument to b* functions to take a 2-vector input. Also no longer ranks points with an improvement statistic of zero 2.1-3 (7 Oct 2008) ----- added check for >1 unique Z in Tree::Singular allow (undocumented) specification of minpart through the ellipses (...) argument to the b* functions m0r1=TRUE is now the default for all b* functions, the Rnw documentation has been updated (but the pdfs have not been regenerated in the current version) 2.1-2 (17 April 2008) ----- introduced params$Wi and made it so that params${b,Wi} set both the starting an prior values for the corresponding parameters. added bprior="bmznot" so that tau2 can be fixed at its starting value 2.1-1 (4 April 2008) ----- separaing tcounts and cum_tcounts and resetting tcounts to the average of cum_tcounts at beginning of each round fixed bug in returning of tcounts back to R by encuring that its->UpdateProbs() is always called after the last of R rounds whenever its->Numit() > 1 return ess information at each inverse temperature back to R for storage in the tgp-class object 2.1 (22 March 2008) --- moved CHANGES to ChangeLog for the new CRAN packages page cleaned up tgp vignette into one .Rnw file including several .iRnw files added linear=FALSE to akima interp commands stopped printing both separate ess and essN in IT method added new itemps.barplot function for visualizing the number of visits to each inverse temperature in the ST-MCMC chain now tcounts (observation counts) for IT are accumulated across repeats (R>=2) -- not sure if this is a good idea now recording tree acceptance rates (Grow, Prune Change and Swap accepts over total) propogated splitmin to up to the R interface, and added a basemax paramter also specifiable in the R inferface -- the parameters allow control of which X colums can be partitioned upon (by the tree) and which appear in the base (GP) model added heights="map" argument to tgp.trees for plotting only the tree corresponding to the maximum a' posteriori tree wrote two sections in the new vignette (tgp2): one on splitmin and basemax (i.e., categorical inputs) and one on importance tempering 2.0-4 (23 Jan 2008) ----- made a change suggested by Andrea Spano to make the partition function more robust when new X values (on a different range from the original data) are provided 2.0-3 (27 Dec 2007) ----- commented the moving average code (for sens) and made it more efficient 2.0-2 (12 Dec 2007) ----- allow mode in the sens function to be be within the bounds of rect -- i.e., stop checking for positive mode fixed dyslexic error in man page for sens describing total effect indices fixed missing braces in some .Rd files shortened to LGPL in DESCRIPTION 2.0-1 (1 Oct 2007) ----- Memory savings: preds->ZZ and preds->Zp only allocated when pred.n=TRUE, preds->w and preds->itemp only allocated when ST or IT or IS corrected default.itemps() example barplot and changed k.min to 0.1 to agree with IT paper fixed zcov bug in tgp.postprocess 2.0 (21 Sept 2007) --- consolidated R functions from individual files into those grouped by task made gridlen argument a 2-vector so the grid size can be specified in both x and y new economy argument to tree and Base duplicators so that the entire set of covariance matrices is not copied unless necessary Matt Taddy officially joins the list of authors, adding multi-resolution tgp and sensitivity analysis importance tempering, with importance sampling and simulated tempering support Latin hypercube sampling with respect to a Beta distribution moved most of the reading of parameters out of the Tgp constructor and into Tgp::Init so that tgp_cleanup() can safely delete the Tgp module even it it wasn't successfully initialized ordered multiple improv statistics predictive covariances now calculated instead of variances 1.2-7 (19 Aug 2007) ----- tgp.partition 1-d data handling made more robust removed assertion on w that tends to fail for unknown reasons 1.2-6 (17 June 2007) ----- added number of leaves to traces fixed CART bug in Gp::predict that was already handled in v1.3, thanks to Taddy, but was bad in the CRAN version 1.2-5 (29 May 2007) ----- allowing btgp to do a linburn $parts is a now a matrix, and $linburn now {TRUE,FALSE} $tree and $hier removed from tgp-class output, and $trace correctly removed when input trace=FALSE got rid of some hanging code fragments in documentation of btgp and dopt.gp 1.2-4 (07 May 2007) ----- fixed a leak when krige=FALSE appearing in Tree::Predict fixed sub-vignette cutting for preds and traces corrected documentation of nug.p in tgp.default.params() added verbosity and iter arguments to dopt and thus dopt.gp and tgp.design 1.2-3 (09 Apr 2007) ----- updates to the vignette for the JSS publication check.matrix modified to allow one-column matrix Z arguments which have column-name information tgp.trees calculation of rows and columns corrected for situations when there is a height 1 tree 1.2-2 (19 Dec 2006) ----- slice.interp bugs fixed (is.null(NULL) and plotting of axis labels) and tick marks added added R argument to predict.tgp and changed the krige argument to be called MAP added new krige argument to b* and predict.tgp to allow the user to control whether Z*k* kriging samples are to be obtained (possibly saving on memory) bug involving the order of trees read from files in the tgp.get.trees function is fixed; as a result the $trees output field in "tgp"-class objects is listed by height and so may contain NULL entries documented plot.tgp and predict.tgp with the method markup 1.2-1 (03 Dec 2006) ----- Added "cart-" option to bprior in order to allow a CART style mean rather than a LM mean 1.2 (21 Nov 2006) --- Now allowing BTE[2]-BTE[1] % BTE[3] != 0 Added predict.tgp and necessary functionality to save and load in MAP tgp model for later prediction Corrected par calculation in tgp.trees for non-default which argument when there is an unprinted height 1 tree Traces not recorded for linarea, parts, and ego, when they are off or fixed to unchanging settings Fixed EGO calculations; now calling them "improv", made them thread-safe, and added improv samples to traces Also now renamed ds2x to Ds2x, and made Ds2x (i.e., ALC) calculations thread-safe Ellipses to b* function allow other params arguments to be passed to replace defaults in tgp.default.params() Added traces of hierarchical parameters, and all predictive summaries (including kriging means and vars) Initial implementation of Importance Tempering idea Calculating variances of predictive distribution, and saving kriging means and variances Fixed numPrunable (P+1) calculation in grow attempts EGO calculations made thread-safe 1.1-11 (20 Sept 2006) ------ Bad compilation flags caused bad bug in log_HierPrior to go unnoticed until assertion failure on Windows 1.1-10 (19 Sept 2006) ------ Fixed big compute_ego() bug Tweaks to RNG seeds so that they give same sequence across platforms (tested on OSX/PB & Linux/Xeons) Allow X=NULL in dopt.gp() Removal of constants LOG_2_PI covered by R internal M_LOG_SQRT_2PI Added mvnpdf_log_dup and wishpdf_log functions Corrected full log-pdf function for tree prior, and added log-pdf of W and B0 1.1-9 (03 Sept 2006) ----- Many comments added in predict[_linear].c and exp_sep.cc Fixed ds2x (predict_linear) memory leak Fixed Matern bug -- now using correct pwr=1 distance computation; added comments to gen_covar.c Compilation warnings addressed in update of compat- ibility with C/C++ adaptive sampling (as) code Now getting BestPartitions from Tgp instead of at the end of Model::Rounds 1.1-8 (29 Aug 2006) ----- Added trace capability for Matern corr family Fixed bug that num_consumed is not updated on final NULL read from tlist Using new log_bessel_k() function to bypass allocs of floor(nu)+1 double each time bessel_k() was called 1.1-7 (23 Aug 2006) ----- Added the ability to get traces of all parameters, except the hierarchical ones Fixed bug to undo.m0r1 so that quantile differences don't have the mean subtracted out twice Changes to allow "..." arguments to mapT, and plotting of 2-d slices of input locations Minor fix to do params->Print() within model->Print(). Begin addition of mr_tgp, by Matt Taddy. When these changes are complete, we should be moving to version 2.0 1.1-6 (26 Jun 2006) ----- Added Latin Hypercube design function Added "mapT" function for stand-alone plotting of MAP partitions via projection and slice. Fixed bug in "tgp.plot.slice" in the process Also now calling "tgp.get.partitions" by the shorter name "partition" 1.1-5 (27 May 2006) ----- Fixed memory leak with RNG state in predict_consumer Solved -DPARALLEL adaptive sampling mystery exp2d.rand now returns more information about responses including ZZ, Ztrue, and ZZtrue 1.1-4 (22 May 2006) ----- Instructions for compiling with Pthreads. Got rid of duplicate printing of d[a,b] in tgp header. Added verb arguments to specify how verbose the R-console printing should be be. 1.1-3: (16 Apr 2006) ------ Necessary changes in order to get read_ctrlfile to work for the command-line (non-R) interface to tgp, and other minor changes. Noticed bug for bcart and b0tau options due to bad T- matrix initialization -- fixed. 1.1-2: (04 Mar 2006) ------ 1. Beta version of Matern correlation function working (abiet a bit shakily) 2. Tgp class and cleanup function now implemented in order to let tgp be interrupted, and then clean up to avoid memory leaks "on.exit()" 1.1-1: (26 Feb 2006) ------ Minor edits to documentation. 1.1: (22 Feb 2006) ---- 1. Modularization overhall of C/C++ code for passing to Matt Taddy, who will be responsible for such future additions as Matern correlation functions, and multi- resolution GP implementations. 2. Plotting enhancements, including 1-d projections and (now default) loess interpolation for 2-d surfaces and projections, plotting of ALC & EGO statistics, and ability to control plot layout to show mean surface, error surface, or both. 3. URL/Email now to UCSC/AMS address. 1.0-2: (Dec 2005) ------ 1. Wrote generic random deviate function which can use unif_rand(), randomkit, and erand48. 2. Fixed up some documentation bugs and typos. 3. system command in model.cc no longer calls "rm" which doesn't work on Windows. 1.0-1: (Dec 2005) ------ 1. No longer using erand48; using unif_rand() from R for Windows compatibility. tgp/data/0000755000176200001440000000000013531032535011755 5ustar liggesuserstgp/data/exp2d.rda0000644000176200001440000001646113726670364013515 0ustar liggesusers՛yޟZg?xJJRRR2Rr?~d~RQ ^FIIjGG[4 \cѿO S AɟL3~p8,igv[L]Iݥdl?'Hp$Kf\^$<%#v}u1/n~m,2w.G/n]q~u}O?OJ>wo[y%+ |$ɋ.v=$->]ϞZSK>%_zlygR=zRݞZ~b졥{l)۽=Y}/׫yiVz;ȇ7"祷OD+hd=]7 8*8Y$MSg{vz`7Ϙ ~>7_FE|sggM͇Զ.q\2#6>ΩjYBBd).rエ=K.''QCrW@*i6QƖ[ACPWV [utWwb`ѥhKW_٣ϔjHj+Q8)h¹={ӑNWXTw 8)Z-cl5;P%MvoE'3>GT%.}j>jRiR"kgYu4ʗڢtG ~BY(^pBqT/%uΫw Zwǯs1AQȴ+9z,E[æj`3<jmkŗLS|e_ ߝQoQþƣѕO; y(^ eқ'" pWEtPnqlZ0s}T휟 q5bv fPi(4M7v?a<4vQV͕V?R_[7 \#y= 3pڣz70E &B:hKW-E8U\SilV-sr|䖴*h'`~,x۷Ow_'VCLb *;>mSwL7}~#ܰ%SjQC_P͖FTo2u`Tf܆&f]޲%m0{~~l=$F& EY;][sM:rj'J9C(x|D[l8Xqo^1EFaAr/<1M%Q14t rf:9ܟ:8UF<\ӌsA5 &nF`Q9D*Sz{Bt&ģYrRi]ݾ9cy}iؖhcV<{۔̔^+ i4cꑽ¹e*a܏YR!*zc0G*?o;IziTSt71ӣcsBQZ΄l_TͶYG+vۆs,['rB ^EӰoAd64;mI%‹^ 5ߝW.zii9&;>]:~@4tř(osvk4vwfy@" \Rƫv9^Y(^Q]9)(sd{o:Z6'LӘ'CcNvˡR/LW_N.bqBUZ4m:ȥ~m^HAps>M|8n!͖/uLݴmr睑ޕ7 Ҍ0'gc>|-[u2>WboC&a٧ކz`5i t"G6E hǼUF@wLDnR ثن ? v|uAˣR i5r KSܰIt΁QX8驃F#_# <#9LsDT}Մ}(LV[]w/cC."|)T9 ]ьܶN5b䰦cAsNIV@R_mOF-Ϛ#wK6]=ml/UI},Ey_ݩgUy^ :tjlFzp<|lE#,+ n/NsnCK>=X]}jRFa5~֠ ႔4xi{γ )J#rN1(Ǯ7>L]ԋilk{vm\Ty <u̻ 7Mx'k:ԪbcӧF!A[!׻"@mC^)4)K^ 4#1h b/#Ķ6zl2G{v  3cت&{S.,LW`Jry$p7pIiu7U:gUDrH>8jcm׳s8Yd2d4jfd@$k0r*V{Do.V] vs½-:%`ǁtdd4$):mW88yyl\c皥^J'tth y`6{Kr֧ge9U|:S%ۉ@{E8ۑ@JPgĭo֞[|Ec~?d򬴺1[:nzfeO}hKH95<E}w=UN~8>z{ hKu olbJw^j1y,&;쎎I|- zquj\2 7$?lg;"\~yPTpRfV42`Fs SK_=|h@Wϧ2gW̘)._8D{wHQƿ|uGqa8( |w*ÍWӕVmfdiGLČG|(Kt7צ=P}ϓt&ǯ՚[D𭴔Օw/ekV?݄ګnw/vq"f>f__?_?9{oϜ;v~A'b?7}oH70+wWOXKyS4}!>bc}M6?~y_~8J׍V)cW]jZhFsqMVD:iBSJ(* ;C0'I-e44+\ĺu?|8G&]Ui[ӎO3U?Mg k5ѾSL 7Q?}|ꊳ8ұ*{ؑ89Bvі5 KE:܄e vy5tNf,yNI%i͌yM[x/Afbo^ə΋D7TuE6%4 %G <7#~[6aKecNR(=]<:mfc4N3if<'2p܅Dqiwފ.zkD:BEnDdLdag˺,vw'ypkZdJ8*J~WƠWni{(>Խl-1ui43^'.X>s&[Cg/]Qj[ؖ^uC{N]w3x13xs,wЩ.V߬#2ҾKY;uh+p{̀+M2E )%2^?ol X<-;Js}#zmb/f|Oy=Nhiy-D >hI3ޥpN~'TҷfQ󆚢қ Їǟ+sJOoS3LxaU,m^eGף_lMZ8pn~E?52flD0d%&pn"4?*, "d3,rII@I$J$KLو(3H6؈F\6X2A e,` X2A e,d$ Y2HA eP,bˠX2(A eP,baaaaa\e\e\e\e\e 0} minimum parameter \code{t1 >= 0} and maximum parameter \code{t1 >= 0}, where \code{t1 + t2 <= 1} specifies \deqn{p(b|d)=t_1 +\exp\left\{\frac{-g(t_2-t_1)}{d-0.5}\right\}}{p(b|d)= t1 + exp(-g*(t2-t1)/(d-0.5))}} \item{corr}{ Gaussian process correlation model. Choose between the isotropic power exponential family (\code{"exp"}) or the separable power exponential family (\code{"expsep"}, default); the current version also supports the isotropic Matern (\code{"matern"}) and single-index Model (\code{"sim"}) as \dQuote{beta} functionality. % The option \code{"mrexpsep"} assumes % within each partition a version of % the multi-resolution stationary GP model described in Kennedy and O'Hagan % (2000). To use this option, the first column of the design % matrices \code{X} and \code{XX} must contain an indicator for % 'fine' (1) or 'coarse' (0) fidelity. \code{"mrexpsep"} is only % available with the \code{btgp} and \code{bgp} models, and % \code{linburn=TRUE} is not allowed. % See details below. } \item{BTE}{ 3-vector of Monte-carlo parameters (B)urn in, (T)otal, and (E)very. Predictive samples are saved every E MCMC rounds starting at round B, stopping at T. } \item{R}{ Number of repeats or restarts of \code{BTE} MCMC rounds, default \code{R=1} is no restarts} \item{m0r1}{If \code{TRUE} (default) the responses \code{Z} will be scaled to have a mean of zero and a range of 1} \item{linburn}{If \code{TRUE} initializes MCMC with \code{B} (additional) rounds of Bayesian Linear CART (\code{btlm}); default is \code{FALSE} } \item{itemps}{ Importance tempering (IT) inverse temperature ladder, or powers to improve mixing. See \code{\link{default.itemps}}. The default is no IT \code{itemps = NULL}} \item{pred.n}{\code{TRUE} (default) value results in prediction at the inputs \code{X}; \code{FALSE} skips prediction at \code{X} resulting in a faster implementation} \item{krige}{\code{TRUE} (default) value results in collection of kriging means and variances at predictive (and/or data) locations; \code{FALSE} skips the gathering of kriging statistics giving a savings in storage} \item{zcov}{If \code{TRUE} then the predictive covariance matrix is calculated-- can be computationally (and memory) intensive if \code{X} or \code{XX} is large. Otherwise only the variances (diagonal of covariance matrices) are calculated (default). See outputs \code{Zp.s2}, \code{ZZ.s2}, etc., below} \item{Ds2x}{\code{TRUE} results in ALC (Active Learning--Cohn) computation of expected reduction in uncertainty calculations at the \code{XX} locations, which can be used for adaptive sampling; \code{FALSE} (default) skips this computation, resulting in a faster implementation} \item{improv}{\code{TRUE} results in samples from the improvement at locations \code{XX} with respect to the observed data minimum. These samples are used to calculate the expected improvement over \code{XX}, as well as to rank all of the points in \code{XX} in the order that they should be sampled to minimize the expected multivariate improvement (refer to Schonlau et al, 1998). Alternatively, \code{improv} can be set to any positive integer 'g', in which case the ranking is performed with respect to the expectation for improvement raised to the power 'g'. Increasing 'g' leads to rankings that are more oriented towards a global optimization. The option \code{FALSE} (default) skips these computations, resulting in a faster implementation. Optionally, a two-vector can be supplied where \code{improv[2]} is interpreted as the (maximum) number of points to rank by improvement. See the note below. If not specified, the entire \code{XX} matrix is ranked. } \item{sens.p}{ Either \code{NULL} or a vector of parameters for sensitivity analysis, built by the function \code{\link{sens}}. Refer there for details} \item{nu}{ \dQuote{beta} functionality: fixed smoothness parameter for the Matern correlation function; \code{nu + 0.5} times differentiable predictive surfaces result} \item{trace}{ \code{TRUE} results in a saving of samples from the posterior distribution for most of the parameters in the model. The default is \code{FALSE} for speed/storage reasons. See note below } \item{verb}{ Level of verbosity of R-console print statements: from 0 (none); 1 (default) which shows the \dQuote{progress meter}; 2 includes an echo of initialization parameters; up to 3 and 4 (max) with more info about successful tree operations} \item{...}{ These ellipses arguments are interpreted as augmentations to the prior specification generated by \code{params <- \link{tgp.default.params}(ncol(X)+1)}. You may use these to specify a custom setting of any of default parameters in the output list \code{params} except those for which a specific argument is already provided (e.g., \code{params$corr} or \code{params$bprior}) or those which contradict the type of \code{b*} function being called (e.g., \code{params$tree} or \code{params$gamma}); these redundant or possibly conflicting specifications will be ignored. Refer to \code{tgp.default.params} for details on the prior specification} } \details{ The functions and their arguments can be categorized by whether or not they use treed partitioning (T), GP models, and jumps to the LLM (or LM) \tabular{lll}{ blm \tab LM \tab Linear Model \cr btlm \tab T, LM \tab Treed Linear Model \cr bcart \tab T \tab Treed Constant Model \cr bgp \tab GP \tab GP Regression \cr bgpllm \tab GP, LLM \tab GP with jumps to the LLM \cr btgp \tab T, GP \tab treed GP Regression \cr btgpllm \tab T, GP, LLM \tab treed GP with jumps to the LLM } Each function implements a special case of the generic function \code{tgp} which is an interface to C/C++ code for treed Gaussian process modeling of varying parameterization. Documentation for \code{tgp} has been declared redundant, and has subsequently been removed. To see how the \code{b*} functions use \code{tgp} simply examine the function. In the latest version, with the addition of the ellipses \dQuote{...} argument, there is nothing that can be done with the direct \code{tgp} function that cannot also be done with a \code{b*} function Only functions in the T (tree) category take the \code{tree} argument; GP category functions take the \code{corr} argument; and LLM category functions take the \code{gamma} argument. Non-tree class functions omit the \code{parts} output, see below \code{bcart} is the same as \code{btlm} except that only the intercept term in the LM is estimated; the others are zero, thereby implementing a Bayesian version of the original CART model The \code{sens.p} argument contains a vector of parameters for sensitivity analysis. It should be \code{NULL} unless created by the \code{sens} function. Refer to \code{help(sens)} for details. % If \code{corr="mrexpsep"} and the matrices X and XX are properly % formatted with an indicator first column (0='coarse', 1='fine'), % the stationary GP model fit within each partition has: % \deqn{ % Z_{\mbox{\tiny coarse}} \sim m(x) + \mbox{GP}(\sigma^2 + K_c) % }{ % Z[coarse] ~ 'meanfn' + GP(sigma^2 * K[c]) % } and % \deqn{ % Z_{\mbox{\tiny fine}} \sim Z_{\mbox{\tiny coarse}} + % \mbox{GP}(\sigma^2 \delta + K_f) % }{ % Z[fine] ~ Z_coarse + GP(sigma^2 * delta * K[f]) % } % Where each matrix \eqn{K_c}{K[c]} and \eqn{K_f}{K[f]} are based on the % same separable power exponential family plus a nugget effect that is % used for \code{corr="expsep"}. If \code{itemps =! NULL} then importance tempering (IT) is performed to get better mixing. After each restart (when \code{R > 1}) the observation counts are used to update the pseudo-prior. Stochastic approximation is performed in the first burn-in rounds (for \code{B-T} rounds, not \code{B}) when \code{c0} and \code{n0} are positive. Every subsequent burn-in after the first restart is for \code{B} rounds in order to settle-in after using the observation counts. See \code{\link{default.itemps}} for more details and an example Please see \code{vignette("tgp")} for a detailed illustration } \value{ \code{bgp} returns an object of class \code{"tgp"}. The function \code{\link{plot.tgp}} can be used to help visualize results. An object of class \code{"tgp"} is a list containing at least the following components... The \code{parts} output is unique to the T (tree) category functions. Tree viewing is supported by \code{\link{tgp.trees}} \item{X}{Input argument: \code{data.frame} of inputs \code{X}} \item{n}{Number of rows in \code{X}, i.e., \code{nrow(X)}} \item{d}{Number of cols in \code{X}, i.e., \code{ncol(X)}} \item{Z}{Vector of output responses \code{Z}} \item{XX}{Input argument: \code{data.frame} of predictive locations \code{XX}} \item{nn}{Number of rows in \code{XX}, i.e., \code{nrow(XX)}} \item{BTE}{Input argument: Monte-carlo parameters} \item{R}{Input argument: restarts} \item{linburn}{Input argument: initialize MCMC with linear CART} \item{params}{\code{list} of model parameters generated by \code{\link{tgp.default.params}} and subsequently modified according to the calling \code{b*} function and its arguments} \item{dparams}{Double-representation of model input parameters used by the C-code} \item{itemps}{\code{data.frame} containing the importance tempering ladders and pseudo-prior: \code{$k} has inverse inverse temperatures (from the input argument), \code{$k} has an \emph{updated} pseudo-prior based on observation counts and (possibly) stochastic approximation during burn-in and (input) stochastic approximation parameters \eqn{c_0}{c0} and \eqn{n_0}{n0}. See \code{\link{default.itemps}} for more info} \item{Zp.mean}{Vector of mean predictive estimates at \code{X} locations} \item{Zp.q1}{Vector of 5\% predictive quantiles at \code{X} locations} \item{Zp.q2}{Vector of 95\% predictive quantiles at \code{X} locations} \item{Zp.q}{Vector of quantile norms \code{Zp.q2-Zp.q1}} \item{Zp.s2}{If input \code{zcov = TRUE}, then this is a predictive covariance matrix for the inputs at locations \code{X}; otherwise then this is a vector of predictive variances at the \code{X} locations (diagonal of the predictive covariance matrix). Only appears when input \code{pred.n = TRUE}} \item{Zp.km}{Vector of (expected) kriging means at \code{X} locations} \item{Zp.vark}{Vector of posterior variance for kriging surface (no additive noise) at \code{X} locations} \item{Zp.ks2}{Vector of (expected) predictive kriging variances at \code{X} locations} \item{ZZ.mean}{Vector of mean predictive estimates at \code{XX} locations} \item{ZZ.q1}{Vector of 5\% predictive quantiles at \code{XX} locations} \item{ZZ.q2}{Vector of 95\% predictive quantiles at \code{XX} locations} \item{ZZ.q}{Vector of quantile norms \code{ZZ.q2-ZZ.q1}, used by the ALM adaptive sampling algorithm} \item{ZZ.s2}{If input \code{zcov = TRUE}, then this is a predictive covariance matrix for predictive locations \code{XX}; otherwise then this is a vector of predictive variances at the \code{XX} locations (diagonal of the predictive covariance matrix). Only appears when input \code{XX != NULL}} \item{ZpZZ.s2}{If input \code{zcov = TRUE}, then this is a predictive \code{n * nn} covariance matrix between locations in \code{X} and \code{XX}; Only appears when \code{zcov = TRUE} and both \code{pred.n = TRUE} and \code{XX != NULL}} \item{ZZ.km}{Vector of (expected) kriging means at \code{XX} locations} \item{ZZ.vark}{Vector of posterior variance for kriging surface (no additive noise) at \code{XX} locations} \item{ZZ.ks2}{Vector of (expected) predictive kriging variances at \code{XX} locations} \item{Ds2x}{If argument \code{Ds2x=TRUE}, this vector contains ALC statistics for \code{XX} locations} \item{improv}{If argument \code{improv} is \code{TRUE} or a positive integer, this is a 'matrix' with first column set to the expected improvement statistics for \code{XX} locations, and the second column set to a ranking in the order that they should be sampled to minimize the expected multivariate improvement raised to a power determined by the argument \code{improv}} \item{response}{Name of response \code{Z} if supplied by \code{data.frame} in argument, or "z" if none provided} \item{parts}{Internal representation of the regions depicted by partitions of the maximum a' posteriori (MAP) tree} \item{trees}{\code{list} of trees (\pkg{maptree} representation) which were MAP as a function of each tree height sampled between MCMC rounds \code{B} and \code{T}} \item{trace}{If \code{trace==TRUE}, this \code{list} contains traces of most of the model parameters and posterior predictive distributions at input locations \code{XX}. Otherwise the entry is \code{FALSE}. See note below} \item{ess}{Importance tempering effective sample size (ESS). If \code{itemps==NULL} this corresponds to the total number of samples collected, i.e.. \code{R*(BTE[2]-BTE[1])/BTE[3]}. Otherwise the ESS will be lower due to a non-zero coefficient of variation of the calculated importance tempering weights} \item{sens}{ See \code{\link{sens}} documentation for more details} } \references{ Gramacy, R. B. (2020) \emph{Surrogates: Gaussian Process Modeling, Design and Optimization for the Applied Sciences}. Boca Raton, Florida: Chapman Hall/CRC. (See Chapter 9.) \url{https://bobby.gramacy.com/surrogates/} Gramacy, R. B. (2008). \emph{\pkg{tgp}: An \R Package for Bayesian Nonstationary, Semiparametric Nonlinear Regression and Design by Treed Gaussian Process Models.} Journal of Statistical Software, \bold{19}(9). \url{https://www.jstatsoft.org/v19/i09} Robert B. Gramacy, Matthew Taddy (2010). \emph{Categorical Inputs, Sensitivity Analysis, Optimization and Importance Tempering with \pkg{tgp} Version 2, an \R Package for Treed Gaussian Process Models.} Journal of Statistical Software, \bold{33}(6), 1--48. \url{https://www.jstatsoft.org/v33/i06/}. Gramacy, R. B., Lee, H. K. H. (2007). \emph{Bayesian treed Gaussian process models with an application to computer modeling}. Journal of the American Statistical Association, 103(483), pp. 1119-1130. Also available as ArXiv article 0710.4536 \url{https://arxiv.org/abs/0710.4536} Gramacy, R. B. and Lee, K.H. (2008). \emph{Gaussian Processes and Limiting Linear Models.} Computational Statistics and Data Analysis, 53, pp. 123-136. Also available as ArXiv article 0804.4685 \url{https://arxiv.org/abs/0804.4685} Gramacy, R. B., Lee, H. K. H. (2009). \emph{Adaptive design and analysis of supercomputer experiments.} Technometrics, 51(2), pp. 130-145. Also avaliable on ArXiv article 0805.4359 \url{https://arxiv.org/abs/0805.4359} Robert B. Gramacy, Heng Lian (2011). \emph{Gaussian process single-index models as emulators for computer experiments}. Available as ArXiv article 1009.4241 \url{https://arxiv.org/abs/1009.4241} Chipman, H., George, E., \& McCulloch, R. (1998). \emph{Bayesian CART model search (with discussion).} Journal of the American Statistical Association, \bold{93}, 935--960. Chipman, H., George, E., \& McCulloch, R. (2002). \emph{Bayesian treed models.} Machine Learning, \bold{48}, 303--324. M. Schonlau and Jones, D.R. and Welch, W.J. (1998). \emph{Global versus local search in constrained optimization of computer models.} In "New Developments and applications in experimental design", IMS Lecture Notes - Monograph Series 34. 11--25. \url{https://bobby.gramacy.com/r_packages/tgp/} } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \note{ Inputs \code{X, XX, Z} containing \code{NaN, NA}, or \code{Inf} are discarded with non-fatal warnings Upon execution, MCMC reports are made every 1,000 rounds to indicate progress Stationary (non-treed) processes on larger inputs (e.g., \code{X,Z}) of size greater than 500, *might* be slow in execution, especially on older machines. Once the C code starts executing, it can be interrupted in the usual way: either via Ctrl-C (Unix-alikes) or pressing the Stop button in the \R-GUI. When this happens, interrupt messages will indicate which required cleanup measures completed before returning control to \R. Whereas most of the \pkg{tgp} models will work reasonably well with little or no change to the default prior specification, GP's with the \code{"mrexpsep"} correlation imply a very specific relationship between fine and coarse data, and a careful prior specification is usually required. The ranks provided in the second column of the \code{improv} field of a \code{tgp} object are based on the expectation of a multivariate improvement that may or may not be raised to a positive integer power. They can thus differ significantly from a simple ranking of the first column of expected univariate improvement values. Regarding \code{trace=TRUE}: Samples from the posterior will be collected for all parameters in the model. GP parameters are collected with reference to the locations in \code{XX}, resulting \code{nn=nrow{XX}} traces of \code{d,g,s2,tau2}, etc. Therefore, it is recommended that \code{nn} is chosen to be a small, representative, set of input locations. Besides GP parameters, traces are saved for the tree partitions, areas under the LLM, log posterior (as a function of tree height), and samples from the posterior predictive distributions. Note that since some traces are stored in files, multiple \code{tgp}/\R sessions in the same working directory can clobber the trace files of other sessions } \seealso{ \code{\link{plot.tgp}}, \code{\link{tgp.trees}}, \code{\link{predict.tgp}}, \code{\link{sens}}, \code{\link{default.itemps}}} \examples{ \donttest{ ## ## Many of the examples below illustrate the above ## function(s) on random data. Thus it can be fun ## (and informative) to run them several times. ## # # simple linear response # # input and predictive data X <- seq(0,1,length=50) XX <- seq(0,1,length=99) Z <- 1 + 2*X + rnorm(length(X),sd=0.25) out <- blm(X=X, Z=Z, XX=XX) # try Linear Model plot(out) # plot the surface # # 1-d Example # # construct some 1-d nonstationary data X <- seq(0,20,length=100) XX <- seq(0,20,length=99) Z <- (sin(pi*X/5) + 0.2*cos(4*pi*X/5)) * (X <= 9.6) lin <- X>9.6; Z[lin] <- -1 + X[lin]/10 Z <- Z + rnorm(length(Z), sd=0.1) out <- btlm(X=X, Z=Z, XX=XX) # try Linear CART plot(out) # plot the surface tgp.trees(out) # plot the MAP trees out <- btgp(X=X, Z=Z, XX=XX) # use a treed GP plot(out) # plot the surface tgp.trees(out) # plot the MAP trees # # 2-d example # (using the isotropic correlation function) # # construct some 2-d nonstationary data exp2d.data <- exp2d.rand() X <- exp2d.data$X; Z <- exp2d.data$Z XX <- exp2d.data$XX # try a GP out <- bgp(X=X, Z=Z, XX=XX, corr="exp") plot(out) # plot the surface # try a treed GP LLM out <- btgpllm(X=X, Z=Z, XX=XX, corr="exp") plot(out) # plot the surface tgp.trees(out) # plot the MAP trees # # Motorcycle Accident Data # # get the data require(MASS) # try a GP out <- bgp(X=mcycle[,1], Z=mcycle[,2]) plot(out) # plot the surface # try a treed GP LLM # best to use the "b0" beta linear prior to capture common # common linear process throughout all regions (using the # ellipses "...") out <- btgpllm(X=mcycle[,1], Z=mcycle[,2], bprior="b0") plot(out) # plot the surface tgp.trees(out) # plot the MAP trees } } \keyword{ nonparametric } \keyword{ nonlinear } \keyword{ smooth } \keyword{ models } \keyword{ regression } \keyword{ spatial } \keyword{ tree } \keyword{ optimize } tgp/man/exp2d.Rd0000644000176200001440000000446213724022642013140 0ustar liggesusers\name{exp2d} \alias{exp2d} \docType{data} \title{ 2-d Exponential Data } \description{ A 2-dimensional data set that can be used to validate non-stationary models. } \usage{data(exp2d)} \format{ A \code{data frame} with 441 observations on the following 4 variables. \describe{ \item{\code{X1}}{Numeric vector describing the first dimension of \code{X} inputs} \item{\code{X2}}{Numeric vector describing the second dimension of \code{X} inputs} \item{\code{Z}}{Numeric vector describing the response \code{Z(X)+N(0,sd=0.001)}} \item{\code{Ztrue}}{Numeric vector describing the true response \code{Z(X)}, without noise} } } \details{ The true response is evaluated as \deqn{Z(X)=x_1 * \exp(x_1^2-x_2^2).}{Z(X) = X1 * exp(-X1^2 -X2^2).} Zero-mean normal noise with \code{sd=0.001} has been added to the true response } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \references{ Gramacy, R. B. (2020) \emph{Surrogates: Gaussian Process Modeling, Design and Optimization for the Applied Sciences}. Boca Raton, Florida: Chapman Hall/CRC. \url{https://bobby.gramacy.com/surrogates/} Gramacy, R. B. (2007). \emph{\pkg{tgp}: An \R Package for Bayesian Nonstationary, Semiparametric Nonlinear Regression and Design by Treed Gaussian Process Models.} Journal of Statistical Software, \bold{19}(9). \url{https://www.jstatsoft.org/v19/i09} Robert B. Gramacy, Matthew Taddy (2010). \emph{Categorical Inputs, Sensitivity Analysis, Optimization and Importance Tempering with \pkg{tgp} Version 2, an \R Package for Treed Gaussian Process Models.} Journal of Statistical Software, \bold{33}(6), 1--48. \url{https://www.jstatsoft.org/v33/i06/}. Gramacy, R. B., Lee, H. K. H. (2008). \emph{Bayesian treed Gaussian process models with an application to computer modeling}. Journal of the American Statistical Association, 103(483), pp. 1119-1130. Also available as ArXiv article 0710.4536 \url{https://arxiv.org/abs/0710.4536} \url{https://bobby.gramacy.com/r_packages/tgp/} } \note{This data is used in the examples of the functions listed below in the \dQuote{See Also} section via the \code{\link{exp2d.rand}} function} \seealso{ \code{\link{exp2d.rand}}, \code{\link{exp2d.Z}}, \code{\link{btgp}}, and other \code{b*} functions} \keyword{datasets} \keyword{datagen} tgp/man/lhs.Rd0000644000176200001440000000476313723731514012714 0ustar liggesusers\name{lhs} \alias{lhs} \title{Latin Hypercube sampling} \description{ Draw a (random) Latin Hypercube (LH) sample of size \code{n} from in the region outlined by the provided rectangle } \usage{ lhs(n, rect, shape=NULL, mode=NULL) } \arguments{ \item{n}{ Size of the LH sample } \item{rect}{ Rectangle describing the domain from which the LH sample is to be taken. The rectangle should be a \code{matrix} or \code{data.frame} with \code{ncol(rect) = 2}, and number of rows equal to the dimension of the domain. For 1-d data, a vector of length 2 is allowed} \item{shape}{ Optional vector of shape parameters for the Beta distribution. Vector of length equal to the dimension of the domain, with elements > 1. If this is specified, the LH sample is proportional to a joint pdf formed by independent Beta distributions in each dimension of the domain, scaled and shifted to have support defined by \code{rect}. Only concave Beta distributions with \code{shape} > 1 are supported. } \item{mode}{ Optional vector of mode values for the Beta distribution. Vector of length equal to the dimension of the domain, with elements within the support defined by \code{rect}. If \code{shape} is specified, but this is not, then the scaled Beta distributions will be symmetric } } \value{ The output is a \code{matrix} with \code{n} rows and \code{nrow(rect)} columns. Each of the \code{n} rows represents a sample point. } \references{ Gramacy, R. B. (2020) \emph{Surrogates: Gaussian Process Modeling, Design and Optimization for the Applied Sciences}. Boca Raton, Florida: Chapman Hall/CRC. (See Chapter 4.) \url{https://bobby.gramacy.com/surrogates/} McKay, M. D., W. J. Conover and R. J. Beckman. (1979). \emph{A Comparison of Three Methods for Selecting Values of Input Variables in the Analysis of Output from a Computer Code}, Technometrics 21: (pp. 239--245). } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \note{The domain bounds specified by the rows of \code{rect} can be specified backwards with no change in effect.} \seealso{ \code{\link{tgp.design}}, \code{\link{dopt.gp}}, \code{\link{sens}} } \examples{ # get and plot a 2-d LH design s1 <- lhs(10, rbind(c(-2,3), c(0.5, 0.8))) plot(s1) # plot a grid to show that there is one sample # in each grid location abline(v=seq(-2,3,length=11), lty=2, col=3) abline(h=seq(0.5,0.8,length=11), lty=2, col=3) } \keyword{ design } \keyword{ spatial } tgp/man/friedman.1.data.Rd0000644000176200001440000000767413724022705014762 0ustar liggesusers\name{friedman.1.data} \alias{friedman.1.data} \alias{fried.bool} \title{ First Friedman Dataset and a variation } \description{ Generate X and Y values from the 10-dim \dQuote{first} Friedman data set used to validate the Multivariate Adaptive Regression Splines (MARS) model, and a variation involving boolean indicators. This test function has three non-linear and interacting variables, along with two linear, and five which are irrelevant. The version with indicators has parts of the response turned on based on the setting of the indicators } \usage{ friedman.1.data(n = 100) fried.bool(n = 100) } \arguments{ \item{n}{Number of samples desired} } \details{ In the original formulation, as implemented by \code{friedman.1.data} the function has 10-dim inputs \code{X} are drawn from Unif(0,1), and responses are \eqn{N(m(X),1)}{N(m(X),1)} where \eqn{m(\mathbf{x}) = E[f(\mathbf{x})]}{m(X) = E[f(X)]} and \deqn{m(\mathbf{x}) = 10\sin(\pi x_1 x_2) + 20(x_3-0.5)^2 + 10x_4 + 5x_5}{m(X) = 10*sin(pi*X[,1]*X[,2]) + 20*(X[,3]-0.5)^2 + 10*X[,4] + 5*X[,5]} The variation \code{fried.bool} uses indicators \eqn{I\in \{1,2,3,4\}}{I in 1:4}. The function also has 10-dim inputs \code{X} with columns distributed as Unif(0,1) and responses are \eqn{N(m(\mathbf{x},I), 1)}{N(m(X,I), 1)} where \eqn{m(\mathbf{x},I) = E(f(\mathbf{x},I)}{m(X,I) = E[f(X,I)]} and \deqn{m(\mathbf{x},I) = f_1(\mathbf{x})_{[I=1]} + f_2(\mathbf{x})_{[I=2]} + f_3(\mathbf{x})_{[I=3]} + m([x_{10},\cdots,x_1])_{[I=4]}}{m(X,I) = fI(X) if I in 1:3 else m(X[,10:1])} where \deqn{f_1(\mathbf{x}) = 10\sin(\pi x_1 x_2), \; f_2(\mathbf{x}) = 20(x_3-0.5)^2, \; \mbox{and } f_3(\mathbf{x}) = 10x_4 + 5x_5.}{f1(X)=10*sin(pi*X[,1]*X[,2]), f2(X)=20*(X[,3]-0.5)^2, f3(X)=10*X[,4]+5*X[,5] } The indicator I is coded in binary in the output data frame as: \code{c(0,0,0)} for \code{I=1}, \code{c(0,0,1)} for \code{I=2}, \code{c(0,1,0)} for \code{I=3}, and \code{c(1,0,0)} for \code{I=4}. } \value{ Output is a \code{data.frame} with columns \item{X.1, \dots, X.10 }{describing the 10-d randomly sampled inputs} \item{I.1, \dots, I.3}{boolean version of the indicators provided only for \code{fried.bool}, as described above} \item{Y}{sample responses (with N(0,1) noise)} \item{Ytrue}{true responses (without noise)} } \references{ Gramacy, R. B. (2007). \emph{\pkg{tgp}: An \R Package for Bayesian Nonstationary, Semiparametric Nonlinear Regression and Design by Treed Gaussian Process Models.} Journal of Statistical Software, \bold{19}(9). \url{https://www.jstatsoft.org/v19/i09} Robert B. Gramacy, Matthew Taddy (2010). \emph{Categorical Inputs, Sensitivity Analysis, Optimization and Importance Tempering with \pkg{tgp} Version 2, an \R Package for Treed Gaussian Process Models.} Journal of Statistical Software, \bold{33}(6), 1--48. \url{https://www.jstatsoft.org/v33/i06/}. Friedman, J. H. (1991). \emph{Multivariate adaptive regression splines.} \dQuote{Annals of Statistics}, \bold{19}, No. 1, 1--67. Gramacy, R. B., Lee, H. K. H. (2008). \emph{Bayesian treed Gaussian process models with an application to computer modeling}. Journal of the American Statistical Association, 103(483), pp. 1119-1130. Also available as ArXiv article 0710.4536 \url{https://arxiv.org/abs/0710.4536} Chipman, H., George, E., \& McCulloch, R. (2002). \emph{Bayesian treed models.} Machine Learning, \bold{48}, 303--324. \url{https://bobby.gramacy.com/r_packages/tgp/} } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \note{An example using the original version of the data (\code{friedman.1.data}) is contained in the first package vignette: \code{vignette("tgp")}. The boolean version \code{fried.bool} is used in second vignette \code{vignette("tgp2")} } \seealso{ \code{\link{bgpllm}}, \code{\link{btlm}}, \code{\link{blm}}, \code{\link{bgp}}, \code{\link{btgpllm}}, \code{\link{bgp}}} \keyword{ datagen } tgp/man/sens.Rd0000644000176200001440000002300613724020524013056 0ustar liggesusers\name{sens} \alias{sens} \title{Monte Carlo Bayesian Sensitivity Analysis} \description{Fully Bayesian Monte Carlo sensitivity analysis scheme, based upon any of the regression models contained in the \pkg{tgp} package. Random Latin hypercube samples are drawn at each MCMC iteration in order to estimate main effects as well as 1st order and total sensitivity indices.} \usage{ sens(X, Z, nn.lhs, model = btgp, ngrid = 100, span = 0.3, BTE = c(3000,8000,10), rect = NULL, shape = NULL, mode = NULL, ...) } \arguments{ \item{X}{\code{data.frame}, \code{matrix}, or vector of inputs \code{X} } \item{Z}{ Vector of output responses \code{Z} of length equal to the leading dimension (rows) of \code{X}, i.e., \code{length(Z) == nrow(X)}} \item{nn.lhs}{Size of each Latin hypercube drawn for use in the Monte Carlo integration scheme. Total number of locations for prediction is \code{nn.lhs*(ncol(X)+2)}} \item{model}{Either the regression model used for prediction, or \code{NULL}. If \code{model=NULL}, then the function just returns the \code{sens.p} vector of parameters to be passed with a regression model call. This can be used to perform sensitivity analysis through the \code{\link{predict.tgp}} framework} \item{ngrid}{The number of grid points in each input dimension upon which main effects will be estimated.} \item{span}{Smoothing parameter for main effects integration: the fraction of \code{nn.lhs} points that will be included in a moving average window that is used to estimate main effects at the \code{ngrid} locations in each input dimension.} \item{BTE}{ 3-vector of Monte-Carlo parameters (B)urn in, (T)otal, and (E)very. Predictive samples are saved every E MCMC rounds starting at round B, stopping at T } \item{rect}{ Rectangle describing the domain of the uncertainty distribution with respect to which the sensitivity is to be determined. This defines the domain from which the LH sample is to be taken. The rectangle should be a \code{matrix} or \code{data.frame} with \code{ncol(rect) = 2}, and number of rows equal to the dimension of the domain. For 1-d data, a vector of length 2 is allowed. Defaults to the input data range (\code{X}).} \item{shape}{ Optional vector of shape parameters for the Beta distribution. Vector of length equal to the dimension of the domain, with elements > 1. If specified, the uncertainty distribution (i.e. the LH sample) is proportional to a joint pdf formed by independent Beta distributions in each dimension of the domain, scaled and shifted to have support defined by \code{rect}. Only concave Beta distributions with \code{shape} > 1 are supported. If unspecified, the uncertainty distribution is uniform over \code{rect}. The specification \code{shape[i]=0} instructs \code{sens} to treat the i'th dimension as a binary variable. In this case, \code{mode[i]} is the probability parameter for a bernoulli uncertainty distribution, and we must also have \code{rect[i,]=c(0,1)}. } \item{mode}{ Optional vector of mode values for the Beta uncertainty distribution. Vector of length equal to the dimension of the domain, with elements within the support defined by \code{rect}. If \code{shape} is specified, but this is not, then the scaled Beta distributions will be symmetric. } \item{\dots}{Extra arguments to the \pkg{tgp} \code{model}. } } \details{ Saltelli (2002) describes a Latin Hypercube sampling based method for estimation of the 'Sobal' sensitivity indices: 1st Order for input \eqn{i}{i}, \deqn{S(i) = \mbox{Var}(E[f|x_i])/\mbox{Var}(f),}{S(i) = var(E[f|x[i]])/var(f),} where \eqn{x_i}{x[i]} is the \eqn{i}{i}-th input. Total Effect for input \eqn{i}{i}, \deqn{T(i) = E[\mbox{Var}(f|x_{-i})]/\mbox{Var}(f),}{T(i) = E[var(f|x[-i])]/var(f),} where \eqn{x_{-i}}{x[-i]} is all inputs except for the \eqn{i}{i}-th. All moments are with respect to the appropriate marginals of the uncertainty distribution \eqn{U}{U} -- that is, the probability distribution on the inputs with respect to which sensitivity is being investigated. Under this approach, the integrals involved are approximated through averages over properly chosen samples based on two LH samples proportional to U. If \code{nn.lhs} is the sample size for the Monte Carlo estimate, this scheme requires \code{nn.lhs*(ncol(X)+2)} function evaluations. The \code{sens} function implements the method for unknown functions \eqn{f}, through prediction via one of the \pkg{tgp} regression models conditional on an observed set of \code{X} locations. At each MCMC iteration of the \pkg{tgp} model fitting, the \code{nn.lhs*(ncol(X)+2)} locations are drawn randomly from the LHS scheme and realizations of the sensitivity indices are calculated. Thus we obtain a posterior sample of the indices, incorporating variability from both the Monte Carlo estimation and uncertainty about the function output. Since a subset of the predictive locations are actually an LHS proportional to the uncertainty distribution, we can also estimate the main effects through simple non-parametric regression (a moving average). Please see \code{vignette("tgp2")} for a detailed illustration } \value{ The output is a \code{"tgp"}-class object. The details for \code{\link{btgp}} contain a complete description of this output. The list entry that is relevance to sensitivity analysis is \code{sens}, which itself has entries: \item{par}{ This contains a \code{list} of the input parameters used in the sensitivity analysis, as outlined above.} \item{Xgrid}{A \code{matrix} containing a grid in each input dimension (by column) over which the main effects are estimated.} \item{ZZ.mean}{A \code{matrix}, where each column contains the mean main effects over the corresponding column of \code{sens.Xgrid}.} \item{ZZ.q1}{A \code{matrix}, where each column contains the 5th percentile main effects over the corresponding column of \code{sens.Xgrid}.} \item{ZZ.q2}{A \code{matrix}, where each column contains the 5th percentile main effects over the corresponding column of \code{sens.Xgrid}.} \item{S}{A \code{matrix}, where each column contains the posterior sample of 1st order sensitivity indices for the corresponding input dimension.} \item{T}{A \code{matrix}, where each column contains the posterior sample of total sensitivity indices for the corresponding input dimension.} } \references{ Gramacy, R. B. (2020) \emph{Surrogates: Gaussian Process Modeling, Design and Optimization for the Applied Sciences}. Boca Raton, Florida: Chapman Hall/CRC. (See Chapter 8.) \url{https://bobby.gramacy.com/surrogates/} R.D. Morris, A. Kottas, M. Taddy, R. Furfaro, and B. Ganapol. (2009) \emph{A statistical framework for the sensitivity analysis of radiative transfer models.} IEEE Transactions on Geoscience and Remote Sensing, to appear. Saltelli, A. (2002) \emph{Making best use of model evaluations to compute sensitivity indices.} Computer Physics Communications, 145, 280-297. } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \note{ The quality of sensitivity analysis is dependent on the size of the LH samples used for integral approximation; as with any Monte Carlo integration scheme, the sample size (\code{nn.lhs}) must increase with the dimensionality of the problem. The total sensitivity indices \eqn{T}{T} are forced non-negative, and if negative values occur it is necessary to increase \code{nn.lhs}. The \code{plot.tgp} function replaces negative values with zero for illustration. } \seealso{ \code{\link{btgp}}, \code{\link{plot.tgp}}, \code{\link{predict.tgp}}, \code{\link{lhs}} } \examples{ # Take a look at the air quality in New York: Sensitivity of # ozone levels with respect to solar radiation, wind, and # temperature. See help(airquality) for details. X <- airquality[,2:4] Z <- airquality$Ozone # Uncertainty distribution is the default: uniform over range(X) # There is missing data, which is removed automatically by tgp # range(X). \donttest{ s <- suppressWarnings(sens(X=X, Z=Z, nn.lhs=300, model=btgp, ngrid=100, span=0.3, BTE=c(5000,10000,10))) # plot the results plot(s, layout="sens", ylab="Ozone", main="main effects") # plot only the sensitivity indices plot(s, layout="sens", ylab="Ozone", maineff=FALSE) # plot only the main effects, side by side plot(s, layout="sens", ylab="Ozone", main="", maineff=t(1:3)) } # build a 'sens.p' parameter vector for a data-dependent # informative uncertainty distribution. For each variable, # the input distribution will be a scaled Beta with shape=2, # and mode equal to the data mean rect <- t(apply(X, 2, range, na.rm=TRUE)) mode <- apply(X , 2, mean, na.rm=TRUE) shape <- rep(2,3) # plot a sample from the marginal uncertainty distribution. Udraw <- lhs(300, rect=rect, mode=mode, shape=shape) par(mfrow=c(1,3)) for(i in 1:3) hist(Udraw[,i], breaks=15,xlab=names(X)[i]) # build sens.p with the 'sens' function. sens.p <- suppressWarnings(sens(X=X, Z=Z, nn.lhs=300, model=NULL, ngrid=100, rect=rect, shape=shape, mode=mode)) # Use predict.tgp to quickly analyze with respect to this new # uncertainty distribution without re-running the MCMC, then # plot the results. \donttest{ s.new <- predict(s, BTE=c(1,1000,1), sens.p=sens.p, verb=1) plot(s.new, layout="sens", ylab="Ozone", main="main effects") } } \keyword{ htest } \keyword{ multivariate } \keyword{ regression } \keyword{ spatial } \keyword{ tree } tgp/man/predict.tgp.Rd0000644000176200001440000002074413724021575014346 0ustar liggesusers\name{predict.tgp} \alias{predict.tgp} \title{ Predict method for Treed Gaussian process models } \description{ This generic prediction method was designed to obtain samples from the posterior predictive distribution after the \code{b*} functions have finished. Samples, or kriging mean and variance estimates, can be obtained from the MAP model encoded in the \code{"tgp"}-class object, or this parameterization can be used as a jumping-off point in obtaining further samples from the joint posterior and posterior predictive distributions } \usage{ \method{predict}{tgp}(object, XX = NULL, BTE = c(0, 1, 1), R = 1, MAP = TRUE, pred.n = TRUE, krige = TRUE, zcov = FALSE, Ds2x = FALSE, improv = FALSE, sens.p = NULL, trace = FALSE, verb = 0, ...) } \arguments{ \item{object}{ \code{"tgp"}-class object that is the output of one of the \code{b*} functions: \code{\link{blm}}, \code{\link{btlm}} \code{\link{bgp}}, \code{\link{bgpllm}}, \code{\link{btgp}}, or \code{\link{btgpllm}}} \item{XX}{ Optional \code{data.frame}, \code{matrix}, or vector of predictive input locations with \code{ncol(XX) == ncol(object$X)}} \item{BTE}{ 3-vector of Monte-carlo parameters (B)urn in, (T)otal, and (E)very. Predictive samples are saved every E MCMC rounds starting at round B, stopping at T. The default \code{BTE=c(0,1,1)} is specified to give the kriging means and variances as outputs, plus one sample from the posterior predictive distribution} \item{R}{ Number of repeats or restarts of \code{BTE} MCMC rounds, default \code{R=1} is no restarts} \item{MAP}{ When \code{TRUE} (default) predictive data (i.e., kriging mean and variance estimates, and samples from the posterior predictive distribution) are obtained for the \emph{fixed} MAP model encoded in \code{object}. Otherwise, when \code{MAP=FALSE} sampling from the joint posterior of the model parameters (i.e., tree and GPs) and the posterior predictive distribution are obtained starting from the MAP model and proceeding just as the \code{b*} functions} \item{pred.n}{\code{TRUE} (default) value results in prediction at the inputs \code{X}; \code{FALSE} skips prediction at \code{X} resulting in a faster implementation} \item{krige}{\code{TRUE} (default) value results in collection of kriging means and variances at predictive (and/or data) locations; \code{FALSE} skips the gathering of kriging statistics giving a savings in storage} \item{zcov}{If \code{TRUE} then the predictive covariance matrix is calculated-- can be computationally (and memory) intensive if \code{X} or \code{XX} is large. Otherwise only the variances (diagonal of covariance matrices) are calculated (default). See outputs \code{Zp.s2}, \code{ZZ.s2}, etc., below} \item{Ds2x}{\code{TRUE} results in ALC (Active Learning--Cohn) computation of expected reduction in uncertainty calculations at the \code{X} locations, which can be used for adaptive sampling; \code{FALSE} (default) skips this computation, resulting in a faster implementation} \item{improv}{\code{TRUE} results in samples from the improvement at locations \code{XX} with respect to the observed data minimum. These samples are used to calculate the expected improvement over \code{XX}, as well as to rank all of the points in \code{XX} in the order that they should be sampled to minimize the expected multivariate improvement (refer to Schonlau et al, 1998). Alternatively, \code{improv} can be set to any positive integer 'g', in which case the ranking is performed with respect to the expectation for improvement raised to the power 'g'. Increasing 'g' leads to rankings that are more oriented towards a global optimization. The option \code{FALSE} (default) skips these computations, resulting in a faster implementation. Optionally, a two-vector can be supplied where \code{improv[2]} is interpreted as the (maximum) number of points to rank by improvement. See the note in \code{\link{btgp}} documentation. If not specified, then the larger of 10\% of \code{nn = nrow(XX)} and \code{min(10, nn)} is taken by default } \item{sens.p}{ Either \code{NULL} or a vector of parameters for sensitivity analysis, built by the function \code{\link{sens}}. Refer there for details} \item{trace}{ \code{TRUE} results in a saving of samples from the posterior distribution for most of the parameters in the model. The default is \code{FALSE} for speed/storage reasons. See note below } \item{verb}{ Level of verbosity of R-console print statements: from 0 (default: none); 1 which shows the \dQuote{progress meter}; 2 includes an echo of initialization parameters; up to 3 and 4 (max) with more info about successful tree operations} \item{...}{ Ellipses are not used in the current version of \code{predict.tgp}. They are are only included in order to maintain S3 generic/method consistency } } \details{ While this function was designed with prediction in mind, it is actually far more general. It allows a continuation of MCMC sampling where the \code{b*} function left off (when \code{MAP=FALSE}) with a possibly new set of predictive locations \code{XX}. The intended use of this function is to obtain quick kriging-style predictions for a previously-fit MAP estimate (contained in a \code{"tgp"}-class object) on a new set of predictive locations \code{XX}. However, it can also be used simply to extend the search for an MAP model when \code{MAP=FALSE}, \code{pred.n=FALSE}, and \code{XX=NULL} } \note{ It is important to note that this function is not a replacement for supplying \code{XX} to the \code{b*} functions, which is the only way to get fully Bayesian samples from the posterior prediction at new inputs. It is only intended as a post-analysis (diagnostic) tool. Inputs \code{XX} containing \code{NaN, NA}, or \code{Inf} are discarded with non-fatal warnings. Upon execution, MCMC reports are made every 1,000 rounds to indicate progress. If \code{XX}s are provided which fall outside the range of \code{X} inputs provided to the original \code{b*} function, then those will not be extrapolated properly, due to the way that bounding rectangles are defined in the original run. For a workaround, supply \code{out$Xsplit <- rbind(X, XX)} before running \code{predict} on \code{out}. See note for \code{\link{btgp}} or another \code{b*} function regarding the handling and appropriate specification of \code{traces}. The \code{"tgp"} class output produced by \code{predict.tgp} can also be used as input to \code{predict.tgp}, as well as others (e.g., \code{\link{plot.tgp}}. } \value{ The output is the same, or a subset of, the output produced by the \code{b*} functions, for example see \code{\link{btgp}} } \references{ \url{https://bobby.gramacy.com/r_packages/tgp/} } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \seealso{ \code{\link{predict}}, \code{\link{blm}}, \code{\link{btlm}}, \code{\link{bgp}}, \code{\link{btgp}}, \code{\link{bgpllm}}, \code{\link{btgpllm}}, \code{\link{plot.tgp}} } \examples{ \donttest{ ## revisit the Motorcycle data require(MASS) ## fit a btgpllm without predictive sampling (for speed) out <- btgpllm(X=mcycle[,1], Z=mcycle[,2], bprior="b0", pred.n=FALSE) ## nothing to plot here because there is no predictive data ## save the "tgp" class output object for use later and save(out, file="out.Rsave") ## then remove it (for illustrative purposes) out <- NULL ## (now imagine emailing the out.Rsave file to a friend who ## then performs the following in order to use your fitted ## tgp model on his/her own predictive locations) ## load in the "tgp" class object we just saved load("out.Rsave") ## new predictive locations XX <- seq(2.4, 56.7, length=200) ## now obtain kriging estimates from the MAP model out.kp <- predict(out, XX=XX, pred.n=FALSE) plot(out.kp, center="km", as="ks2") ## actually obtain predictive samples from the MAP out.p <- predict(out, XX=XX, pred.n=FALSE, BTE=c(0,1000,1)) plot(out.p) ## use the MAP as a jumping-off point for more sampling out2 <- predict(out, XX, pred.n=FALSE, BTE=c(0,2000,2), MAP=FALSE, verb=1) plot(out2) ## (generally you would not want to remove the file) unlink("out.Rsave") } } \keyword{ nonparametric } \keyword{ nonlinear } \keyword{ smooth } \keyword{ models } \keyword{ spatial } \keyword{ tree } tgp/man/default.itemps.Rd0000644000176200001440000001547113724023425015044 0ustar liggesusers\name{default.itemps} \alias{default.itemps} \title{ Default Sigmoidal, Harmonic and Geometric Temperature Ladders } \description{ Parameterized by the minimum desired \emph{inverse} temperature, this function generates a ladder of inverse temperatures \code{k[1:m]} starting at \code{k[1] = 1}, with \code{m} steps down to the final temperature \code{k[m] = k.min} progressing sigmoidally, harmonically or geometrically. The output is in a format convenient for the \code{b*} functions in the \pkg{tgp} package (e.g. \code{\link{btgp}}), including stochastic approximation parameters \eqn{c_0}{c0} and \eqn{n_0}{n0} for tuning the uniform pseudo-prior output by this function } \usage{ default.itemps(m = 40, type = c("geometric", "harmonic","sigmoidal"), k.min = 0.1, c0n0 = c(100, 1000), lambda = c("opt", "naive", "st")) } \arguments{ \item{m}{ Number of temperatures in the ladder; \code{m=1} corresponds to \emph{importance sampling} at the temperature specified by \code{k.min} (in this case all other arguments are ignored) } \item{type}{ Choose from amongst two common defaults for simulated tempering and Metropolis-coupled MCMC, i.e., geometric (default) or harmonic, or a sigmoidal ladder (default) that concentrates more inverse temperatures near 1} \item{k.min}{ Minimum inverse temperature desired } \item{c0n0}{ Stochastic approximation parameters used to tune the simulated tempering pseudo-prior (\code{$pk}) to get a uniform posterior over the inverse temperatures; must be a 2-vector of positive integers \code{c(c0, n0)}; see the Geyer \& Thompson reference below } \item{lambda}{ Method for combining the importance samplers at each temperature. Optimal combination (\code{"opt"}) is the default, weighting the IS at each temperature \eqn{k}{k} by \deqn{\lambda_k \propto (\sum_i w_{ki})^2/\sum_i w_{ki}^2.}{lambda[k] = sum(w[k,]))^2/sum(w[k,]^2).} Setting \code{lambda = "naive"} allows each temperature to contribute equally (\eqn{\lambda_k \propto 1}{\lambda[k] = 1}, or equivalently ignores delineations due to temperature when using importance weights. Setting \code{lambda = "st"} allows only the first (cold) temperature to contribute to the estimator, thereby implementing \emph{simulated tempering}} } \details{ The geometric and harmonic inverse temperature ladders are usually defined by an index \eqn{i=1,\dots,m}{i = 1:m} and a parameter \eqn{\Delta_k > 0}{delta > 0}. The geometric ladder is defined by \deqn{k_i = (1+\Delta_k)^{1-i},}{k[i] = (1 + delta)^(1-i),} and the harmonic ladder by \deqn{k_i = (1+\Delta_k(i-1))^{-1}.}{k[i] = (1 + delta*(i-1))^(-1).} Alternatively, specifying the minimum temperature \eqn{k_{\mbox{\tiny min}}}{k.min} in the ladder can be used to uniquely determine \eqn{\Delta_k}{delta}. E.g., for the geometric ladder \deqn{\Delta_k = k_{\mbox{\tiny min}}^{1/(1-m)}-1,}{delta = k.min^(1/(1-m))-1,} and for the harmonic \deqn{\Delta_k = \frac{k_{\mbox{\tiny min}}^{-1}-1}{m-1}.}{delta = (k.min^(-1)-1)/(m-1).} In a similar spirit, the sigmoidal ladder is specified by first situating \eqn{m}{m} indices \eqn{j_i\in \Re}{j[i] in Re} so that \eqn{k_1 = k(j_1) = 1}{k[1] = k(j[1]) = 1} and \eqn{k_m = k(j_m) = k_{\mbox{\tiny min}}}{k[m] = k(j[m]) = k.min} under \deqn{k(j_i) = 1.01 - \frac{1}{1+e^{j_i}}.}{k(j[i]) = 1.01 - 1/(1+exp(-j[i])).} The remaining \eqn{j_i, i=2,\dots,(m-1)}{j[2:(m-1)]} are spaced evenly between \eqn{j_1}{j[i]} and \eqn{j_m}{j[m]} to fill out the ladder \eqn{k_i = k(j_i), i=1,\dots,(m-1)}{k[2:(m-1)] = k(j[2:(m-1)])}. For more details, see the \emph{Importance tempering} paper cited below and a full demonstration in \code{vignette("tgp2")} } \value{ The return value is a \code{list} which is compatible with the input argument \code{itemps} to the \code{b*} functions (e.g. \code{\link{btgp}}), containing the following entries: \item{c0n0 }{ A copy of the \code{c0n0} input argument } \item{k }{ The generated inverse temperature ladder; a vector with \code{length(k) = m} containing a decreasing sequence from \code{1} down to \code{k.min}} \item{pk }{ A vector with \code{length(pk) = m} containing an initial pseudo-prior for the temperature ladder of \code{1/m} for each inverse temperature} \item{lambda}{ IT method, as specified by the input argument} } \references{ Gramacy, R.B., Samworth, R.J., and King, R. (2010) \emph{Importance Tempering.} ArXiV article 0707.4242 Statistics and Computing, 20(1), pp. 1-7; \url{https://arxiv.org/abs/0707.4242}. For stochastic approximation and simulated tempering (ST): Geyer, C.~and Thompson, E.~(1995). \emph{Annealing Markov chain Monte Carlo with applications to ancestral inference.} Journal of the American Statistical Association, \bold{90}, 909--920. For the geometric temperature ladder: Neal, R.M.~(2001) \emph{Annealed importance sampling.} Statistics and Computing, \bold{11}, 125--129 Justifying geometric and harmonic defaults: Liu, J.S.~(1002) \emph{Monte Carlo Strategies in Scientific Computing.} New York: Springer. Chapter 10 (pages 213 \& 233) \url{https://bobby.gramacy.com/r_packages/tgp/} } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \seealso{ \code{\link{btgp}} } \examples{ ## comparing the different ladders geo <- default.itemps(type="geometric") har <- default.itemps(type="harmonic") sig <- default.itemps(type="sigmoidal") par(mfrow=c(2,1)) matplot(cbind(geo$k, har$k, sig$k), pch=21:23, main="inv-temp ladders", xlab="indx", ylab="itemp") legend("topright", pch=21:23, c("geometric","harmonic","sigmoidal"), col=1:3) matplot(log(cbind(sig$k, geo$k, har$k)), pch=21:23, main="log(inv-temp) ladders", xlab="indx", ylab="itemp") \dontrun{ ## using Importance Tempering (IT) to improve mixing ## on the motorcycle accident dataset library(MASS) out.it <- btgpllm(X=mcycle[,1], Z=mcycle[,2], BTE=c(2000,22000,2), R=3, itemps=default.itemps(), bprior="b0", trace=TRUE, pred.n=FALSE) ## compare to regular tgp w/o IT out.reg <- btgpllm(X=mcycle[,1], Z=mcycle[,2], BTE=c(2000,22000,2), R=3, bprior="b0", trace=TRUE, pred.n=FALSE) ## compare the heights explored by the three chains: ## REG, combining all temperatures, and IT p <- out.it$trace$post L <- length(p$height) hw <- suppressWarnings(sample(p$height, L, prob=p$wlambda, replace=TRUE)) b <- hist2bar(cbind(out.reg$trace$post$height, p$height, hw)) par(mfrow=c(1,1)) barplot(b, beside=TRUE, xlab="tree height", ylab="counts", col=1:3, main="tree heights encountered") legend("topright", c("reg MCMC", "All Temps", "IT"), fill=1:3) } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ misc } tgp/man/optim.tgp.Rd0000644000176200001440000001653613724023333014042 0ustar liggesusers\name{optim.tgp} \alias{optim.step.tgp} \alias{optim.ptgpf} \title{ Surrogate-based optimization of noisy black-box function } \description{ Optimize (minimize) a noisy black-box function (i.e., a function which may not be differentiable, and may not execute deterministically). A \code{b*} \pkg{tgp} model is used as a surrogate for adaptive sampling via improvement (and other) statistics. Note that this function is intended as a skeleton to be tailored as required for a particular application } \usage{ optim.step.tgp(f, rect, model = btgp, prev = NULL, X = NULL, Z = NULL, NN = 20 * length(rect), improv = c(1, 5), cands = c("lhs", "tdopt"), method = c("L-BFGS-B", "Nelder-Mead", "BFGS", "CG", "SANN", "optimize"), ...) optim.ptgpf(start, rect, tgp.obj, method=c("L-BFGS-B", "Nelder-Mead", "BFGS", "CG", "SANN", "optimize")) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{f}{ A function to be optimized, having only one free argument } \item{rect}{ \code{matrix} indicating the domain of the argument of \code{f} over which an optimal should be searched; must have \code{ncol(rect) = 2} and \code{nrow} agreeing with the argument of \code{f} indicating the dimension of the data. For 1-d data, a vector of length 2 is allowed} \item{model}{ The \code{b*} regression model used as a surrogate for optimization; see \code{\link{btgp}}, and others, for more detail } \item{prev}{ The output from a previous call to \code{optim.step.tgp}; this should be a \code{list} with entries as described the \dQuote{Value} section below } \item{X}{\code{data.frame}, \code{matrix}, or vector of current inputs \code{X}, to be augmented } \item{Z}{ Vector of current output responses \code{Z} of length equal to the leading dimension (rows) of \code{X}, i.e., \code{length(Z) == nrow(X)}, to be augmented} \item{NN}{ Number of candidate locations (\code{XX}) at which to sample from the improvement statistic } \item{improv}{ Indicates the \code{improv} argument provided to a \code{b*} \code{model} function for sampling from the improvement statistic at the \code{NN} candidate locations (\code{XX}); see \code{\link{btgp}}, and others, for more detail} \item{cands}{ The type of candidates (\code{XX}) at which samples from the improvement statistics are gathered. The default setting of \code{"lhs"} is recommended. However, a sequential treed D-optimal design can be used with \code{"tdopt"} for a more global exploration; see \code{\link{tgp.design}} for more details } \item{method}{ A method from \code{\link{optim}}, or \code{"optimize"} which uses \code{\link{optimize}} as appropriate (when the input-space is 1-d)} \item{\dots}{ Further arguments to the \code{b*} \code{model} function} \item{start}{ A starting value for optimization of the MAP predictive (kriging) surface of a \code{"tgp"}-class object. A good starting value is the \code{X} or \code{XX} location found to be a minimum in the mean predictive surface contained in \code{"tgp"}-class object } \item{tgp.obj}{ A \code{"tgp"}-class object that is the output of one of the \code{b*} functions: \code{\link{blm}}, \code{\link{btlm}} \code{\link{bgp}}, \code{\link{bgpllm}}, \code{\link{btgp}}, or \code{\link{btgpllm}}, as can be used by \code{\link{predict.tgp}} for optimizing on the MAP predictive (surrogate) kriging surface } } \details{ \code{optim.step.tgp} executes one step in a search for the global optimum (minimum) of a noisy function (\code{Z~f(X)}) in a bounded rectangle (\code{rect}). The procedure essentially fits a tgp \code{model} and samples from the posterior distribution of improvement statistics at \code{NN+1} candidates locations. \code{NN} of the candidates come from \code{cands}, i.e., \code{"lhs"} or \code{"tdopt"}, plus one which is the location of the minima found in a previous run via \code{prev} by using \code{\link{optim}} (with a particular \code{method} or \code{\link{optimize}} instead) on the MAP \code{model} predictive surface using the \code{"tgp"}-class object contained therein. The \code{improv[2]} with the the highest expected improvement are recommended for adding into the design on output. \code{optim.ptgpf} is the subroutine used by \code{optim.step.tgp} to find optimize on the MAP (surrogate) predictive surface for the \code{"tgp"}-class object contained in \code{prev}. Please see \code{vignette("tgp2")} for a detailed illustration } \value{ The \code{list} return has the following components. \item{X }{ A \code{matrix} with \code{nrow(rect)} columns whose rows contain recommendations for input locations to add into the design } \item{progress }{ A one-row \code{data.frame} indicating the the \code{X}-location and objective value of the current best guess of the solution to the (kriging) surrogate optimization along with the maximum values of the improvement statistic } \item{obj }{ the \code{"tgp"}-class object output from the \code{model} function } } \references{ Gramacy, R. B. (2020) \emph{Surrogates: Gaussian Process Modeling, Design and Optimization for the Applied Sciences}. Boca Raton, Florida: Chapman Hall/CRC. (See Chapter 7.) \url{https://bobby.gramacy.com/surrogates/} Matthew Taddy, Herbert K.H. Lee, Genetha A. Gray, and Joshua D. Griffin. (2009) \emph{Bayesian guided pattern search for robust local optimization.} Technometrics, 51(4), pp. 389-401 \url{https://bobby.gramacy.com/r_packages/tgp/} } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \note{ The ellipses (\code{\dots}) argument is used differently here, as compared to \code{\link{optim}}, and \code{\link{optimize}}. It allows further arguments to be passed to the \code{b*} \code{model} function, whereas for \code{\link{optim}} it would describe further (static) arguments to the function \code{f} to be optimized. If static arguments need to be set for \code{f}, then we recommend setting defaults via the \code{\link{formals}} of \code{f} } \seealso{ \code{\link{btgp}}, etc., \code{\link{optim}}, \code{\link{optimize}}, \code{\link{tgp.design}}, \code{\link{predict.tgp}}, \code{\link{dopt.gp}} } \examples{ \donttest{ ## optimize the simple exponential function f <- function(x) { exp2d.Z(x)$Z } ## create the initial design with D-optimal candidates rect <- rbind(c(-2,6), c(-2,6)) Xcand <- lhs(500, rect) X <- dopt.gp(50, X=NULL, Xcand)$XX Z <- f(X) ## do 10 rounds of adaptive sampling out <- progress <- NULL for(i in 1:10) { ## get recommendations for the next point to sample out <- optim.step.tgp(f, X=X, Z=Z, rect=rect, prev=out) ## add in the inputs, and newly sampled outputs X <- rbind(X, out$X) Z <- c(Z, f(out$X)) ## keep track of progress and best optimum progress <- rbind(progress, out$progress) print(progress[i,]) } ## plot the progress so far par(mfrow=c(2,2)) plot(out$obj, layout="surf") plot(out$obj, layout="as", as="improv") matplot(progress[,1:nrow(rect)], main="optim results", xlab="rounds", ylab="x[,1:2]", type="l", lwd=2) plot(log(progress$improv), type="l", main="max log improv", xlab="rounds", ylab="max log(improv)") } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ optimize } \keyword{ design } tgp/man/tgp-package.Rd0000644000176200001440000000662413724023004014274 0ustar liggesusers\name{tgp-package} \alias{tgp-package} \docType{package} \title{ The Treed Gaussian Process Model Package } \description{ A Bayesian nonstationary nonparametric regression and design package implementing an array of models of varying flexibility and complexity. } \details{ This package implements Bayesian nonstationary, semiparametric nonlinear regression with \dQuote{treed Gaussian process models} with jumps to the limiting linear model (LLM). The package contains functions which facilitate inference for seven regression models of varying complexity using Markov chain Monte Carlo (MCMC): linear model, CART (Classification and Regression Tree), treed linear model, Gaussian process (GP), GP with jumps to the LLM, GP single-index models, treed GPs, treed GP LLMs, and treed GP single-index models. R provides an interface to the C/C++ backbone, and a serves as mechanism for graphically visualizing the results of inference and posterior predictive surfaces under the models. A Bayesian Monte Carlo based sensitivity analysis is implemented, and multi-resolution models are also supported. Sequential experimental design and adaptive sampling functions are also provided, including ALM, ALC, and expected improvement. The latter supports derivative-free optimization of noisy black-box functions. For a fuller overview including a complete list of functions, demos and vignettes, please use \code{help(package="tgp")}. } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \references{ Gramacy, R. B. (2020) \emph{Surrogates: Gaussian Process Modeling, Design and Optimization for the Applied Sciences}. Boca Raton, Florida: Chapman Hall/CRC. (See Chapter 9.) \url{https://bobby.gramacy.com/surrogates/} Gramacy, R. B. (2007). \emph{\pkg{tgp}: An \R Package for Bayesian Nonstationary, Semiparametric Nonlinear Regression and Design by Treed Gaussian Process Models.} Journal of Statistical Software, \bold{19}(9). \url{https://www.jstatsoft.org/v19/i09} Robert B. Gramacy, Matthew Taddy (2010). \emph{Categorical Inputs, Sensitivity Analysis, Optimization and Importance Tempering with \pkg{tgp} Version 2, an \R Package for Treed Gaussian Process Models.} Journal of Statistical Software, \bold{33}(6), 1--48. \url{https://www.jstatsoft.org/v33/i06/}. Gramacy, R. B., Lee, H. K. H. (2008). \emph{Bayesian treed Gaussian process models with an application to computer modeling}. Journal of the American Statistical Association, 103(483), pp. 1119-1130. Also available as ArXiv article 0710.4536 \url{https://arxiv.org/abs/0710.4536} Robert B. Gramacy, Heng Lian (2011). \emph{Gaussian process single-index models as emulators for computer experiments}. Available as ArXiv article 1009.4241 \url{https://arxiv.org/abs/1009.4241} Gramacy, R. B., Lee, H. K. H. (2006). \emph{Adaptive design of supercomputer experiments.} Available as UCSC Technical Report ams2006-02. Gramacy, R.B., Samworth, R.J., and King, R. (2007) \emph{Importance Tempering.} ArXiV article 0707.4242 \url{https://arxiv.org/abs/0707.4242} Gray, G.A., Martinez-Canales, M., Taddy, M.A., Lee, H.K.H., and Gramacy, R.B. (2007) \emph{Enhancing Parallel Pattern Search Optimization with a Gaussian Process Oracle}, SAND2006-7946C, Proceedings of the NECDC \url{https://bobby.gramacy.com/r_packages/tgp/} } \keyword{ nonparametric } \keyword{ smooth } \keyword{ models } \keyword{ spatial } \keyword{ tree } \keyword{ hplot } tgp/man/partition.Rd0000644000176200001440000000277113723731544014137 0ustar liggesusers\name{partition} \alias{partition} \title{ Partition data according to the MAP tree } \description{ Partition data according to the maximum a' posteriori (MAP) tree contained in a \code{"tgp"}-class object. } \usage{ partition(X, out) } \arguments{ \item{X}{\code{data.frame}, \code{matrix}, or vector of inputs \code{X} with the same dimension of \code{out$X}, i.e., \code{ncol(X) == ncol(out$X)}} \item{out}{ \code{"tgp"}-class object which is the output of one the model functions with tree support (e.g. \code{\link{btgpllm}}, \code{\link{btgp}}, \code{\link{btlm}}) } } \value{ Output is a list of \code{data.frame}s populated with the inputs \code{X} contained in each region of the partition of the MAP tree in the \code{"tgp"}-class object \code{out} } \references{ \url{https://bobby.gramacy.com/r_packages/tgp/} } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \seealso{ \code{\link{tgp.design}}, \code{\link{tgp.trees}} } \examples{ # # 2-d Exponential data # (This example is based on random data. # It might be fun to run it a few times) # # get the data exp2d.data <- exp2d.rand() X <- exp2d.data$X; Z <- exp2d.data$Z Xcand <- exp2d.data$XX # fit treed GP LLM model to data w/o prediction # basically just to get MAP tree (and plot it) out <- btgpllm(X=X, Z=Z, pred.n=FALSE, BTE=c(2000,3000,2)) tgp.trees(out) # find a treed sequential D-Optimal design # with 10 more points Xcand.parts <- partition(Xcand, out) } \keyword{ tree } tgp/man/exp2d.rand.Rd0000644000176200001440000001316113724022632014056 0ustar liggesusers \name{exp2d.rand} \alias{exp2d.rand} \title{ Random 2-d Exponential Data } \description{ A Random subsample of \code{data(\link{exp2d})}, or Latin Hypercube sampled data evaluated with \code{\link{exp2d.Z}} } \usage{exp2d.rand(n1 = 50, n2 = 30, lh = NULL, dopt = 1)} \arguments{ \item{n1}{Number of samples from the first, interesting, quadrant} \item{n2}{Number of samples from the other three, uninteresting, quadrants} \item{lh}{If \code{!is.null(lh)} then Latin Hypercube (LH) sampling (\code{\link{lhs}}) is used instead of subsampling from \code{data(\link{exp2d})}; \code{lh} should be a single nonnegative integer specifying the desired number of predictive locations, \code{XX}; or, it should be a vector of length 4, specifying the number of predictive locations desired from each of the four quadrants (interesting quadrant first, then counter-clockwise)} \item{dopt}{If \code{dopt >= 2} then d-optimal subsampling from LH candidates of the multiple indicated by the value of \code{dopt} will be used. This argument only makes sense when \code{!is.null(lh)}} } \value{ Output is a \code{list} with entries: \item{X}{2-d \code{data.frame} with \code{n1 + n2} input locations} \item{Z}{Numeric vector describing the responses (with noise) at the \code{X} input locations} \item{Ztrue}{Numeric vector describing the true responses (without noise) at the \code{X} input locations} \item{XX}{2-d \code{data.frame} containing the remaining \code{441 - (n1 + n2)} input locations} \item{ZZ}{Numeric vector describing the responses (with noise) at the \code{XX} predictive locations} \item{ZZtrue}{Numeric vector describing the responses (without noise) at the \code{XX} predictive locations} } \details{ When \code{is.null(lh)}, data is subsampled without replacement from \code{data(\link{exp2d})}. Of the \code{n1 + n2 <= 441} input/response pairs \code{X,Z}, there are \code{n1} are taken from the first quadrant, i.e., where the response is interesting, and the remaining \code{n2} are taken from the other three quadrants. The remaining \code{441 - (n1 + n2)} are treated as predictive locations Otherwise, when \code{!is.null(lh)}, Latin Hypercube Sampling (\code{\link{lhs}}) is used If \code{dopt >= 2} then \code{n1*dopt} LH candidates are used for to get a D-optimal subsample of size \code{n1} from the first (interesting) quadrant. Similarly \code{n2*dopt} in the rest of the un-interesting region. A total of \code{lh*dopt} candidates will be used for sequential D-optimal subsampling for predictive locations \code{XX} in all four quadrants assuming the already-sampled \code{X} locations will be in the design. In all three cases, the response is evaluated as \deqn{Z(X)=x_1 * \exp(x_1^2-x_2^2).}{Z(X) = X1 * exp(-X1^2-X2^2),} thus creating the outputs \code{Ztrue} and \code{ZZtrue}. Zero-mean normal noise with \code{sd=0.001} is added to the responses \code{Z} and \code{ZZ} } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \references{ Gramacy, R. B. (2007). \emph{\pkg{tgp}: An \R Package for Bayesian Nonstationary, Semiparametric Nonlinear Regression and Design by Treed Gaussian Process Models.} Journal of Statistical Software, \bold{19}(9). \url{https://www.jstatsoft.org/v19/i09} Gramacy, R. B., Lee, H. K. H. (2008). \emph{Bayesian treed Gaussian process models with an application to computer modeling}. Journal of the American Statistical Association, 103(483), pp. 1119-1130. Also available as ArXiv article 0710.4536 \url{https://arxiv.org/abs/0710.4536} \url{https://bobby.gramacy.com/r_packages/tgp/} } \seealso{\code{\link{lhs}}, \code{\link{exp2d}}, \code{\link{exp2d.Z}}, \code{\link{btgp}}, and other \code{b*} functions} \examples{ ## randomly subsampled data ## ------------------------ eds <- exp2d.rand() # higher span = 0.5 required because the data is sparse # and was generated randomly eds.g <- interp.loess(eds$X[,1], eds$X[,2], eds$Z, span=0.5) # perspective plot, and plot of the input (X & XX) locations par(mfrow=c(1,2), bty="n") persp(eds.g, main="loess surface", theta=-30, phi=20, xlab="X[,1]", ylab="X[,2]", zlab="Z") plot(eds$X, main="Randomly Subsampled Inputs") points(eds$XX, pch=19, cex=0.5) ## Latin Hypercube sampled data ## ---------------------------- edlh <- exp2d.rand(lh=c(20, 15, 10, 5)) # higher span = 0.5 required because the data is sparse # and was generated randomly edlh.g <- interp.loess(edlh$X[,1], edlh$X[,2], edlh$Z, span=0.5) # perspective plot, and plot of the input (X & XX) locations par(mfrow=c(1,2), bty="n") persp(edlh.g, main="loess surface", theta=-30, phi=20, xlab="X[,1]", ylab="X[,2]", zlab="Z") plot(edlh$X, main="Latin Hypercube Sampled Inputs") points(edlh$XX, pch=19, cex=0.5) # show the quadrants abline(h=2, col=2, lty=2, lwd=2) abline(v=2, col=2, lty=2, lwd=2) \dontrun{ ## D-optimal subsample with a factor of 10 (more) candidates ## --------------------------------------------------------- edlhd <- exp2d.rand(lh=c(20, 15, 10, 5), dopt=10) # higher span = 0.5 required because the data is sparse # and was generated randomly edlhd.g <- interp.loess(edlhd$X[,1], edlhd$X[,2], edlhd$Z, span=0.5) # perspective plot, and plot of the input (X & XX) locations par(mfrow=c(1,2), bty="n") persp(edlhd.g, main="loess surface", theta=-30, phi=20, xlab="X[,1]", ylab="X[,2]", zlab="Z") plot(edlhd$X, main="D-optimally Sampled Inputs") points(edlhd$XX, pch=19, cex=0.5) # show the quadrants abline(h=2, col=2, lty=2, lwd=2) abline(v=2, col=2, lty=2, lwd=2) } } \keyword{datasets} \keyword{datagen} tgp/man/itemps.Rd0000644000176200001440000000522213723713504013415 0ustar liggesusers\name{itemps} \alias{itemps.barplot} \alias{hist2bar} \title{ Functions to plot summary information about the sampled inverse temperatures, tree heights, etc., stored in the traces of a "tgp"-class object} \description{ Functions for making barplots summarizing the progress of importance tempering. The \code{itemps.barplot} function can be used to make a histogram of the inverse temperatures visited in the trans-temporal Markov chain. The \code{hist2bar} function is useful for making a histogram of integer-valued samples (e.g., tree heights) encountered in one or several Markov chains } \usage{ itemps.barplot(obj, main = NULL, xlab = "itemps", ylab = "counts", plot.it = TRUE, ...) hist2bar(x) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{obj}{ \code{"tgp"}-class object } \item{main}{ Main plot label to be augmented by \code{itemps.barplot} } \item{xlab}{ Label for the x-axis } \item{ylab}{ Label for the y-axis } \item{plot.it}{ whether to plot the \code{\link{barplot}} in addition to returning the \code{data.frame} for later use in a \code{\link{barplot}} call } \item{\dots}{ other arguments passed to \code{\link{barplot}} if \code{plot.it = TRUE} } \item{x}{ \code{matrix} of integers whose columns are treated as different realizations of similar processes producing where each row represents a sample (e.g., tree height) under that process } } \details{ \code{itemps.barplot} specifically works with the \code{$trace} field of a \code{"tgp"}-class object. An error will be produced if this field is \code{NULL}, i.e., if the \code{b*} function used the create the object was not run with the argument \code{trace=TRUE} The \code{hist2bar} function can be used on any integer (or discrete) valued matrix. The columns are interpreted as different realizations of similar processes for comparison with one another via a histogram. The histogram is obtained with the \code{\link{barplot}} command used with the argument \code{beside=TRUE}. See the examples section of \code{\link{default.itemps}} } \value{ Both functions return a \code{data.frame} that can be used within the \code{\link{barplot}} function with argument \code{beside=TRUE} } \references{ Gramacy, R.B., Samworth, R.J., and King, R. (2007) \emph{Importance Tempering.} ArXiv article 0707.4242 \url{https://arxiv.org/abs/0707.4242} \url{https://bobby.gramacy.com/r_packages/tgp/} } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \seealso{ \code{\link{default.itemps}}, \code{vignette(tgp2)}, \code{\link{barplot}} } \keyword{ hplot } tgp/man/plot.tgp.Rd0000644000176200001440000002010513723731552013663 0ustar liggesusers\name{plot.tgp} \alias{plot.tgp} \title{ Plotting for Treed Gaussian Process Models } \description{ A generic function for plotting of \code{"tgp"}-class objects. 1-d posterior mean and error plots, 2-d posterior mean and error image and perspective plots, and 3+-dimensional mean and error image and perspective plots are supported via projection and slicing. } \usage{ \method{plot}{tgp}(x, pparts = TRUE, proj = NULL, slice = NULL, map = NULL, as = NULL, center = "mean", layout = "both", main = NULL, xlab = NULL, ylab = NULL, zlab = NULL, pc = "pc", gridlen = c(40,40), span = 0.1, pXX = TRUE, legendloc = "topright", maineff = TRUE, mrlayout="both", rankmax = 20, ...) } \arguments{ \item{x}{ \code{"tgp"}-class object that is the output of one of the \code{b*} functions: \code{\link{blm}}, \code{\link{btlm}} \code{\link{bgp}}, \code{\link{bgpllm}}, \code{\link{btgp}}, or \code{\link{btgpllm}}} \item{pparts}{If \code{TRUE}, partition-regions are plotted (default), otherwise they are not} \item{proj}{1-or-2-Vector describing the dimensions to be shown in a projection. The argument is ignored for 1-d data, i.e., if \code{x$d == 1}. For 2-d data, no projection needs be specified--- the default argument (\code{proj = NULL}) will result in a 2-d perspective or image plot. 1-d projections of 2-d or higher data are are supported, e.g., \code{proj = c(2)} would show the second variable projection. For 3-d data or higher, \code{proj=NULL} defaults to \code{proj = c(1,2)} which plots a 2-d projection for the first two variables. Slices have priority over the projections--- see next argument (\code{slice})--- when non-null arguments are provided for both.} \item{slice}{\code{list} object with \code{x} and \code{z} fields, which are vectors of equal length describing the slice to be plotted, i.e., which z-values of the \code{x$d - 2} inputs \code{x$X} and \code{x$XX} should be fixed to in order to obtain a 2-d visualization. For example, for 4-d data, \code{slice = list(x=(2,4), z=c(0.2, 1.5)} will result in a 2-d plot of the first and third dimensions which have the second and fourth slice fixed at 0.5 and 1.5. The default is \code{NULL}, yielding to the \code{proj} argument. Argument is ignored for 1-d data, i.e., if \code{x$d == 1}} \item{map}{Optional 2-d map (longitude and latitude) from \pkg{maps} to be shown on top of image plots} \item{center}{Default \code{center = "mean"} causes the posterior predictive mean to be plotted as the centering statistic. Otherwise the median can be used with \code{center = "med"}, or the kriging mean with \code{center = "km"}} \item{as}{Optional string indicator for plotting of adaptive sampling statistics: specifying \code{as = "alm"} for ALM, \code{as = "s2"} for predictive variance, \code{as = "ks2"} for expected kriging variance, \code{as = "alc"} for ALC, and \code{as = "improv"} for expected improvement (about the minimum, see the \code{rankmax} argument below). The default \code{as = NULL} plots error-bars (1d-plots) or error magnitudes (2d-plots), which is essentially the same as \code{as = "alm"}} \item{layout}{Specify whether to plot the mean predictive surface (\code{layout = "surf"}), the error or adaptive sampling statistics (\code{layout = "as"}), or default (\code{layout = "both"}) which shows both. If \code{layout = "sens"}, plot the results of a sensitivity analysis (see \code{\link{sens}}) in a format determined by the argument \code{maineff} below. } \item{main}{Optional \code{character} string to add to the main title of the plot} \item{xlab}{Optional \code{character} string to add to the x label of the plots} \item{ylab}{Optional \code{character} string to add to the y label of the plots} \item{zlab}{Optional \code{character} string to add to the z label of the plots; ignored unless \code{pc = "p"}} \item{pc}{ Selects perspective-posterior mean and image-error plots (\code{pc = "pc"}, the default) or a double--image plot (\code{pc = "c"})} (only valid for 2-d plots) \item{gridlen}{ Number of regular grid points for 2-d slices and projections in x and y. The default of \code{gridlen = c(40,40)} causes a \code{40 * 40} grid of \code{X}, \code{Y}, and \code{Z} values to be computed. Ignored for 1-d plots and projections} \item{span}{ Span for \code{\link[stats]{loess}} kernel. The \pkg{tgp} package default (\code{span = 0.1}) is set lower than the \code{\link[stats]{loess}} default. Smaller spans can lead to warnings from \code{\link[stats]{loess}} when the data or predictive locations are sparse and ugly plots may result. In this case, try increasing the span} \item{pXX}{ scalar logical indicating if \code{XX} locations should be plotted } \item{legendloc}{ Location of the \code{\link{legend}} included in the plots of sensitivity analyses produced with \code{layout = "sens"}, or 1-d plots of multi-resolution models (with \code{corr = "mrexpsep"}) and option \code{mrlayout = "both"}; otherwise the argument is ignored} \item{maineff}{ Format for the plots of sensitivity analyses produced with \code{layout = "sens"}; otherwise the argument is ignored. If \code{maineff=TRUE} main effect plots are produced alongside boxplots for posterior samples of the sensitivity indices, and if \code{FALSE} only the boxplots are produced. Alternatively, \code{maineff} can be a matrix containing input dimensions in the configuration that the corresponding main effects are to be plotted; that is, \code{mfrow=dim(maineff)}. In this case, a 90 percent interval is plotted with each main effect and the sensitivity index boxplots are not plotted.} \item{mrlayout}{ The plot layout for double resolution tgp objects with \code{params$corr == "mrexpsep"}. For the default \code{mrlayout="both"}, the coarse and fine fidelity are plotted together, either on the same plot for 1D inputs or through side-by-side image plots of the predicted \code{center} with axis determined by \code{proj} for inputs of greater dimension. Note that many of the standard arguments -- such as \code{slice}, \code{pc}, and \code{map} -- are either non-applicable or unsupported for \code{mrlayout="both"}. If \code{mrlayout="coarse"} or \code{mrlayout="fine"}, prediction for the respective fidelity is plotted as usual and all of the standard options apply.} \item{rankmax}{ When \code{as = "improv"} is provided, the posterior expected improvements are plotted according the the first column of the \code{improv} field of the \code{"tgp"}-class object. Text is added to the plot near the \code{XX} positions of the first \code{1:rankmax} predictive locations with the highest ranks in the second column of the \code{improv} field. } \item{\dots}{ Extra arguments to 1-d (\code{\link[graphics]{plot}}) and 2-d plotting functions \code{persp} and \code{image}} } \value{ The only output of this function is beautiful plots } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \references{ \url{https://bobby.gramacy.com/r_packages/tgp/} } \note{ This plotting function is provided with the intention that it will be used as an aid in the visualization of \code{"tgp"}-class objects. Users are encouraged to use the source code for this function in order to develop custom plotting functions. 1-d projections for 3-d or higher data are also available by specifying a 1-d projection argument (e.g. \code{proj=c(1)} for projecting onto the first input variable). For examples, see \code{vignette("tgp")} and the help files of those functions in "See Also", below } \seealso{ \code{\link[graphics]{plot}}, \code{\link{bgpllm}}, \code{\link{btlm}}, \code{\link{blm}}, \code{\link{bgp}}, \code{\link{btgpllm}}, \code{\link{predict.tgp}}, \code{\link{tgp.trees}}, \code{\link{mapT}}, \code{\link{loess}}, \code{\link{sens}}} \keyword{ hplot } \keyword{ tree } tgp/man/tgp.trees.Rd0000644000176200001440000000433513723731650014035 0ustar liggesusers\name{tgp.trees} \alias{tgp.trees} \title{ Plot the MAP Tree for each height encountered by the Markov Chain} \description{ Plot the maximum a' posteriori (MAP) tree as a function of tree height, and show the log posterior probabilities for comparison. } \usage{ tgp.trees(out, heights = NULL, main = NULL, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{out}{ \code{"tgp"}-class object which is the output of one the model functions with tree support (e.g. \code{\link{btgpllm}})} \item{heights}{ Index vector of length less than \code{length(out$trees)} describing trees to plot by their height. Default (\code{NULL}) is to plot all trees, one for each height encountered when sampling from the Markov chain of the tree posterior. This is equivalent to \code{heights = out$posts$height}. Specifying \code{heights = "map"} causes (only) the maximum a' posteriori (MAP) height tree to be plotted } \item{main}{ Optional character string to add to the main title of the plot} \item{\dots}{ Extra arguments to the \code{\link[maptree]{draw.tree}} function from \pkg{maptree}} } \details{ The maximum a' posteriori (MAP) tree encountered at each height (in the MCMC chain) is plotted, and the log posterior probabilities are shown for comparison. The text at the branches in the tree show the splitting variable and value. The text at the leaves show the number of input data points (\code{X} and \code{Z}) that fall into the region(s) along with an estimate of the variability therein. } \value{ The only output of this function is beautiful tree diagrams. } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \references{ \url{https://bobby.gramacy.com/r_packages/tgp/} } \note{ Plotting trees that the \pkg{maptree} library is installed, which itself requires that the \pkg{combinat} library also be installed. See \code{vignette("tgp")} and the examples sections of the functions under \dQuote{See Also}, below} \seealso{ \code{\link{bgpllm}}, \code{\link{btlm}}, \code{\link{blm}}, \code{\link{bgp}}, \code{\link{btgpllm}}, \code{\link{plot.tgp}}, \code{\link{mapT}}, \code{vignette("tgp")}} \keyword{ hplot } \keyword{ tree } tgp/man/mapT.Rd0000644000176200001440000000542013723713521013014 0ustar liggesusers\name{mapT} \alias{mapT} \title{ Plot the MAP partition, or add one to an existing plot } \description{ Plot the maximum a' posteriori (MAP) tree from a \code{"tgp"}-class object, or add one on top of an existing plot. Like \code{plot.tgp}, projections and slices of trees can be plotted as specified } \usage{ mapT(out, proj = NULL, slice = NULL, add = FALSE, lwd = 2, ...) } \arguments{ \item{out}{ \code{"tgp"}-class object which is the output of one the model functions with tree support (e.g. \code{\link{btgpllm}})} \item{proj}{1-or-2-Vector describing the dimensions to be shown in a projection. The argument is ignored for 1-d data, i.e., if \code{x$d == 1}. For 2-d data, no projection needs to be specified--- the default argument (\code{proj = NULL}) will result in a 2-d plot. 1-d projections of 2-d or higher trees are are supported, e.g., \code{proj = c(2)} would show the second variable projection. For 3-d data or higher, \code{proj=NULL} defaults to \code{proj = c(1,2)} which plots a 2-d projection of the trees for the first two variables. Slices have priority over projections--- see next argument (\code{slice})--- when non-null arguments are provided for both.} \item{slice}{\code{list} object with \code{x} and \code{z} fields, which are vectors of equal length describing the slice to be plotted, i.e., which z-values of the treed partitions in the \code{x$d - 2} inputs \code{x$X} and \code{x$XX} should be fixed to in order to obtain a 2-d visualization. For example, for 4-d data, \code{slice = list(x=(2,4), z=c(0.2, 1.5)} will result in a 2-d plot of the first and third dimensions which have the second and fourth slice fixed at 0.5 and 1.5. The default is \code{NULL}, yielding to the \code{proj} argument. Argument is ignored for 1-d data, i.e., if \code{x$d == 1}} \item{add}{ Specify whether the to add partitions to an existing plot (\code{add = TRUE}) or to make a new plot showing the data \code{out$X} along with the partitions (default \code{add = FALSE})} \item{lwd}{ Plotting argument specifying the width of the lines used to depict the partitions} \item{...}{ Additional arguments to \code{plot} used when \code{add = FALSE}} } \value{ The only output of this function is a beautiful region-representation of the MAP tree. } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \references{ \url{https://bobby.gramacy.com/r_packages/tgp/} } \note{ For examples, see \code{vignette("tgp")} and the examples provided in the documentation for the \code{\link{tgp.design}} function } \seealso{ \code{\link{plot.tgp}}, \code{\link{tgp.trees}}, \code{\link{tgp.design}}, \code{vignette("tgp")}} \keyword{ hplot } \keyword{ tree } tgp/man/tgp-internal.Rd0000644000176200001440000000257413723712726014534 0ustar liggesusers\name{tgp-internal} %% Part of the sensible export list but (currently?) documented as %% internal (or waiting for documentation to be written): %% \alias{tgp} \alias{tree2c} \alias{tgp.postprocess} \alias{print.tgptraces} \alias{tgp.read.XX.traces} \alias{tgp.read.traces} \alias{tgp.cleanup} \alias{tgp.choose.as} \alias{tgp.choose.center} \alias{tgp.check.params} \alias{tgp.partition} \alias{tgp.get.trees} \alias{tgp.plot.tree} \alias{tgp.plot.parts.1d} \alias{tgp.plot.parts.2d} \alias{tgp.plot.slice} \alias{tgp.plot.proj} \alias{tgp.cands} \alias{framify.X} \alias{slice.interp} \alias{slice.image} \alias{slice.image.contour} \alias{slice.contour} \alias{slice.persp} \alias{mean0.range1} \alias{undo.mean0.range1} \alias{check.matrix} \alias{mr.checkrez} \alias{check.itemps} \alias{check.slice} \alias{check.proj} \alias{check.sens} \alias{getlocs} \alias{print.tgp} \alias{sens.plot} \alias{mr.plot} \alias{mr.checkres} %% %% Currently (?) exported as used in the grid.layout.Rd \example ... %% \alias{layout.torture} %% \title{Internal Treed Gaussian Process Model Functions} \description{ Internal Treed Gaussian Process Model functions } \details{ These are not to be called by the user (or in some cases are just waiting for proper documentation to be written :)). } \references{ \url{https://bobby.gramacy.com/r_packages/tgp/} } \keyword{ internal } tgp/man/exp2d.Z.Rd0000644000176200001440000000503213724022653013344 0ustar liggesusers\name{exp2d.Z} \alias{exp2d.Z} \title{ Random Z-values for 2-d Exponential Data } \description{ Evaluate the functional (mean) response for the 2-d exponential data (truth) at the \code{X} inputs, and randomly sample noisy \code{Z}--values having normal error with standard deviation provided. } \usage{exp2d.Z(X, sd=0.001)} \arguments{ \item{X}{Must be a \code{matrix} or a \code{data.frame} with two columns describing input locations} \item{sd}{Standard deviation of iid normal noise added to the responses} } \value{ Output is a \code{data.frame} with columns: \item{Z}{Numeric vector describing the responses (with noise) at the \code{X} input locations} \item{Ztrue}{Numeric vector describing the true responses (without noise) at the \code{X} input locations} } \details{ The response is evaluated as \deqn{Z(X)=x_1 * \exp(x_1^2-x_2^2).}{Z(X) = X1 * exp(-X1^2-X2^2),} thus creating the outputs \code{Z} and \code{Ztrue}. Zero-mean normal noise with \code{sd=0.001} is added to the responses \code{Z} and \code{ZZ} } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \references{ Gramacy, R. B. (2020) \emph{Surrogates: Gaussian Process Modeling, Design and Optimization for the Applied Sciences}. Boca Raton, Florida: Chapman Hall/CRC. \url{https://bobby.gramacy.com/surrogates/} Gramacy, R. B. (2007). \emph{\pkg{tgp}: An \R Package for Bayesian Nonstationary, Semiparametric Nonlinear Regression and Design by Treed Gaussian Process Models.} Journal of Statistical Software, \bold{19}(9). \url{https://www.jstatsoft.org/v19/i09} Robert B. Gramacy, Matthew Taddy (2010). \emph{Categorical Inputs, Sensitivity Analysis, Optimization and Importance Tempering with \pkg{tgp} Version 2, an \R Package for Treed Gaussian Process Models.} Journal of Statistical Software, \bold{33}(6), 1--48. \url{https://www.jstatsoft.org/v33/i06/}. Gramacy, R. B., Lee, H. K. H. (2008). \emph{Bayesian treed Gaussian process models with an application to computer modeling}. Journal of the American Statistical Association, 103(483), pp. 1119-1130. Also available as ArXiv article 0710.4536 \url{https://arxiv.org/abs/0710.4536} \url{https://bobby.gramacy.com/r_packages/tgp/} } \seealso{\code{\link{exp2d}}, \code{\link{exp2d.rand}}} \examples{ N <- 20 x <- seq(-2,6,length=N) X <- expand.grid(x, x) Zdata <- exp2d.Z(X) persp(x,x,matrix(Zdata$Ztrue, nrow=N), theta=-30, phi=20, main="Z true", xlab="x1", ylab="x2", zlab="Ztrue") } \keyword{datagen} tgp/man/dopt.gp.Rd0000644000176200001440000000725413723731365013503 0ustar liggesusers\name{dopt.gp} \alias{dopt.gp} \title{Sequential D-Optimal Design for a Stationary Gaussian Process} \description{ Create sequential D-Optimal design for a stationary Gaussian process model of fixed parameterization by subsampling from a list of candidates } \usage{ dopt.gp(nn, X=NULL, Xcand, iter=5000, verb=0) } \arguments{ \item{nn}{ Number of new points in the design. Must be less than or equal to the number of candidates contained in \code{Xcand}, i.e., \code{nn <= nrow(Xcand)}} \item{X}{ \code{data.frame}, \code{matrix} or vector of input locations which are forced into (already in) the design} \item{Xcand}{ \code{data.frame}, \code{matrix} or vector of candidates from which new design points are subsampled. Must have the same dimension as \code{X}, i.e., \code{ncol(X) == ncol(Xcand)}} \item{iter}{number of iterations of stochastic accent algorithm, default \code{5000}} \item{verb}{positive integer indicating after how many rounds of stochastic approximation to print each progress statement; default \code{verb=0} results in no printing} } \details{ Design is based on a stationary Gaussian process model with stationary isotropic exponential correlation function with parameterization fixed as a function of the dimension of the inputs. The algorithm implemented is a simple stochastic ascent which maximizes \code{det(K)}-- the covariance matrix constructed with locations \code{X} and a subset of \code{Xcand} of size \code{nn}. The selected design is \emph{locally} optimal } \value{ The output is a list which contains the inputs to, and outputs of, the C code used to find the optimal design. The chosen design locations can be accessed as list members \code{XX} or equivalently \code{Xcand[fi,]}. \item{X}{Input argument: \code{data.frame} of inputs \code{X}, can be \code{NULL}} \item{nn}{Input argument: number new points in the design} \item{Xcand}{Input argument: \code{data.frame} of candidate locations \code{Xcand}} \item{ncand}{Number of rows in \code{Xcand}, i.e., \code{nncand = dim(Xcand)[1]}} \item{fi}{Vector of length \code{nn} describing the selected new design locations as indices into \code{Xcand}} \item{XX}{\code{data.frame} of selected new design locations, i.e., \code{XX = Xcand[fi,]}} } \references{ Gramacy, R. B. (2020) \emph{Surrogates: Gaussian Process Modeling, Design and Optimization for the Applied Sciences}. Boca Raton, Florida: Chapman Hall/CRC. (See Chapter 6.) \url{https://bobby.gramacy.com/surrogates/} Chaloner, K. and Verdinelli, I. (1995). \emph{Bayesian experimental design: A review.} Statist. Sci., 10, (pp. 273--304). } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \note{ Inputs \code{X, Xcand} containing \code{NaN, NA, Inf} are discarded with non-fatal warnings. If \code{nn > dim(Xcand)[1]} then a non-fatal warning is displayed and execution commences with \code{nn = dim(Xcand)[1]} In the current version there is no progress indicator. You will have to be patient. Creating D-optimal designs is no speedy task } \seealso{ \code{\link{tgp.design}}, \code{\link{lhs}}} \examples{ # # 2-d Exponential data # (This example is based on random data. # It might be fun to run it a few times) # # get the data exp2d.data <- exp2d.rand() X <- exp2d.data$X; Z <- exp2d.data$Z Xcand <- exp2d.data$XX # find a treed sequential D-Optimal design # with 10 more points dgp <- dopt.gp(10, X, Xcand) # plot the d-optimally chosen locations # Contrast with locations chosen via # the tgp.design function plot(X, pch=19, xlim=c(-2,6), ylim=c(-2,6)) points(dgp$XX) } \keyword{ design } \keyword{ spatial } \keyword{ optimize } tgp/man/interp.loess.Rd0000644000176200001440000000663613723713475014562 0ustar liggesusers\name{interp.loess} \alias{interp.loess} \title{ Lowess 2-d interpolation onto a uniform grid } \description{ Use the \code{\link[stats]{loess}} function to interpolate the two-dimensional \code{x}, \code{y}, and \code{z} data onto a uniform grid. The output produced is an object directly usable by the plotting functions \code{\link[graphics]{persp}}, \code{\link[graphics]{image}}, and \code{\link[graphics]{contour}}, etc. This function is designed as an alternative to the \code{\link[akima]{interp}} functions from the \pkg{akima} library. } \usage{ interp.loess(x, y, z, gridlen = c(40,40), span = 0.1, ...) } \arguments{ \item{x}{ Vector of \code{X} spatial input locations } \item{y}{ Vector of \code{Y} spatial input locations } \item{z}{ Vector of \code{Z} responses interpreted as \code{Z = f(X,Y)}} \item{gridlen}{ Size of the interpolated grid to be produced in x and y. The default of \code{gridlen = c(40,40)} causes a \code{40 * 40} grid of \code{X}, \code{Y}, and \code{Z} values to be computed.} \item{span}{ Kernel span argument to the \code{\link[stats]{loess}} function with default setting \code{span = 0.1} set significantly lower than the the \code{\link[stats]{loess}} default -- see note below. } \item{\dots}{ Further arguments to be passed to the \code{\link[stats]{loess}} function} } \details{ Uses \code{\link[base]{expand.grid}} function to produce a uniform grid of size \code{gridlen} with domain equal to the rectangle implied by \code{X} and \code{Y}. Then, a \code{\link[stats]{loess}} a smoother is fit to the data \code{Z = f(X,Y)}. Finally, \code{\link[stats]{predict.loess}} is used to predict onto the grid. } \value{ The output is a list compatible with the 2-d plotting functions \code{\link[graphics]{persp}}, \code{\link[graphics]{image}}, and \code{\link[graphics]{contour}}, etc. The list contains... \item{x }{Vector of with \code{length(x) == gridlen} of increasing \code{X} grid locations} \item{y }{Vector of with \code{length(y) == gridlen} of increasing \code{Y} grid locations} \item{z }{\code{matrix} of interpolated responses \code{Z = f(X,Y)} where \code{z[i,j]} contains an estimate of \code{f(x[i],y[j])}} } \references{ \url{https://bobby.gramacy.com/r_packages/tgp/} } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \note{ As mentioned above, the default \code{span = 0.1} parameter is significantly smaller that the default \code{\link[stats]{loess}} setting. This asserts a tacit assumption that the input is densely packed and that the noise in \code{z}'s is small. Such should be the case when the data are output from a \pkg{tgp} regression -- this function was designed specifically for this situation. For data that is random or sparse, simply choose higher setting, e.g., the default \code{\link[stats]{loess}} setting of \code{span = 0.75}, or a more intermediate setting of \code{span = 0.5} as in the example below} \seealso{ \code{\link[akima]{interp}}, \code{\link[stats]{loess}}, \code{\link{persp}}, \code{\link{image}}, \code{\link{contour}} } \examples{ # random data ed <- exp2d.rand() # higher span = 0.5 required because the data is sparse # and was generated randomly ed.g <- interp.loess(ed$X[,1], ed$X[,2], ed$Z, span=0.5) # perspective plot persp(ed.g) } \keyword{ smooth } \keyword{ loess } tgp/man/tgp.design.Rd0000644000176200001440000001167013724735422014166 0ustar liggesusers\name{tgp.design} \alias{tgp.design} \title{ Sequential Treed D-Optimal Design for Treed Gaussian Process Models } \description{ Based on the maximum a' posteriori (MAP) treed partition extracted from a \code{"tgp"}-class object, calculate independent sequential treed D-Optimal designs in each of the regions. } \usage{ tgp.design(howmany, Xcand, out, iter = 5000, verb = 0) } \arguments{ \item{howmany}{Number of new points in the design. Must be less than the number of candidates contained in \code{Xcand}, i.e., \code{howmany <= nrow(Xcand)}} \item{Xcand}{ \code{data.frame}, \code{matrix} or vector of candidates from which new design points are subsampled. Must have \code{nrow(Xcand) == nrow(out$X)} } \item{out}{ \code{"tgp"}-class object output from one of the model functions which has tree support, e.g., \code{\link{btgpllm}}, \code{\link{btgp}}, \code{\link{btlm}}} \item{iter}{number of iterations of stochastic accent algorithm, default \code{5000}} \item{verb}{positive integer indicating after how many rounds of stochastic approximation in \code{\link{dopt.gp}} to print each progress statement; default \code{verb=0} results in no printing} } \details{ This function partitions \code{Xcand} and \code{out$X} based on the MAP tree (obtained on \code{"tgp"}-class \code{out} with \code{\link{partition}}) and calls \code{\link{dopt.gp}} in order to obtain a D-optimal design under independent stationary Gaussian processes models defined in each region. The aim is to obtain a design where new points from \code{Xcand} are spaced out relative to themselves, and relative to the existing locations (\code{out$X}) in the region. The number of new points from each region of the partition is proportional to the number of candidates \code{Xcand} in the region. } \value{ Output is a list of \code{data.frame}s containing \code{XX} design points for each region of the MAP tree in \code{out} } \references{ Gramacy, R. B. (2020) \emph{Surrogates: Gaussian Process Modeling, Design and Optimization for the Applied Sciences}. Boca Raton, Florida: Chapman Hall/CRC. (See Chapter 9.) \url{https://bobby.gramacy.com/surrogates/} Gramacy, R. B. (2008). \emph{\pkg{tgp}: An \R Package for Bayesian Nonstationary, Semiparametric Nonlinear Regression and Design by Treed Gaussian Process Models.} Journal of Statistical Software, \bold{19}(9). \url{https://www.jstatsoft.org/v19/i09} Robert B. Gramacy, Matthew Taddy (2010). \emph{Categorical Inputs, Sensitivity Analysis, Optimization and Importance Tempering with \pkg{tgp} Version 2, an \R Package for Treed Gaussian Process Models.} Journal of Statistical Software, \bold{33}(6), 1--48. \url{https://www.jstatsoft.org/v33/i06/}. Gramacy, R. B., Lee, H. K. H. (2006). \emph{Adaptive design and analysis of supercomputer experiments.} Technometrics, 51(2), pp. 130-145. Also avaliable on ArXiv article 0805.4359 \url{https://arxiv.org/abs/0805.4359} Gramacy, R. B., Lee, H. K. H., \& Macready, W. (2004). \emph{Parameter space exploration with Gaussian process trees.} ICML (pp. 353--360). Omnipress \& ACM Digital Library. \url{https://bobby.gramacy.com/r_packages/tgp/} } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \note{ Input \code{Xcand} containing \code{NaN, NA, Inf} are discarded with non-fatal warnings D-Optimal computation in each region is preceded by a print statement indicated the number of new locations to be chosen and the number of candidates in the region. Other than that, there are no other indicators of progress. You will have to be patient. Creating treed sequential D-optimal designs is no speedy task. At least it faster than the non-treed version (see \code{\link{dopt.gp}}). The example below is also part of \code{vignette("tgp")}. Please see \code{vignette("tgp2")} for a similar example based on optimization using the \code{\link{optim.step.tgp}} } \seealso{ \code{\link{bgpllm}}, \code{\link{btlm}}, \code{\link{blm}}, \code{\link{bgp}}, \code{\link{btgpllm}}, \code{\link{plot.tgp}}, \code{\link{dopt.gp}}, \code{\link{lhs}}, \code{\link{partition}}, \code{\link{optim.step.tgp}}} \examples{ \donttest{ # # 2-d Exponential data # (This example is based on random data. # It might be fun to run it a few times) # # get the data exp2d.data <- exp2d.rand() X <- exp2d.data$X; Z <- exp2d.data$Z Xcand <- exp2d.data$XX # fit treed GP LLM model to data w/o prediction # basically just to get MAP tree (and plot it) out <- btgpllm(X=X, Z=Z, pred.n=FALSE, corr="exp") tgp.trees(out) # find a treed sequential D-Optimal design # with 10 more points. It is interesting to # contrast this design with one obtained via # the dopt.gp function XX <- tgp.design(10, Xcand, out) # now fit the model again in order to assess # the predictive surface at those new design points dout <- btgpllm(X=X, Z=Z, XX=XX, corr="exp") plot(dout) } } \keyword{ design } \keyword{ optimize } \keyword{ spatial } \keyword{ tree } tgp/man/tgp.default.params.Rd0000644000176200001440000002115313724022754015615 0ustar liggesusers\name{tgp.default.params} \alias{tgp.default.params} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Default Treed Gaussian Process Model Parameters } \description{ Construct a default list of parameters to the \code{b*} functions-- the interfaces to treed Gaussian process modeling } \usage{ tgp.default.params(d, meanfn = c("linear", "constant"), corr = c("expsep", "exp", "mrexpsep", "matern", "sim", "twovar"), splitmin = 1, basemax = d, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{d}{ number of input dimensions \code{ncol(X)}} \item{meanfn}{ A choice of mean function for the process. When \code{meanfn = "linear"} (default), then we have the process \deqn{Z = (\mathbf{1} \;\; \mathbf{X}) \mbox{\boldmath $\beta$} + W(\mathbf{X})}{Z = cbind(rep(1,nrow(X), X)) \%*\% beta + W(X),} where \eqn{W(\mathbf{X})}{W(X)} represents the Gaussian process part of the model (if present). Otherwise, when \code{meanfn = "constant"}, then\deqn{Z = \beta_0 + W(\mathbf{X})}{ Z = beta0 + W(X)}} \item{corr}{ Gaussian process correlation model. Choose between the isotropic power exponential family (\code{"exp"}) or the separable power exponential family (\code{"expsep"}, default); the current version also supports the isotropic Matern (\code{"matern"}) and single-index model (\code{"sim"}) and \code{"twovar"} as \dQuote{beta} functionality. The option \code{"mrexpsep"} uses a multi-resolution GP model, a depricated feature in the package (docs removed)} \item{splitmin}{ Indicates which column of the inputs \code{X} should be the first to allow splits via treed partitioning. This is useful for excluding certain input directions from the partitioning mechanism} \item{basemax}{ Indicates which column of the inputs \code{X} should be the last be fit under the base model (e.g., LM or GP). This is useful for allowing some input directions (e.g., binary indicators) to only influence the tree partitioning mechanism, and not the base model(s) at the leaves of the tree} \item{...}{ These ellipses arguments are interpreted as augmentations to the prior specification. You may use these to specify a custom setting of any of default parameters in the output list detailed below} } \value{ The output is the following list of \code{params}... \item{col}{dimension of regression coefficients \eqn{\mbox{\boldmath $\beta$}}{beta}: 1 for input \code{meanfn = "constant"}, or \code{ncol(X)+1} for \code{meanfn = "linear"}} \item{meanfn}{ copied from the inputs } \item{corr}{ copied from the inputs } \item{bprior}{Linear (beta) prior, default is \code{"bflat"} which gives an \dQuote{improper} prior which can perform badly when the signal-to-noise ratio is low. In these cases the \dQuote{proper} hierarchical specification \code{"b0"}, \code{"bmzt"}, or \code{"bmznot"} prior may perform better } \item{beta}{\code{rep(0,col)} starting values for beta linear parameters} \item{tree}{\code{c(0.5,2,max(c(10,col+1)),1,d)} indicating the tree prior process parameters \eqn{\alpha}{alpha}, \eqn{\beta}{beta}, \emph{minpart}, \emph{splitmin} and \emph{basemax}: \deqn{p_{\mbox{\tiny split}}(\eta, \mathcal{T}) = \alpha*(1+\eta)^\beta}{p(split leaf eta) = alpha*(1+depth(eta))^(-beta)} with zero probability given to trees with partitions containing less than \code{nmin} data points; \emph{splitmin} indicates the first column of \code{X} which where treed partitioning is allowed; \emph{basemax} gives the last column where the base model is used} \item{s2.p}{\code{c(5,10)} \eqn{\sigma^2}{s2} inverse-gamma prior parameters \code{c(a0, g0)} where \code{g0} is rate parameter} \item{tau2.p}{\code{c(5,10)} \eqn{\tau^2}{tau2} inverse-gamma prior parameters \code{c(a0, g0)} where \code{g0} is rate parameter} \item{d.p}{c(1.0,20.0,10.0,10.0) Mixture of gamma prior parameter (initial values) for the range parameter(s) \code{c(a1,g1,a2,g2)} where \code{g1} and \code{g2} are rate parameters. If \code{corr="mrexpsep"}, then this is a vector of length 8: The first four parameters remain the same and correspond to the "coarse" process, and the second set of four values, which default to \code{c(1,10,1,10)}, are the equivalent prior parameters for the range parameter(s) in the residual "fine" process.} \item{nug.p}{\code{c(1,1,1,1)} Mixture of gamma prior parameter (initial values) for the nugget parameter \code{c(a1,g1,a2,g2)} where \code{g1} and \code{g2} are rate parameters; default reduces to simple exponential prior; specifying \code{nug.p = 0} fixes the nugget parameter to the \dQuote{starting} value in \code{gd[1]}, i.e., it is excluded from the MCMC} \item{gamma}{\code{c(10,0.2,10)} LLM parameters c(g, t1, t2), with growth parameter \code{g > 0} minimum parameter \code{t1 >= 0} and maximum parameter \code{t1 >= 0}, where \code{t1 + t2 <= 1} specifies \deqn{p(b|d)=t_1 + \exp\left\{\frac{-g(t_2-t_1)}{d-0.5}\right\}}{p(b|d)= t1 + exp(-g*(t2-t1)/(d-0.5))}} \item{d.lam}{\code{"fixed"} Hierarchical exponential distribution parameters to \code{a1}, \code{g1}, \code{a2}, and \code{g2} of the prior distribution for the range parameter \code{d.p}; \code{"fixed"} indicates that the hierarchical prior is \dQuote{turned off}} \item{nug.lam}{\code{"fixed"} Hierarchical exponential distribution parameters to \code{a1}, \code{g1}, \code{a2}, and \code{g2} of the prior distribution for the nug parameter \code{nug.p}; \code{"fixed"} indicates that the hierarchical prior is \dQuote{turned off}} \item{s2.lam}{\code{c(0.2,10)} Hierarchical exponential distribution prior for \code{a0} and \code{g0} of the prior distribution for the s2 parameter \code{s2.p}; \code{"fixed"} indicates that the hierarchical prior is \dQuote{turned off}} \item{tau2.lam}{\code{c(0.2,0.1)} Hierarchical exponential distribution prior for \code{a0} and \code{g0} of the prior distribution for the s2 parameter \code{tau2.p}; \code{"fixed"} indicates that the hierarchical prior is \dQuote{turned off}} \item{delta.p}{\code{c(1,1,1,1)} Parameters in the mixture of gammas prior on the delta scaling parameter for \code{corr="mrexpsep"}: \code{c(a1,g1,a2,g2)} where \code{g1} and \code{g2} are rate parameters; default reduces to simple exponential prior. Delta scales the variance of the residual "fine" process with respect to the variance of the underlying "coarse" process. } \item{nugf.p}{\code{c(1,1,1,1)} Parameters in the mixture of gammas prior on the residual \dQuote{fine} process nugget parameter for \code{corr="mrexpsep"}: \code{c(a1,g1,a2,g2)} where \code{g1} and \code{g2} are rate parameters; default reduces to simple exponential prior.} \item{dp.sim}{\code{basemax * basemax} RW-MVN proposal covariance matrix for GP-SIM models; only appears when \code{corr="sim"}, the default is \code{diag(rep(0.2, basemax))}} } \references{ Gramacy, R. B. (2007). \emph{\pkg{tgp}: An \R Package for Bayesian Nonstationary, Semiparametric Nonlinear Regression and Design by Treed Gaussian Process Models.} Journal of Statistical Software, \bold{19}(9). \url{https://www.jstatsoft.org/v19/i09} Robert B. Gramacy, Matthew Taddy (2010). \emph{Categorical Inputs, Sensitivity Analysis, Optimization and Importance Tempering with \pkg{tgp} Version 2, an \R Package for Treed Gaussian Process Models.} Journal of Statistical Software, \bold{33}(6), 1--48. \url{https://www.jstatsoft.org/v33/i06/}. Gramacy, R. B., Lee, H. K. H. (2008). \emph{Bayesian treed Gaussian process models with an application to computer modeling}. Journal of the American Statistical Association, 103(483), pp. 1119-1130. Also available as ArXiv article 0710.4536 \url{https://arxiv.org/abs/0710.4536} Robert B. Gramacy, Heng Lian (2011). \emph{Gaussian process single-index models as emulators for computer experiments}. Available as ArXiv article 1009.4241 \url{https://arxiv.org/abs/1009.4241} \url{https://bobby.gramacy.com/r_packages/tgp/} } \author{ Robert B. Gramacy, \email{rbg@vt.edu}, and Matt Taddy, \email{mataddy@amazon.com} } \note{Please refer to the examples for the functions in "See Also" below, \code{vignette("tgp")} and \code{vignette(tgp2)} } \seealso{ \code{\link{blm}}, \code{\link{btlm}}, \code{\link{bgp}}, \code{\link{btgp}}, \code{\link{bgpllm}}, \code{\link{btgpllm}} } \keyword{ nonparametric } \keyword{ smooth } \keyword{ models } \keyword{ spatial } \keyword{ tree } tgp/DESCRIPTION0000644000176200001440000000230013731677332012561 0ustar liggesusersPackage: tgp Title: Bayesian Treed Gaussian Process Models Version: 2.4-17 Date: 2020-09-11 Author: Robert B. Gramacy and Matt A. Taddy Depends: R (>= 2.14.0) Imports: maptree Suggests: MASS Description: Bayesian nonstationary, semiparametric nonlinear regression and design by treed Gaussian processes (GPs) with jumps to the limiting linear model (LLM). Special cases also implemented include Bayesian linear models, CART, treed linear models, stationary separable and isotropic GPs, and GP single-index models. Provides 1-d and 2-d plotting functions (with projection and slice capabilities) and tree drawing, designed for visualization of tgp-class output. Sensitivity analysis and multi-resolution models are supported. Sequential experimental design and adaptive sampling functions are also provided, including ALM, ALC, and expected improvement. The latter supports derivative-free optimization of noisy black-box functions. Maintainer: Robert B. Gramacy License: LGPL URL: https://bobby.gramacy.com/r_packages/tgp/ NeedsCompilation: yes Packaged: 2020-09-11 12:43:32 UTC; bobby Repository: CRAN Date/Publication: 2020-09-20 16:10:02 UTC tgp/build/0000755000176200001440000000000013726670360012155 5ustar liggesuserstgp/build/vignette.rds0000644000176200001440000000041413726670360014513 0ustar liggesusersN0:Ii%$n, 2 . QSs c.'o$6+O^KFs3قպxVW$׃[I(\#Z ww [Q!A+4V6JϿ|uYElE>i5 #)#hg0DKwSdz+^}(j.SpD<[yًt?m~L§7Q6jC:6Z-uJuDX{}Y2t00tgp/src/0000755000176200001440000000000013726670363011650 5ustar liggesuserstgp/src/mr_exp_sep.cc0000644000176200001440000012605513531032535014314 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ extern "C" { #include "matrix.h" #include "lh.h" #include "lik_post.h" #include "rand_draws.h" #include "rand_pdf.h" #include "all_draws.h" #include "gen_covar.h" #include "rhelp.h" } #include "corr.h" #include "params.h" #include "model.h" #include "mr_exp_sep.h" #include #include #include #include #include #include using namespace std; #define BUFFMAX 256 #define PWR 2.0 /* * MrExpSep: * * constructor function; should be the same as ExpSep, * but for delta and nugaux */ MrExpSep::MrExpSep(unsigned int dim, Base_Prior *base_prior) : Corr(dim, base_prior) { K= new_id_matrix(n); /* Sanity Checks */ assert(base_prior->BaseModel() == GP); assert( ((Gp_Prior*) base_prior)->CorrPrior()->CorrModel() == MREXPSEP); /* set pointer to correllation priot from the base prior */ prior = ((Gp_Prior*) base_prior)->CorrPrior(); assert(prior); /* let the prior choose the starting nugget value */ nug = prior->Nug(); /* allocate and initialize (from prior) the range params */ d = new_dup_vector(((MrExpSep_Prior*)prior)->D(), 2*dim); /* start fully in the GP model, not the LLM */ b = new_ones_ivector(2*dim, 1); pb = new_zero_vector(2*dim); /* memory allocated for effective range parameter -- deff = d*b */ d_eff = new_dup_vector(d, 2*dim); /* counter of the number of d-rejections in a row */ dreject = 0; /* get the fine variance discount factor, and observation nugget for thefine level proc -- both fro prior */ delta = ((MrExpSep_Prior*)prior)->Delta(); nugaux = ((MrExpSep_Prior*)prior)->Nugaux(); } /* * MrExpSep (assignment operator): * * used to assign the parameters of one correlation * function to anothers. Both correlation functions * must already have been allocated */ Corr& MrExpSep::operator=(const Corr &c) { MrExpSep *e = (MrExpSep*) &c; /* sanity check */ assert(prior == ((Gp_Prior*) base_prior)->CorrPrior()); /* copy everything */ log_det_K = e->log_det_K; linear = e->linear; dim = e->dim; dupv(d, e->d, 2*dim); dupv(pb, e->pb, 2*dim); dupv(d_eff, e->d_eff, 2*dim); dupiv(b, e->b, 2*dim); nug = e->nug; dreject = e->dreject; /* copy the covariance matrices -- no longer performed due to the new economy argument in Gp/Base */ // Cov(e); return *this; } /* * ~MrExpSep: * * destructor */ MrExpSep::~MrExpSep(void) { free(d); free(b); free(pb); free(d_eff); } /* * Init: * * initialise this corr function with the parameters provided * from R via the vector of doubles */ void MrExpSep::Init(double *dmrexpsep) { dupv(d, &(dmrexpsep[3]), dim*2); if(!prior->Linear() && prior->LLM()) linear_pdf_sep(pb, d, dim, prior->GamLin()); bool lin = true; for(unsigned int i=0; i<2*dim; i++) { b[i] = (int) dmrexpsep[2*dim+1+i]; lin = lin && !b[i]; d_eff[i] = d[i] * b[i]; } if(prior->Linear()) assert(lin); NugInit(dmrexpsep[0], lin); nugaux = dmrexpsep[1]; delta = dmrexpsep[2]; } /* * Jitter: * * fill jitter[ ] with the observation variance factor. That is, * the variance for an observation at the same location as * data point 'i' will be s2*(jitter[i]). In standard tgp, the * jitter is simply the nugget. But for calibration and mr tgp, * the jitter value depends upon X (eg real or simulated data). * */ double* MrExpSep::Jitter(unsigned int n1, double **X) { double *jitter = new_vector(n1); for(unsigned int i=0; in); /* with probability 0.5, skip drawing the nugget */ if(runi(state) > 0.5) return false; /* make the draw */ if(!K) Update(n, K, X); double* new_nugs = mr_nug_draw_margin(n, col, nug, nugaux, X, F, Z, K, log_det_K, *lambda, Vb, K_new, Ki_new, Kchol_new, &log_det_K_new, &lambda_new, Vb_new, bmu_new, gp_prior->get_b0(), gp_prior->get_Ti(), gp_prior->get_T(), tau2, prior->NugAlpha(), prior->NugBeta(), ((MrExpSep_Prior*) prior)->Nugaux_alpha(), ((MrExpSep_Prior*) prior)->Nugaux_beta(), delta, gp_prior->s2Alpha(), gp_prior->s2Beta(), (int) linear, itemp, state); /* did we accept the draw? */ if(new_nugs[0] != nug) { nug = new_nugs[0]; nugaux = new_nugs[1]; success = true; swap_new(Vb, bmu, lambda); } /* clean up */ free(new_nugs); return success; } /* * Update: (symmetric) * * computes the internal correlation matrix K, * (INCLUDES NUGGET) */ void MrExpSep::Update(unsigned int n, double **K, double **X) { corr_symm(K, dim+1, X, n, d_eff, nug, nugaux, delta, PWR); } /* * Update: (symmetric) * * takes in a (symmetric) distance matrix and * returns a correlation matrix (INCLUDES NUGGET) */ void MrExpSep::Update(unsigned int n, double **X) { /* no need to update internal K if we're at LLM */ if(linear) return; /* sanity check */ assert(this->n == n); /* compute K */ corr_symm(K, dim+1, X, n, d_eff, nug, nugaux, delta, PWR); } /* * Update: (non-symmetric) * * takes in a distance matrix and returns a * correlation matrix (DOES NOT INCLUDE NUGGET) */ void MrExpSep::Update(unsigned int n1, unsigned int n2, double **K, double **X, double **XX) { corr_unsymm(K, dim+1, XX, n1, X, n2, d_eff, delta, PWR); } /* * propose_new_d: * * propose new d and b values. Sometimes propose d's and b's for all * dimensions jointly, sometimes do just the d's with b==1, and * other times do only those with b==0. I have found that this improves * mixing */ bool MrExpSep::propose_new_d(double* d_new, int * b_new, double *pb_new, double *q_fwd, double *q_bak, void *state) { *q_bak = *q_fwd = 1.0; /* copy old values */ dupv(d_new, d, 2*dim); dupv(pb_new, pb, 2*dim); dupiv(b_new, b, 2*dim); /* RW proposal for all d-values */ d_proposal(2*dim, NULL, d_new, d, q_fwd, q_bak, state); /* if we are allowing the LLM, then we need to draw the b_new conditional on d_new; otherwise just return */ /* only drawing the first dim booleans (i.e. coarse model only) */ if(prior->LLM()) return linear_rand_sep(b_new,pb_new,d_new,dim,prior->GamLin(),state); else return false; } /* * Draw: * * draw parameters for a new correlation matrix; * returns true if the correlation matrix (passed in) * has changed; otherwise returns false */ int MrExpSep::Draw(unsigned int n, double **F, double **X, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state) { int success = 0; bool lin_new; double q_fwd, q_bak; /* get more accessible pointers to the priors */ MrExpSep_Prior* ep = (MrExpSep_Prior*) prior; Gp_Prior *gp_prior = (Gp_Prior*) base_prior; /* pointers to proposed settings of parameters */ double *d_new = NULL; int *b_new = NULL; double *pb_new = NULL; /* proposals happen when we're not forcing the LLM */ if(prior->Linear()) lin_new = true; else { /* allocate new d, b, and pb */ d_new = new_zero_vector((2*dim)); b_new = new_ivector((2*dim)); pb_new = new_vector((2*dim)); /* make the RW proposal for d, and then b */ lin_new = propose_new_d(d_new, b_new, pb_new, &q_fwd, &q_bak, state); } /* calculate the effective model (d_eff = d*b), and allocate memory -- when we're not proposing the LLM */ double *d_new_eff = NULL; if(! lin_new) { d_new_eff = new_zero_vector((2*dim)); for(unsigned int i=0; i<(2*dim); i++) d_new_eff[i] = d_new[i]*b_new[i]; /* allocate K_new, Ki_new, Kchol_new */ allocate_new(n); /* sanity check */ assert(n == this->n); } /* compute the acceptance ratio, unless we're forcing the LLM in which case we do nothing just return a successful "draw" */ if(prior->Linear()) success = 1; else { /* compute prior ratio and proposal ratio */ double pRatio_log = 0.0; double qRatio = q_bak/q_fwd; pRatio_log += ep->log_DPrior_pdf(d_new); pRatio_log -= ep->log_DPrior_pdf(d); /* MH acceptance ratio for the draw */ success = d_draw(d_new_eff, n, col, F, X, Z, log_det_K,*lambda, Vb, K_new, Ki_new, Kchol_new, &log_det_K_new, &lambda_new, Vb_new, bmu_new, gp_prior->get_b0(), gp_prior->get_Ti(), gp_prior->get_T(), tau2, nug, nugaux, qRatio, pRatio_log, gp_prior->s2Alpha(), gp_prior->s2Beta(), (int) lin_new, itemp, state); /* see if the draw was acceptedl; if so, we need to copy (or swap) the contents of the new into the old */ if(success == 1) { swap_vector(&d, &d_new); /* d_eff is zero if we're in the LLM */ if(!lin_new) swap_vector(&d_eff, &d_new_eff); else zerov(d_eff, (2*dim)); linear = (bool) lin_new; /* copy b and pb */ swap_ivector(&b, &b_new); swap_vector(&pb, &pb_new); swap_new(Vb, bmu, lambda); } } /* if we're not forcing the LLM, then we have some cleadimg up to do */ if(! prior->Linear()) { free(d_new); free(pb_new); free(b_new); } /* if we didn't happen to jump to the LLM, then we have more cleaning up to do */ if(!lin_new) free(d_new_eff); /* something went wrong, abort; otherwise keep track of the number of d-rejections in a row */ if(success == -1) return success; else if(success == 0) dreject++; else dreject = 0; /* abort if we have had too many rejections */ if(dreject >= REJECTMAX) return -2; /* draw nuggets */ bool changed = DrawNugs(n, X, F, Z, lambda, bmu, Vb, tau2, itemp, state); bool deltasuccess = DrawDelta(n, X, F, Z, lambda, bmu, Vb, tau2, itemp, state); success = success || changed || deltasuccess; return success; } /* * Combine*: * * used in tree-prune steps, chooses one of two * sets of parameters to correlation functions, * and choose one for "this" correlation function */ double MrExpSep::CombineNugaux(MrExpSep *c1, MrExpSep *c2, void *state) { double nugch[2]; int ii[2]; nugch[0] = c1->Nugaux(); nugch[1] = c2->Nugaux(); propose_indices(ii,0.5, state); return nugch[ii[0]]; } double MrExpSep::CombineDelta(MrExpSep *c1, MrExpSep *c2, void *state) { double deltach[2]; int ii[2]; deltach[0] = c1->Delta(); deltach[1] = c2->Delta(); propose_indices(ii,0.5, state); return deltach[ii[0]]; } /* * Combine: * * used in tree-prune steps, chooses one of two * sets of parameters to correlation functions, * and choose one for "this" correlation function */ void MrExpSep::Combine(Corr *c1, Corr *c2, void *state) { get_delta_d((MrExpSep*)c1, (MrExpSep*)c2, state); CombineNug(c1, c2, state); nugaux = CombineNugaux((MrExpSep*)c1, (MrExpSep*)c2, state); delta = CombineDelta((MrExpSep*)c1, (MrExpSep*)c2, state); } /* * Split*: * * used in tree-grow steps, splits the parameters * of "this" correlation function into a parameterization * for two (new) correlation functions */ void MrExpSep::SplitNugaux(MrExpSep *c1, MrExpSep *c2, void *state) { int i[2]; double nugnew[2]; propose_indices(i, 0.5, state); nugnew[i[0]] = nugaux; nugnew[i[1]] = ((MrExpSep_Prior*)prior)->NugauxDraw(state); c1->SetNugaux(nugnew[0]); c2->SetNugaux(nugnew[1]); } void MrExpSep::SplitDelta(MrExpSep *c1, MrExpSep *c2, void *state) { int i[2]; double deltanew[2]; propose_indices(i, 0.5, state); deltanew[i[0]] = delta; deltanew[i[1]] = ((MrExpSep_Prior*)prior)->DeltaDraw(state); c1->SetDelta(deltanew[0]); c2->SetDelta(deltanew[1]); } /* * Split: * * used in tree-grow steps, splits the parameters * of "this" correlation function into a parameterization * for two (new) correlation functions */ void MrExpSep::Split(Corr *c1, Corr *c2, void *state) { propose_new_d((MrExpSep*) c1, (MrExpSep*) c2, state); SplitNug(c1, c2, state); SplitNugaux((MrExpSep*)c1, (MrExpSep*)c2, state); SplitDelta((MrExpSep*)c1, (MrExpSep*)c2, state); } void MrExpSep::SetNugaux(double nugauxnew){ nugaux = nugauxnew; } void MrExpSep::SetDelta(double deltanew){ delta = deltanew; } /* * get_delta_d: * * compute d from two ds residing in c1 and c2 * and sample b conditional on the chosen d * * (used in prune) */ void MrExpSep::get_delta_d(MrExpSep* c1, MrExpSep* c2, void *state) { /* ceate pointers to the two ds */ double **dch = (double**) malloc(sizeof(double*) * 2); dch[0] = c1->d; dch[1] = c2->d; /* randomly choose one of the ds */ int ii[2]; propose_indices(ii, 0.5, state); /* and copy the chosen one */ dupv(d, dch[ii[0]], (2*dim)); /* clean up */ free(dch); /* propose b conditional on the chosen d */ /* propose linear model only in coarse dimensions */ linear = linear_rand_sep(b, pb, d, dim, prior->GamLin(), state); /* compute d_eff = d * b for the chosen d and b */ for(unsigned int i=0; i<(2*dim); i++) d_eff[i] = d[i] * b[i]; } /* * propose_new_d: * * propose new D parameters for possible * new children partitions. */ void MrExpSep::propose_new_d(MrExpSep* c1, MrExpSep* c2, void *state) { int i[2]; double **dnew = new_matrix(2, (2*dim)); /* randomply choose which of c1 and c2 will get a copy of this->d, and which will get a random d from the prior */ propose_indices(i, 0.5, state); /* =from this->d */ dupv(dnew[i[0]], d, (2*dim)); /* from the prior */ draw_d_from_prior(dnew[i[1]], state); /* copy into c1 and c2 */ dupv(c1->d, dnew[0], (2*dim)); dupv(c2->d, dnew[1], (2*dim)); /* clean up */ delete_matrix(dnew); /* propose new b for c1 and c2, conditional on the two new d parameters */ c1->linear = (bool) linear_rand_sep(c1->b, c1->pb, c1->d, (2*dim), prior->GamLin(), state); c2->linear = (bool) linear_rand_sep(c2->b, c2->pb, c2->d, (2*dim), prior->GamLin(), state); /* compute d_eff = b*d for the two new b and d pairs */ for(unsigned int i=0; i<(2*dim); i++) { c1->d_eff[i] = c1->d[i] * c1->b[i]; c2->d_eff[i] = c2->d[i] * c2->b[i]; } } /* * d_draw: * * draws for d given the rest of the parameters except b and s2 marginalized out * * F[col][n], Kchol[n][n], K_new[n][n], Ti[col][col], T[col][col] Vb[col][col], * Vb_new[col][col], Ki_new[n][n], Kchol_new[n][n], b0[col], Z[n], dlast[dim*2], * d_alpha[dim*2][2], d_beta[dim*2][2] * * return 1 if draw accepted, 0 if rejected, -1 if error */ int MrExpSep::d_draw(double *d, unsigned int n, unsigned int col, double **F, double **X, double *Z, double log_det_K, double lambda, double **Vb, double **K_new, double **Ki_new, double **Kchol_new, double *log_det_K_new, double *lambda_new, double **VB_new, double *bmu_new, double *b0, double **Ti, double **T, double tau2, double nug, double nugaux, double qRatio, double pRatio_log, double a0, double g0, int lin, double itemp, void *state) { double pd, pdlast, alpha; unsigned int m = 0; /* Knew = dist_to_K(dist, d, nugget) compute lambda, Vb, and bmu, for the NEW d */ if(! lin) { /* regular */ corr_symm(K_new, dim+1, X, n, d, nug, nugaux, delta, PWR); inverse_chol(K_new, Ki_new, Kchol_new, n); *log_det_K_new = log_determinant_chol(Kchol_new, n); *lambda_new = compute_lambda(Vb_new, bmu_new, n, col, F, Z, Ki_new, Ti, tau2, b0, itemp); } else { /* linear */ *log_det_K_new = 0.0; double *Kdiag = new_vector(n); for(unsigned int i=0; iget_b0(); double a0 = gp_prior->s2Alpha(); double g0 = gp_prior->s2Beta(); /* allocate K_new, Ki_new, Kchol_new */ if(! linear) assert(n == this->n); if(runi(state) > 0.5) return false; double q_fwd; double q_bak; double pdelta; double pnewdelta; /* make the draw */ double newdelta = unif_propose_pos(delta, &q_fwd, &q_bak, state); // printf("%g %g\n", delta, newdelta); /* new covariace matrix based on new nug */ if(linear) { log_det_K_new = 0.0; double *Kdiag = new_vector(n); for(unsigned int i=0; iget_Ti(), tau2, b0, Kdiag, itemp); free(Kdiag); } else{ corr_symm(K_new, dim+1, X, n, d, nug, nugaux, newdelta, PWR); inverse_chol(K_new, Ki_new, Kchol_new, n); log_det_K_new = log_determinant_chol(Kchol_new, n); lambda_new = compute_lambda(Vb_new, bmu_new, n, col, F, Z, Ki_new, gp_prior->get_Ti(), tau2, b0, itemp); } if((gp_prior->get_T())[0][0] == 0) m = col; pnewdelta = gamma_mixture_pdf(newdelta, ep->Delta_alpha(), ep->Delta_beta()); pnewdelta += post_margin(n,col,lambda_new,Vb_new,log_det_K_new,a0-m,g0,itemp); pdelta = gamma_mixture_pdf(delta, ep->Delta_alpha(), ep->Delta_beta()); pdelta += post_margin(n,col,*lambda,Vb,log_det_K,a0-m,g0,itemp); /* accept or reject */ double alpha = exp(pnewdelta - pdelta)*(q_bak/q_fwd); if(runi(state) < alpha) { success = true; delta = newdelta; swap_new(Vb, bmu, lambda); } return success; } /* * draw_d_from_prior: * * get draws of separable d parameter from * the prior distribution */ void MrExpSep::draw_d_from_prior(double *d_new, void *state) { if(prior->Linear()) dupv(d_new, d, (2*dim)); else ((MrExpSep_Prior*)prior)->DPrior_rand(d_new, state); } /* * corr_symm: * * compute a (symmetric) correllation matrix from a seperable * exponential correllation function * * X[n][m], K[n][n] */ void MrExpSep::corr_symm(double **K, unsigned int m, double **X, unsigned int n, double *d, double nug, double nugaux, double delta, double pwr) { unsigned int i,j,k; double diff, fine; i = k = j = 0; for(i=0; ilog_Prior(d, b, pb, linear); return prob; } /* * sum_b: * * return the count of the number of linearizing * booleans set to one (the number of linear dimensions) */ unsigned int MrExpSep::sum_b(void) { unsigned int bs = 0; for(unsigned int i=0; i<(2*dim); i++) if(!b[i]) bs ++; /* sanity check */ if(bs == (2*dim)) assert(linear); return bs; } /* * ToggleLinear: * * make linear if not linear, otherwise * make not linear */ void MrExpSep::ToggleLinear(void) { if(linear) { /* force a full GP model */ linear = false; for(unsigned int i=0; i<(2*dim); i++) b[i] = 1; } else { /* force a full LLM */ linear = true; for(unsigned int i=0; i<(2*dim); i++) b[i] = 0; } /* set d_Eff = d * b */ for(unsigned int i=0; i<(2*dim); i++) d_eff[i] = d[i] * b[i]; } /* * D: * * return the vector of range parameters for the * separable exponential family of correlation function */ double* MrExpSep::D(void) { return d; } /* * Delta: * * return the fine fidelity discount factor, delta. */ double MrExpSep::Delta(void) { return delta; } /* * Nugaux: * * * return the fine fidelity observational error */ double MrExpSep::Nugaux(void) { return nugaux; } /* * TraceNames: * * return the names of the parameters recorded in MrExpSep::Trace() */ char** MrExpSep::TraceNames(unsigned int* len) { /* calculate the length of the trace vector, and allocate */ *len = 3 + 3*(dim) + 1; char **trace = (char**) malloc(sizeof(char*) * (*len)); /* copy the nugget */ trace[0] = strdup("nugc"); trace[1] = strdup("nugf"); trace[2] = strdup("delta"); /* copy the d-vector of range parameters */ for(unsigned int i=0; i<2*dim; i++) { trace[3+i] = (char*) malloc(sizeof(char) * (3 + (dim)/10 + 1)); sprintf(trace[3+i], "d%d", i+1); } /* copy the booleans */ for(unsigned int i=0; in); inverse_chol(K, Ki, Kchol, n); log_det_K = log_determinant_chol(Kchol, n); } else { assert(n > 0); log_det_K = n * log(1.0 + nug); } } /* * MrExpSep_Prior: * * constructor for the prior parameterization of the separable * exponential power distribution function */ MrExpSep_Prior::MrExpSep_Prior(const unsigned int dim) : Corr_Prior(dim) { corr_model = MREXPSEP; /* default starting values and initial parameterization */ d = ones((2*dim), 0.5); d_alpha = new_zero_matrix((2*dim), 2); d_beta = new_zero_matrix((2*dim), 2); default_d_priors(); /* set d_alpha and d_beta */ default_d_lambdas(); /* set d_alpha_lambda and d_beta_lambda */ /* defauly starting values for mr-specific parameters; these should probably be moved into a default_* function like the others */ delta = 1.0; nugaux = 0.01; delta_alpha = ones(2, 1.0); delta_beta = ones(2, 20.0); nugaux_alpha = ones(2, 1.0); nugaux_beta = ones(2, 1.0); } /* * Dup: * * duplicate this prior for the isotropic exponential * power family */ Corr_Prior* MrExpSep_Prior::Dup(void) { return new MrExpSep_Prior(this); } /* * MrExpSep_Prior (new duplicate) * * duplicating constructor for the prior distribution for * the separable exponential correlation function */ MrExpSep_Prior::MrExpSep_Prior(Corr_Prior *c) : Corr_Prior(c) { MrExpSep_Prior *e = (MrExpSep_Prior*) c; /* sanity check */ assert(e->corr_model == MREXPSEP); /* copy all parameters of the prior */ corr_model = e->corr_model; dupv(gamlin, e->gamlin, 3); dim = e->dim; d = new_dup_vector(e->d, (2*dim)); fix_d = e->fix_d; d_alpha = new_dup_matrix(e->d_alpha, (2*dim), 2); d_beta = new_dup_matrix(e->d_beta, (2*dim), 2); dupv(d_alpha_lambda, e->d_alpha_lambda, 2); dupv(d_beta_lambda, e->d_beta_lambda, 2); delta = e->delta; nugaux = e->nugaux; delta_alpha = new_dup_vector(e->delta_alpha, 2); delta_beta = new_dup_vector(e->delta_beta, 2); nugaux_alpha = new_dup_vector(e->nugaux_alpha, 2); nugaux_beta = new_dup_vector(e->nugaux_beta, 2); } /* * ~MrExpSep_Prior: * * destructor for the prior parameterization of the separable * exponential power distribution function */ MrExpSep_Prior::~MrExpSep_Prior(void) { free(d); delete_matrix(d_alpha); delete_matrix(d_beta); free(delta_alpha); free(delta_beta); free(nugaux_alpha); free(nugaux_beta); } /* * read_double: * * read the double parameter vector giving the user-secified * prior parameterization specified in R */ void MrExpSep_Prior::read_double(double *dparams) { /* read the parameters that have to to with the nugget */ read_double_nug(dparams); /* read the starting value(s) for the range parameter(s) */ for(unsigned int i=0; i<(2*dim); i++) d[i] = dparams[1]; /*MYprintf(MYstdout, "starting d="); printVector(d, (2*dim), MYstdout, HUMAN); */ /* reset the d parameter to after nugget and gamlin params */ dparams += 13; /* read d gamma mixture prior parameters */ double alpha[2], beta[2]; get_mix_prior_params_double(alpha, beta, dparams, "d"); for(unsigned int i=0; igetline(line, BUFFMAX); d[0] = atof(strtok(line, " \t\n#")); for(unsigned int i=1; i<(2*dim); i++) d[i] = d[0]; MYprintf(MYstdout, "starting d=", d); printVector(d, (2*dim), MYstdout, HUMAN); /* read d and nug-hierarchical parameters (mix of gammas) */ double alpha[2], beta[2]; ctrlfile->getline(line, BUFFMAX); get_mix_prior_params(alpha, beta, line, "d"); for(unsigned int i=0; i<(2*dim); i++) { dupv(d_alpha[i], alpha, 2); dupv(d_beta[i], beta, 2); } /* get the d prior mixture */ ctrlfile->getline(line, BUFFMAX); get_mix_prior_params(alpha, beta, line, "d"); dupv(delta_alpha, alpha, 2); dupv(delta_beta, beta, 2); /* get the nugget prior mixture */ ctrlfile->getline(line, BUFFMAX); get_mix_prior_params(alpha, beta, line, "nug"); dupv(nugaux_alpha, alpha, 2); dupv(nugaux_beta, beta, 2); /* d hierarchical lambda prior parameters */ ctrlfile->getline(line, BUFFMAX); strcpy(line_copy, line); if(!strcmp("fixed", strtok(line_copy, " \t\n#"))) { fix_d = true; MYprintf(MYstdout, "fixing d prior\n"); } else { fix_d = false; get_mix_prior_params(d_alpha_lambda, d_beta_lambda, line, "d lambda"); } } /* * default_d_priors: * * set d prior parameters * to default values */ void MrExpSep_Prior::default_d_priors(void) { for(unsigned int i=0; i<(2*dim); i++) { d_alpha[i][0] = 1.0; d_beta[i][0] = 20.0; d_alpha[i][1] = 10.0; d_beta[i][1] = 10.0; } } /* * default_d_lambdas: * * set d (lambda) hierarchical prior parameters * to default values */ void MrExpSep_Prior::default_d_lambdas(void) { d_alpha_lambda[0] = 1.0; d_beta_lambda[0] = 10.0; d_alpha_lambda[1] = 1.0; d_beta_lambda[1] = 10.0; fix_d = false; } /* * D: * * return the default range parameter vector */ double* MrExpSep_Prior::D(void) { return d; } /* * Delta: * * return the fine fidelity discount factor, delta. */ double MrExpSep_Prior::Delta(void) { return delta; } /* * Nugaux: * * return the fine fidelity observation error. */ double MrExpSep_Prior::Nugaux(void) { return nugaux; } /* * DAlpha: * * return the default/starting alpha matrix for the range * parameter mixture gamma prior */ double** MrExpSep_Prior::DAlpha(void) { return d_alpha; } /* * DBeta: * * return the default/starting beta matrix for the range * parameter mixture gamma prior */ double** MrExpSep_Prior::DBeta(void) { return d_beta; } /* * DeltaAlpha: * * return the default/starting alpha matrix for the scaled variance * parameter mixture gamma prior */ double* MrExpSep_Prior::Delta_alpha(void) { return delta_alpha; } /* * DeltaBeta: * * return the default/starting beta matrix for the scaled variance * parameter mixture gamma prior */ double* MrExpSep_Prior::Delta_beta(void) { return delta_beta; } /* * Nugaux_Alpha: * * return the default/starting alpha for the fine nugget * parameter mixture gamma prior */ double* MrExpSep_Prior::Nugaux_alpha(void) { return nugaux_alpha; } /* * Nugaux_Beta: * * return the default/starting beta matrix for the fine nugget * parameter mixture gamma prior */ double* MrExpSep_Prior::Nugaux_beta(void) { return nugaux_beta; } /* * DeltaDraw: * * sample a delta value from the prior */ double MrExpSep_Prior::DeltaDraw(void *state) { return gamma_mixture_rand(delta_alpha, delta_beta, state); } /* * NugauxDraw: * * sample a nugaux value from the prior */ double MrExpSep_Prior::NugauxDraw(void *state) { return nug_prior_rand(nugaux_alpha, nugaux_beta, state); } /* * Draw: * * draws for the hierarchical priors for the MrExpSep * correlation function which are contained in the params module * * inputs are howmany number of corr modules */ void MrExpSep_Prior::Draw(Corr **corr, unsigned int howmany, void *state) { /* don't do anything if we're fixing the prior for d */ if(!fix_d) { /* for gathering the d-s of each of the corr models; repeatedly used for each dimension */ double *d = new_vector(howmany); /* for each dimension */ for(unsigned int j=0; j<(2*dim); j++) { /* gather all of the d->parameters for the jth dimension from each of the "howmany" corr modules */ for(unsigned int i=0; iD())[j]; /* use those gathered d values to make a draw for the parameters for the prior of the jth d */ mixture_priors_draw(d_alpha[j], d_beta[j], d, howmany, d_alpha_lambda, d_beta_lambda, state); } /* clean up */ free(d); } /* hierarchical prior draws for the nugget */ DrawNugHier(corr, howmany, state); } /* * newCorr: * * construct and return a new separable MrExponential correlation * function with this module governing its prior parameterization */ Corr* MrExpSep_Prior::newCorr(void) { return new MrExpSep(dim, base_prior); } /* * log_Prior: * * compute the (log) prior for the parameters to * the correlation function (e.g. d and nug) */ double MrExpSep_Prior::log_Prior(double *d, int *b, double *pb, bool linear) { double prob = 0; /* if forcing the LLM, just return zero (i.e. prior=1, log_prior=0) */ if(gamlin[0] < 0) return prob; /* sum the log priors for each of the d-parameters */ for(unsigned int i=0; i<(2*dim); i++) prob += log_d_prior_pdf(d[i], d_alpha[i], d_beta[i]); /* if not allowing the LLM, then we're done */ if(gamlin[0] <= 0) return prob; /* otherwise, get the prob of each of the booleans */ double lin_pdf = linear_pdf_sep(pb, d, (2*dim), gamlin); /* either use the calculated lin_pdf value */ double lprob = 0.0; if(linear) lprob = log(lin_pdf); else { /* or the sum of the individual pbs */ for(unsigned int i=0; i<(2*dim); i++) { /* probability of linear, or not linear */ if(b[i] == 0) lprob += log(pb[i]); else lprob += log(1.0 - pb[i]); } } prob += lprob; return prob; } /* * log_Dprior_pdf: * * return the log prior pdf value for the vector * of range parameters d */ double MrExpSep_Prior::log_DPrior_pdf(double *d) { double p = 0; for(unsigned int i=0; i<(2*dim); i++) { p += log_d_prior_pdf(d[i], d_alpha[i], d_beta[i]); } return p; } /* * DPrior_rand: * * draw from the joint prior distribution for the * range parameter vector d */ void MrExpSep_Prior::DPrior_rand(double *d_new, void *state) { for(unsigned int j=0; j<(2*dim); j++) d_new[j] = d_prior_rand(d_alpha[j], d_beta[j], state); } /* * BasePrior: * * return the prior for the Base (eg Gp) model */ Base_Prior* MrExpSep_Prior::BasePrior(void) { return base_prior; } /* * SetBasePrior: * * set the base_prior field */ void MrExpSep_Prior::SetBasePrior(Base_Prior *base_prior) { this->base_prior = base_prior; } /* * Print: * * pretty print the correllation function parameters out * to a file */ void MrExpSep_Prior::Print(FILE *outfile) { MYprintf(MYstdout, "corr prior: separable power\n"); /* print nugget stuff first */ PrintNug(outfile); /* range parameter */ /* MYprintf(outfile, "starting d=\n"); printVector(d, (2*dim), outfile, HUMAN); */ /* range gamma prior, just print once */ MYprintf(outfile, "d[a,b][0,1]=[%g,%g],[%g,%g]\n", d_alpha[0][0], d_beta[0][0], d_alpha[0][1], d_beta[0][1]); /* print many times, one for each dimension instead? */ /*for(unsigned int i=0; i<(2*dim); i++) { MYprintf(outfile, "d[a,b][%d][0,1]=[%g,%g],[%g,%g]\n", i, d_alpha[i][0], d_beta[i][0], d_alpha[i][1], d_beta[i][0]); }*/ /* range gamma hyperprior */ if(fix_d) MYprintf(outfile, "d prior fixed\n"); else { MYprintf(MYstdout, "d lambda[a,b][0,1]=[%g,%g],[%g,%g]\n", d_alpha_lambda[0], d_beta_lambda[0], d_alpha_lambda[1], d_beta_lambda[1]); } } /* * log_HierPrior: * * return the log prior of the hierarchial parameters * to the correllation parameters (i.e., range and nugget) */ double MrExpSep_Prior::log_HierPrior(void) { double lpdf; lpdf = 0.0; /* mixture prior for the range parameter, d */ if(!fix_d) { for(unsigned int i=0; i extern "C" { #include "rand_draws.h" #include "matrix.h" } #include "mstructs.h" #include "temper.h" #include #include #include #define MEDBUFF 256 /* * new_preds: * * new preds structure makes it easier to pass around * the storage for the predictions and the delta * statistics */ Preds* new_preds(double **XX, unsigned int nn, unsigned int n, unsigned int d, double **rect, unsigned int R, bool pred_n, bool krige, bool it, bool delta_s2, bool improv, bool sens, unsigned int every) { /* allocate structure */ Preds* preds = (Preds*) malloc(sizeof(struct preds)); /* copy data size variables */ preds->nn = nn; preds->n = n; preds->d = d; preds->R = (int) ceil(((double)R)/every); preds->mult = every; /* allocations needed for sensitivity analysis */ if(sens){ /* sanity check */ assert(XX); /* XX initialized to zero is used for sens -- the XX * argument holds other information here, see below */ preds->XX=new_zero_matrix(nn,d); if(rect) preds->rect=new_dup_matrix(rect,2,d); else preds->rect = NULL; /* don't know why this is here */ /* copy information passed through the XX argument */ preds->bnds = new_dup_matrix(XX, 2, d); preds->shape = new_dup_vector(XX[2],d); preds->mode = new_dup_vector(XX[3],d); /* allocate M */ preds->nm = nn/(d+2); preds->M = new_zero_matrix(preds->R, d*preds->nm); } else { /* sens FALSE */ /* otherwise null when not used */ preds->mode = preds->shape = NULL; preds->bnds = preds->M = NULL; preds->nm = 0; /* special handling of rect when not doing sens */ assert(rect); preds->rect = new_dup_matrix(rect,2,d); preds->XX = new_normd_matrix(XX,nn,d,rect,NORMSCALE); } /* continue with allocations and assignment regardless * of whether sensitivity analysis is being performed */ /* keep track of importance tempering (IT) weights and inv-temps */ if(it) { preds->w = ones(preds->R, 1.0); preds->itemp = ones(preds->R, 1.0); } else { preds->w = preds->itemp = NULL; } /* samples from the posterior predictive distribution */ preds->ZZ = new_zero_matrix(preds->R, nn); preds->Zp = new_zero_matrix(preds->R, n*pred_n); /* allocations only necessary when saving kriging data */ if(krige) { preds->ZZm = new_zero_matrix(preds->R, nn); preds->ZZvm = new_zero_matrix(preds->R, nn); preds->ZZs2 = new_zero_matrix(preds->R, nn); preds->Zpm = new_zero_matrix(preds->R, n*pred_n); preds->Zpvm = new_zero_matrix(preds->R, n*pred_n); preds->Zps2 = new_zero_matrix(preds->R, n * pred_n); } else { preds->ZZm = preds->ZZvm = preds->ZZs2 = preds->Zpm = preds->Zpvm = preds->Zps2 = NULL; } /* allocations only necessary when calculating ALC and Improv * statistics */ if(delta_s2) preds->Ds2x = new_zero_matrix(preds->R, nn); else preds->Ds2x = NULL; if(improv) preds->improv = new_zero_matrix(preds->R, nn); else preds->improv = NULL; return preds; } /* * import_preds: * * Copy preds data from from to to. * "es not copy the sens information in the current implementation * (not sure whether this will be necessary at a later juncture). */ void import_preds(Preds* to, unsigned int where, Preds *from) { assert(where >= 0); assert(where <= to->R); assert(where + from->R <= to->R); assert(to->nn == from->nn); assert(to->n == from->n); assert(to->nm == from->nm); assert(to->d == to->d); if(from->w) dupv(&(to->w[where]), from->w, from->R); if(from->itemp) dupv(&(to->itemp[where]), from->itemp, from->R); if(from->ZZ) dupv(to->ZZ[where], from->ZZ[0], from->R * from->nn); if(from->ZZm) dupv(to->ZZm[where], from->ZZm[0], from->R * from->nn); if(from->ZZvm) dupv(to->ZZvm[where], from->ZZvm[0], from->R * from->nn); if(from->ZZs2) dupv(to->ZZs2[where], from->ZZs2[0], from->R * from->nn); if(from->Zp) dupv(to->Zp[where], from->Zp[0], from->R * from->n); if(from->Zpm) dupv(to->Zpm[where], from->Zpm[0], from->R * from->n); if(from->Zpvm) dupv(to->Zpvm[where], from->Zpvm[0], from->R * from->n); if(from->Zps2) dupv(to->Zps2[where], from->Zps2[0], from->R * from->n); if(from->Ds2x) dupv(to->Ds2x[where], from->Ds2x[0], from->R * from->nn); if(from->improv) dupv(to->improv[where], from->improv[0], from->R * from->nn); if(from->M) dupv(to->M[where], from->M[0], from->R * from->nm * from->d); } /* * combine_preds: * * create and return a new preds structure with the * combined contents of preds to and preds from. * (to and from must be of same dimenstion, but may * be of different size) */ Preds *combine_preds(Preds *to, Preds *from) { assert(from); if(to == NULL) return from; if(to->nn != from->nn) MYprintf(MYstderr, "to->nn=%d, from->nn=%d\n", to->nn, from->nn); assert(to->nn == from->nn); assert(to->d == from->d); assert(to->mult == from->mult); Preds *preds = new_preds(to->XX, to->nn, to->n, to->d, NULL, (to->R + from->R)*to->mult, (bool) ((to->Zp!=NULL)), (bool) ((to->Zps2!=NULL) || (to->ZZs2!=NULL)), (bool) (to->w != NULL), (bool) to->Ds2x, (bool) to->improv, ((bool) (to->nm>0)), to->mult); import_preds(preds, 0, to); import_preds(preds, to->R, from); delete_preds(to); delete_preds(from); return preds; } /* * delete_preds: * * destructor for preds structure */ void delete_preds(Preds* preds) { if(preds->w) free(preds->w); if(preds->itemp) free(preds->itemp); if(preds->XX) delete_matrix(preds->XX); if(preds->ZZ) delete_matrix(preds->ZZ); if(preds->ZZm) delete_matrix(preds->ZZm); if(preds->ZZvm) delete_matrix(preds->ZZvm); if(preds->ZZs2) delete_matrix(preds->ZZs2); if(preds->Zp) delete_matrix(preds->Zp); if(preds->Zpm) delete_matrix(preds->Zpm); if(preds->Zpvm) delete_matrix(preds->Zpvm); if(preds->Zps2) delete_matrix(preds->Zps2); if(preds->Ds2x) delete_matrix(preds->Ds2x); if(preds->improv) delete_matrix(preds->improv); if(preds->rect) delete_matrix(preds->rect); if(preds->bnds) delete_matrix(preds->bnds); if(preds->shape) free(preds->shape); if(preds->mode) free(preds->mode); if(preds->M) delete_matrix(preds->M); free(preds); } /* * fill_larg: * * full an LArg structure with the parameters to * the each_leaf function that will be forked using * pthreads */ void fill_larg(LArgs* larg, Tree *leaf, Preds* preds, int index, bool dnorm) { larg->leaf = leaf; larg->preds = preds; larg->index = index; larg->dnorm = dnorm; } /* * new_posteriors: * * creade a new Posteriors data structure for * recording the posteriors of different tree depths * and initialize */ Posteriors* new_posteriors(void) { Posteriors* posteriors = (Posteriors*) malloc(sizeof(struct posteriors)); posteriors->maxd = 1; posteriors->posts = (double *) malloc(sizeof(double) * posteriors->maxd); posteriors->trees = (Tree **) malloc(sizeof(Tree*) * posteriors->maxd); posteriors->posts[0] = R_NegInf; posteriors->trees[0] = NULL; return posteriors; } /* * delete_posteriors: * * free the memory used by the posteriors * data structure, and delete the trees saved therein */ void delete_posteriors(Posteriors* posteriors) { free(posteriors->posts); for(unsigned int i=0; imaxd; i++) { if(posteriors->trees[i]) { delete posteriors->trees[i]; } } free(posteriors->trees); free(posteriors); } /* * register_posterior: * * if the posterior for the tree *t is the current largest * seen (for its height), then save it in the Posteriors * data structure. */ void register_posterior(Posteriors* posteriors, Tree* t, double post) { unsigned int height = t->Height(); /* reallocate necessary memory */ if(height > posteriors->maxd) { posteriors->posts = (double*) realloc(posteriors->posts, sizeof(double) * height); posteriors->trees = (Tree**) realloc(posteriors->trees, sizeof(Tree*) * height); for(unsigned int i=posteriors->maxd; iposts[i] = R_NegInf; posteriors->trees[i] = NULL; } posteriors->maxd = height; } /* if this posterior is better, record it */ if(posteriors->posts[height-1] < post) { posteriors->posts[height-1] = post; if(posteriors->trees[height-1]) delete posteriors->trees[height-1]; posteriors->trees[height-1] = new Tree(t, true); } } /* * new_linarea: * * allocate memory for the linarea structure * that keep tabs on how much of the input domain * is under the linear model */ Linarea* new_linarea(void) { Linarea *lin_area = (Linarea*) malloc(sizeof(struct linarea)); lin_area->total = 1000; lin_area->ba = new_zero_vector(lin_area->total); lin_area->la = new_zero_vector(lin_area->total); lin_area->counts = (unsigned int *) malloc(sizeof(unsigned int) * lin_area->total); reset_linarea(lin_area); return lin_area; } /* * new_linarea: * * reallocate memory for the linarea structure * that keep tabs on how much of the input domain * is under the linear model */ Linarea* realloc_linarea(Linarea* lin_area) { assert(lin_area); lin_area->total *= 2; lin_area->ba = (double*) realloc(lin_area->ba, sizeof(double) * lin_area->total); lin_area->la = (double*) realloc(lin_area->la, sizeof(double) * lin_area->total); lin_area->counts = (unsigned int *) realloc(lin_area->counts,sizeof(unsigned int)*lin_area->total); for(unsigned int i=lin_area->size; itotal; i++) { lin_area->ba[i] = 0; lin_area->la[i] = 0; lin_area->counts[i] = 0; } return lin_area; } /* * delete_linarea: * * free the linarea data structure and * all of its fields */ void delete_linarea(Linarea* lin_area) { assert(lin_area); free(lin_area->ba); free(lin_area->la); free(lin_area->counts); free(lin_area); lin_area = NULL; } /* * reset_linearea: * * re-initialize the lineara data structure */ void reset_linarea(Linarea *lin_area) { assert(lin_area); for(unsigned int i=0; itotal; i++) lin_area->counts[i] = 0; zerov(lin_area->ba, lin_area->total); zerov(lin_area->la, lin_area->total); lin_area->size = 0; } /* * process_linarea: * * tabulate the area of the leaves which are under the * linear model (and the gp model) as well as the count of linear * boolean for each dimension */ void process_linarea(Linarea* lin_area, unsigned int numLeaves, Tree** leaves) { if(!lin_area) return; if(lin_area->size + 1 > lin_area->total) realloc_linarea(lin_area); double ba = 0.0; double la = 0.0; unsigned int sumi = 0; for(unsigned int i=0; iLinarea(&sum_b, &area); la += area * linear; ba += sum_b * area; sumi += sum_b; } lin_area->ba[lin_area->size] = ba; lin_area->la[lin_area->size] = la; lin_area->counts[lin_area->size] = sumi; (lin_area->size)++; } /* * print_linarea: * * print linarea stats to the outfile * doesn't do anything if linarea is false */ void print_linarea(Linarea *lin_area, FILE *outfile) { if(!lin_area) return; // FILE *outfile = OpenFile("trace", "linarea"); MYprintf(outfile, "count\t la ba\n"); for(unsigned int i=0; isize; i++) { MYprintf(outfile, "%d\t %g %g\n", lin_area->counts[i], lin_area->la[i], lin_area->ba[i]); } fclose(outfile); } tgp/src/rhelp.h0000644000176200001440000000142213531032535013115 0ustar liggesusers#ifndef __RHELP_H__ #define __RHELP_H__ #include #include /* this is now covered by -D RPRINT flags in Makevars */ /*#define RPRINT*/ #ifndef RPRINT void warning(const char *str, ...); void error(const char *str, ...); #define DOUBLE_EPS 2.220446e-16 #define M_LN_SQRT_2PI 0.918938533204672741780329736406 #include #define MYstdout stdout #define MYstderr stderr #else // #include // #include // #include // #include #include extern FILE *MYstdout, *MYstderr; #endif // void R_FlushConsole(void); /* R < 2.3 does not have this in R.h (in Rinterface.h) */ void MYprintf(FILE *outfile, const char *str, ...); void MYflush(FILE *outfile); time_t MY_r_process_events(time_t itime); #endif tgp/src/temper.cc0000644000176200001440000005171013531032535013442 0ustar liggesusers /******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #include "R.h" extern "C" { #include "rand_draws.h" #include "matrix.h" #include "rhelp.h" } #include "temper.h" #include #include #include /* * Temper: (constructor) * * create a new temperature structure from the temperature * array provided, of length n (duplicating the array) */ Temper::Temper(double *itemps, double *tprobs, unsigned int numit, double c0, double n0, IT_LAMBDA it_lambda) { /* copy the inv-temperature vector */ this->itemps = new_dup_vector(itemps, numit); this->numit = numit; /* stochastic approximation parameters */ this->c0 = c0; this->n0 = n0; this->doSA = false; /* must turn on in Model:: */ /* combination method */ this->it_lambda = it_lambda; /* either assign uniform probs if tprobs is NULL */ if(tprobs == NULL) { this->tprobs = ones(numit, 1.0/numit); } else { /* or copy them and make sure they're positive and normalized */ this->tprobs = new_dup_vector(tprobs, numit); Normalize(); } /* init itemp-location pointer -- find closest to 1.0 */ this->k = 0; double mindist = fabs(this->itemps[0] - 1.0); for(unsigned int i=1; inumit; i++) { double dist = fabs(this->itemps[i] - 1.0); if(dist < mindist) { mindist = dist; this->k = i; } } /* set new (proposed) temperature to "null" */ this->knew = -1; /* set iteration number for stoch_approx to zero */ this->cnt = 1; /* zero-out a new counter for each temperature */ this->tcounts = new_ones_uivector(this->numit, 0); this->cum_tcounts = new_ones_uivector(this->numit, 0); } /* * Temper: (constructor) * * create a new temperature structure from the temperature * array provided, the first entry of the array is n. If n * is not zero, then c0 and n0 follow, and then n inverse * temperatures and n (possibly unnormalized) probabilities. */ Temper::Temper(double *ditemps) { /* read the number of inverse temperatures */ assert(ditemps[0] >= 0); numit = (unsigned int) ditemps[0]; /* copy c0 and n0 */ c0 = ditemps[1]; n0 = ditemps[2]; assert(c0 >= 0 && n0 >= 0); doSA = false; /* must turn on in Model:: */ /* copy the inv-temperature vector and probs */ itemps = new_dup_vector(&(ditemps[3]), numit); tprobs = new_dup_vector(&(ditemps[3+numit]), numit); /* normalize the probs and then check that they're positive */ Normalize(); /* combination method */ int dlambda = (unsigned int) ditemps[3+3*numit]; switch((unsigned int) dlambda) { case 1: it_lambda = OPT; break; case 2: it_lambda = NAIVE; break; case 3: it_lambda = ST; break; default: error("IT lambda = %d unknown\n", dlambda); } /* init itemp-location pointer -- find closest to 1.0 */ k = 0; double mindist = fabs(itemps[0] - 1.0); for(unsigned int i=1; iitemps, temp->numit); tprobs = new_dup_vector(temp->tprobs, temp->numit); tcounts = new_dup_uivector(temp->tcounts, temp->numit); cum_tcounts = new_dup_uivector(temp->cum_tcounts, temp->numit); numit = temp->numit; k = temp->k; knew = temp->knew; c0 = temp->c0; n0 = temp->n0; doSA = false; cnt = temp->cnt; } /* * Temper: (assignment operator) * * copy new temperature structure from the temperature * array provided, of length n (duplicating the array) */ Temper& Temper::operator=(const Temper &t) { Temper *temp = (Temper*) &t; assert(numit == temp->numit); dupv(itemps, temp->itemps, numit); dupv(tprobs, temp->tprobs, numit); dupuiv(tcounts, temp->tcounts, numit); dupuiv(cum_tcounts, temp->cum_tcounts, numit); numit = temp->numit; k = temp->k; knew = temp->knew; c0 = temp->c0; n0 = temp->n0; cnt = temp->cnt; doSA = temp->doSA; return *this; } /* * ~Temper: (destructor) * * free the memory and contents of an itemp * structure */ Temper::~Temper(void) { free(itemps); free(tprobs); free(tcounts); free(cum_tcounts); } /* * Itemp: * * return the actual inv-temperature currently * being used */ double Temper::Itemp(void) { return itemps[k]; } /* * Prob: * * return the probability inv-temperature currently * being used */ double Temper::Prob(void) { return tprobs[k]; } /* * ProposedProb: * * return the probability inv-temperature proposed */ double Temper::ProposedProb(void) { return tprobs[knew]; } /* * Propose: * * Uniform Random-walk proposal for annealed importance sampling * temperature in the continuous interval (0,1) with bandwidth * of 2*0.1. Returns proposal, and passes back forward and * backward probs */ double Temper::Propose(double *q_fwd, double *q_bak, void *state) { /* sanity check */ if(knew != -1) warning("did not accept or reject last proposed itemp"); if(k == 0) { if(numit == 1) { /* only one temp avail */ knew = k; *q_fwd = *q_bak = 1.0; } else { /* knew should be k+1 */ knew = k + 1; *q_fwd = 1.0; if(knew == (int) (numit - 1)) *q_bak = 1.0; else *q_bak = 0.5; } } else { /* k > 0 */ /* k == numit; means k_new = k-1 */ if(k == (int) (numit - 1)) { assert(numit > 1); knew = k - 1; *q_fwd = 1.0; if(knew == 0) *q_bak = 1.0; else *q_bak = 0.5; } else { /* most general case */ if(runi(state) < 0.5) { knew = k - 1; *q_fwd = 0.5; if(knew == (int) (numit - 1)) *q_bak = 1.0; else *q_bak = 0.5; } else { knew = k + 1; *q_fwd = 0.5; if(knew == 0) *q_bak = 1.0; else *q_bak = 0.5; } } } return itemps[knew]; } /* * Keep: * * keep a proposed itemp, double-checking that the itemp_new * argument actually was the last proposed inv-temperature */ void Temper::Keep(double itemp_new, bool burnin) { assert(knew >= 0); assert(itemp_new == itemps[knew]); k = knew; knew = -1; /* update the observation counts only whilest not doing SA and not doing burn in rounds */ if(!(doSA || burnin)) { (tcounts[k])++; (cum_tcounts[k])++; } } /* * Reject: * * reject a proposed itemp, double-checking that the itemp_new * argument actually was the last proposed inv-temperature -- * this actually amounts to simply updating the count of the * kept (old) temperature */ void Temper::Reject(double itemp_new, bool burnin) { assert(itemp_new == itemps[knew]); /* do not update itemps->k, but do update the counter for the old (kept) temperature */ knew = -1; /* update the observation counts only whilest not doing SA and not doing burn in rounds */ if(!(doSA || burnin)) { (tcounts[k])++; (cum_tcounts[k])++; } } /* * UpdatePrior: * * re-create the prior distribution of the temperature * ladder by dividing by the normalization constant, i.e., * adjust by the "observation counts" -- returns a pointer * to the probabilities */ double* Temper::UpdatePrior(void) { /* do nothing if there is only one temperature */ if(numit == 1) return tprobs; /* first find the min (non-zero) tcounts */ unsigned int min = tcounts[0]; for(unsigned int i=1; inumit == numit); dupv(this->tprobs, tprobs, numit); } /* * CopyPrior: * * write the tprior into the double vector provided, in the * same format as the double-input vector to the * Temper::Temper(double*) constructor */ void Temper::CopyPrior(double *dparams) { assert(this->numit == (unsigned int) dparams[0]); /* copy the pseudoprior */ dupv(&(dparams[3+numit]), tprobs, numit); /* copy the integer counts in each temperature */ for(unsigned int i=0; i= 1); for(unsigned int i=0; i= 1) MYprintf(MYstdout, "\neffective sample sizes:\n"); /* for each temperature */ for(unsigned int i=0; i 0 && w2sum[i] > 0) { /* compute ess and max weight for this temp */ lambda[i] = sq(W[i]) / w2sum[i]; /* check for numerical problems and (if none) calculate the within temperature ESS */ if(!R_FINITE(lambda[i])) { lambda[i] = 0; ei = 0; } else ei = calc_ess(wi, len); /* sum up the within temperature ESS's */ eisum += ei*len; } else { W[i] = 1; } /* doesn't matter since ei=0 */ /* keep track of sum of lengths and ess so far */ tlen += len; tess += len * ei; /* save individual ess to the (double) output essd vector */ essd[i] = len; essd[numit + i] = ei*len; /* print individual ess */ if(verb >= 1) MYprintf(MYstdout, "%d: itemp=%g, len=%d, ess=%g\n", //, sw=%g\n", i, itemps[i], len, ei*len); //, sumv(wi, len)); /* clean up */ free(wi); free(p); } /* normalize the lambdas */ double gamma_sum = sumv(lambda, numit); scalev(lambda, numit, 1.0/gamma_sum); /* for each temperature, calculate the adjusted weights */ for(unsigned int i=0; i= 1) { MYprintf(MYstdout, "total: len=%d, ess.sum=%g, ess(w)=%g\n", tlen, tess, ((double)wlen)*calc_ess(w,wlen)); double lce = wlen*(wlen-1.0)*gamma_sum/(sq(wlen)-gamma_sum); if(ISNAN(lce)) lce = 1; MYprintf(MYstdout, "lambda-combined ess=%g\n", lce); } /* clean up */ free(lambda); free(W); free(w2sum); /* return the overall effective sample size */ return(((double)wlen)*calc_ess(w, wlen)); } /* * EachESS: * * calculate the effective sample size at each temperature */ void Temper::EachESS(double *w, double *itemp, unsigned int wlen, double *essd) { /* for each temperature */ for(unsigned int i=0; i= 1) MYprintf(MYstdout, "\nST sample size=%d\n", len); /* return the overall effective sample size */ return((double) len); } /* * LambdaNaive: * * adjust the weight distribution w[n] via Naive Importance Tempering; * that is, disregard demperature, and just normalize the weight vector */ double Temper::LambdaNaive(double *w, unsigned int wlen, unsigned int verb) { /* calculate Wi=sum(wi) */ double W = sumv(w, wlen); if(W == 0) return 0.0; /* multiply by numerator of lambda-star */ scalev(w, wlen, 1.0/W); /* calculate ESS */ double ess = ((double)wlen)*calc_ess(w, wlen); /* print totals */ if(verb >= 1) MYprintf(MYstdout, "\nnaive IT ess=%g\n", ess); /* return the overall effective sample size */ return(ess); } /* * N: * * get number of temperatures n: */ unsigned int Temper::Numit(void) { return numit; } /* * DoStochApprox: * * true if both c0 and n0 are non-zero, then we * are doing StochApprox */ bool Temper::DoStochApprox(void) { if(c0 > 0 && n0 > 0 && numit > 1) return true; else return false; } /* * IS_ST_or_IS: * * return true importance tempering, simulated tempering, * or importance sampling is supported by the current * Tempering distribution */ bool Temper::IT_ST_or_IS(void) { if(numit > 1 || itemps[0] != 1.0) return true; else return false; } /* * IT_or_ST: * * return true importance tempering or simulated tempering, * is supported by the current Tempering distribution */ bool Temper::IT_or_ST(void) { if(numit > 1) return true; else return false; } /* * IS: * * return true if importance sampling (only) is supported * by the current Tempering distribution */ bool Temper::IS(void) { if(numit == 1 && itemps[0] != 1.0) return true; else return false; } /* * Itemps: * * return the temperature ladder */ double* Temper::Itemps(void) { return itemps; } /* * C0: * * return the c0 (SA) paramete */ double Temper::C0(void) { return c0; } /* * N0: * * return the n0 (SA) paramete */ double Temper::N0(void) { return n0; } /* * ResetSA: * * reset the stochastic approximation by setting * the counter to 1, and turn SA on */ void Temper::ResetSA(void) { doSA = true; cnt = 1; } /* * StopSA: * * turn off stochastic approximation */ void Temper::StopSA(void) { doSA = false; } /* * ITLambda: * * choose a method for importance tempering based on the it_lambda * variable, call that method, passing back the lambda-adjusted * weights w, and returning a calculation of ESSw */ double Temper::LambdaIT(double *w, double *itemp, unsigned int R, double *essd, unsigned int verb) { /* sanity check that it makes sense to adjust weights */ assert(IT_ST_or_IS()); double ess = 0; switch(it_lambda) { case OPT: ess = LambdaOpt(w, itemp, R, essd, verb); break; case NAIVE: ess = LambdaNaive(w, R, verb); EachESS(w, itemp, R, essd); break; case ST: ess = LambdaST(w, itemp, R, verb); EachESS(w, itemp, R, essd); break; default: error("bad it_lambda\n"); } return ess; } /* * Print: * * write information about the IT configuration * out to the supplied file */ void Temper::Print(FILE *outfile) { /* print the importance tempring information */ if(IS()) MYprintf(outfile, "IS with inv-temp %g\n", itemps[0]); else if(IT_or_ST()) { switch(it_lambda) { case OPT: MYprintf(outfile, "IT: optimal"); break; case NAIVE: MYprintf(outfile, "IT: naive"); break; case ST: MYprintf(outfile, "IT: implementing ST"); break; } MYprintf(outfile, " on %d-rung ladder\n", numit); if(DoStochApprox()) MYprintf(outfile, " with stoch approx\n"); else MYprintf(outfile, "\n"); } } /* * AppendLadder: * * append tprobs and tcounts to a file with the name * provided */ void Temper::AppendLadder(const char* file_str) { FILE *LOUT = fopen(file_str, "a"); printVector(tprobs, numit, LOUT, MACHINE); printUIVector(tcounts, numit, LOUT); fclose(LOUT); } /* * Normalize: * * normalize the pseudo-prior (tprobs) and * check that all probs are positive */ void Temper::Normalize(void) { scalev(tprobs, numit, 1.0/sumv(tprobs, numit)); for(unsigned int i=0; i 0); } /* * ess: * * effective sample size calculation for imporancnce * sampling -- per unit sample. To get the full sample * size, just multiply by n */ double calc_ess(double *w, unsigned int n) { if(n == 0) return 0; else { double cv2 = calc_cv2(w,n); if(ISNAN(cv2) || !R_FINITE(cv2)) { // warning("nan or inf found in cv2, probably due to zero weights"); return 0.0; } else return(1.0/(1.0+cv2)); } } /* * cv2: * * calculate the coefficient of variation, used here * to find the variance of a sample of unnormalized * importance sampling weights */ double calc_cv2(double *w, unsigned int n) { double mw; wmean_of_rows(&mw, &w, 1, n, NULL); double sum = 0; if(n == 1) return 0.0; for(unsigned int i=0; i typedef enum FIND_OP {LT=101, LEQ=102, EQ=103, GEQ=104, GT=105, NE=106} FIND_OP; typedef enum PRINT_PREC {HUMAN=1001, MACHINE=1002} PRINT_PREC; typedef struct rect { unsigned int d; double **boundary; FIND_OP *opl; FIND_OP *opr; } Rect; Rect* new_rect(unsigned int d); Rect* new_dup_rect(Rect* oldR); Rect* new_drect(double **drect, int d); void delete_rect(Rect* rect); unsigned int matrix_constrained(int *p, double **X, unsigned int n1, unsigned int n2, Rect *rect); void print_rect(Rect *r, FILE* outfile); double rect_area(Rect* rect); double rect_area_maxd(Rect* rect, unsigned int maxd); void rect_unnorm(Rect* r, double **rect, double normscale); double **get_data_rect(double **X, unsigned int N, unsigned int d); void normalize(double **Xall, double **rect, int N, int d, double normscale); void zero(double **M, unsigned int n1, unsigned int n2); int isZero(double **M, unsigned int m, int sym); void id(double **M, unsigned int n); double ** new_id_matrix(unsigned int n); double ** new_zero_matrix(unsigned int n1, unsigned int n2); int ** new_zero_imatrix(unsigned int n1, unsigned int n2); double ** new_matrix(unsigned int m, unsigned int n); double ** new_matrix_bones(double *v, unsigned int n1, unsigned int n2); int ** new_imatrix_bones(int *v, unsigned int n1, unsigned int n2); int ** new_t_imatrix(int** M, unsigned int n1, unsigned int n2); int ** new_imatrix(unsigned int n1, unsigned int n2); double ** new_t_matrix(double** M, unsigned int n1_old, unsigned int n2_old); double ** new_dup_matrix(double** M, unsigned int n1, unsigned int n2); int ** new_dup_imatrix(int** M, unsigned int n1, unsigned int n2); double ** new_shift_matrix(double** M, unsigned int n1, unsigned int n2); void dup_matrix(double** M1, double **M2, unsigned int n1, unsigned int n2); void dup_imatrix(int** M1, int **M2, unsigned int n1, unsigned int n2); void swap_matrix(double **M1, double **M2, unsigned int n1, unsigned int n2); double ** new_bigger_matrix(double** M, unsigned int n1, unsigned int n2, unsigned int n1_new, unsigned int n2_new); int ** new_bigger_imatrix(int** M, unsigned int n1, unsigned int n2, unsigned int n1_new, unsigned int n2_new); double ** new_normd_matrix(double** M, unsigned int n1, unsigned int n2, double **rect, double normscale); void delete_matrix(double** m); void delete_imatrix(int** m); void check_means(double *mean, double *q1, double *median, double *q2, unsigned int n); void center_columns(double **M, double *center, unsigned int n1, unsigned int n2); void center_rows(double **M, double *center, unsigned int n1, unsigned int n2); void norm_columns(double **M, double *norm, unsigned int n1, unsigned int n2); void sum_of_columns_f(double *s, double **M, unsigned int n1, unsigned int n2, double(*f)(double)); void sum_of_columns(double *s, double **M, unsigned int n1, unsigned int n2); void sum_of_each_column_f(double *s, double **M, unsigned int *n1, unsigned int n2, double(*f)(double)); void wmean_of_columns(double *mean, double **M, unsigned int n1, unsigned int n2, double *weight); void wvar_of_columns(double *var, double **M, unsigned int n1, unsigned int n2, double *weight); void wmean_of_columns_f(double *mean, double **M, unsigned int n1, unsigned int n2, double *weight, double(*f)(double)); void wmean_of_rows(double *mean, double **M, unsigned int n1, unsigned int n2, double *weight); void wmean_of_rows_f(double *mean, double **M, unsigned int n1, unsigned int n2, double *weight, double(*f)(double)); void wcov_of_columns(double **cov, double **M, double *mean, unsigned int n1, unsigned int n2, double *weight); void wcovx_of_columns(double **cov, double **M1, double **M2, double *mean1, double *mean2, unsigned int T, unsigned int n1, unsigned int n2, double *weight); void add_matrix(double a, double **M1, double b, double **M2, unsigned int n1, unsigned int n2); double **new_p_submatrix(int *p, double **v, unsigned int nrows, unsigned int ncols, unsigned int col_offset); void sub_p_matrix(double **V, int *p, double **v, unsigned int nrows, unsigned int lenp, unsigned int col_offset); double **new_p_submatrix_rows(int *p, double **v, unsigned int nrows, unsigned int ncols, unsigned int row_offset); void sub_p_matrix_rows(double **V, int *p, double **v, unsigned int ncols, unsigned int lenp, unsigned int row_offset); void copy_p_matrix(double **V, int *p1, int *p2, double **v, unsigned int n1, unsigned int n2); void add_p_matrix(double a, double **V, int *p1, int *p2, double b, double **v, unsigned int n1, unsigned int n2); double* ones(unsigned int n, double scale); double* dseq(double from, double to, double by); int* iseq(double from, double to); int* find(double *V, unsigned int n, FIND_OP op, double val, unsigned int* len); int* find_col(double **V, int *p, unsigned int n, unsigned int var, FIND_OP op, double val, unsigned int* len); double kth_smallest(double a[], int n, int k); double quick_select(double arr[], int n, int k); void quantiles_of_columns(double **Q, double *q, unsigned int m, double **M, unsigned int n1, unsigned int n2, double *w); void quantiles(double *qs, double *q, unsigned int m, double *v, double *w, unsigned int n); void printMatrix(double **M, unsigned int n, unsigned int col, FILE *outfile); void printIMatrix(int **matrix, unsigned int n, unsigned int col, FILE *outfile); void printMatrixT(double **M, unsigned int n, unsigned int col, FILE *outfile); void mean_to_file(const char *file_str, double **M, unsigned int T, unsigned int n); void vector_to_file(const char* file_str, double *quantiles, unsigned int n); void matrix_to_file(const char* file_str, double** matrix, unsigned int n1, unsigned int n2); void intmatrix_to_file(const char* file_str, int** matrix, unsigned int n1, unsigned int n2); void matrix_t_to_file(const char* file_str, double** matrix, unsigned int n1, unsigned int n2); void printVector(double *v, unsigned int n, FILE *outfile, PRINT_PREC type); void printSymmMatrixVector(double **m, unsigned int n, FILE *outfile, PRINT_PREC type); void ivector_to_file(const char* file_str, int *vector, unsigned int n); void uivector_to_file(const char *file_str, unsigned int *iv, unsigned int n); double* new_dup_vector(double* vold, unsigned int n); double* new_zero_vector(unsigned int n); double* new_vector(unsigned int n); void dupv(double *v, double* vold, unsigned int n); void dup_col(double **M, unsigned int col, double *v, unsigned int n); void swap_vector(double **v1, double **v2); void zerov(double*v, unsigned int n); void add_vector(double a, double *v1, double b, double *v2, unsigned int n); void add_p_vector(double a, double *V, int *p, double b, double *v, unsigned int n); void copy_p_vector(double *V, int *p, double *v, unsigned int n); void copy_sub_vector(double *V, int *p, double *v, unsigned int n); double* new_sub_vector(int *p, double *v, unsigned int n); void scalev(double *v, unsigned int n, double scale); void scalev2(double *v, unsigned int n, double *scale); void centerv(double *v, unsigned int n, double scale); void normv(double *v, unsigned int n, double* norm); double sum_fv(double *v, unsigned int n, double(*f)(double)); double sumv(double *v, unsigned int n); double meanv(double *v, unsigned int n); int equalv(double *v1, double *v2, int n); int* new_ivector(unsigned int n); int* new_dup_ivector(int *iv, unsigned int n); void dupiv(int *iv_new, int *iv, unsigned int n); void zeroiv(int*v, unsigned int n); void swap_ivector(int **v1, int **v2); int *new_ones_ivector(unsigned int n, int scale); int *new_zero_ivector(unsigned int n); void iones(int *iv, unsigned int n, int scale); void printIVector(int *iv, unsigned int n, FILE *outfile); void copy_p_ivector(int *V, int *p, int *v, unsigned int n); void copy_sub_ivector(int *V, int *p, int *v, unsigned int n); int* new_sub_ivector(int *p, int *v, unsigned int n); int sumiv(int *v, unsigned int n); int meaniv(int *iv, unsigned int n); void add_ivector(int *v1, int *v2, unsigned int n); unsigned int* new_uivector(unsigned int n); unsigned int* new_dup_uivector(unsigned int *iv, unsigned int n); void dupuiv(unsigned int *iv_new, unsigned int *iv, unsigned int n); void zerouiv(unsigned int *v, unsigned int n); unsigned int *new_ones_uivector(unsigned int n, unsigned int scale); unsigned int *new_zero_uivector(unsigned int n); void uiones(unsigned int *iv, unsigned int n, unsigned int scale); void printUIVector(unsigned int *iv, unsigned int n, FILE *outfile); void copy_p_uivector(unsigned int *V, int *p, unsigned int *v, unsigned int n); void copy_sub_uivector(unsigned int *V, int *p, unsigned int *v, unsigned int n); unsigned int* new_sub_uivector(int *p, unsigned int *v, unsigned int n); unsigned int sumuiv(unsigned int *v, unsigned int n); unsigned int meanuiv(unsigned int *iv, unsigned int n); double max(double *v, unsigned int n, unsigned int *which); double min(double *v, unsigned int n, unsigned int *which); double sq(double x); double MYfmax(double a, double b); double MYfmin(double a, double b); double vmult(double *v1, double *v2, int n); #endif tgp/src/gp.cc0000644000176200001440000014075113531032535012560 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ extern "C" { #include "matrix.h" #include "rhelp.h" #include "all_draws.h" #include "gen_covar.h" #include "predict.h" #include "predict_linear.h" #include "rand_draws.h" #include "rand_pdf.h" #include "lik_post.h" } #include "params.h" #include "exp.h" #include "exp_sep.h" #include "matern.h" #include "mr_exp_sep.h" #include "sim.h" #include "twovar.h" #include "tree.h" #include "model.h" #include "gp.h" #include "base.h" #include #include #include using namespace std; #include class Gp_Prior; /* * Gp: * * constructor for the base Gp model; * most things are set to null values */ Gp::Gp(unsigned int d, Base_Prior *prior, Model *model) : Base(d, prior, model) { /* data size; alread done in Base */ /* this->n = 0; this->d = d; nn = 0; */ /* null everything */ F = FF = xxKx = xxKxx = NULL; Z = NULL; corr = NULL; b = new_zero_vector(this->col); Vb = new_id_matrix(this->col); bmu = new_zero_vector(this->col); bmle = new_zero_vector(this->col); lambda = 0; } /* * Gp: * * duplication constructor; params and "new" variables are also set to * NULL values; the economy argument allows a memory efficient * duplication which does not copy the covariance matrices, as these * can be recreated as necessary. */ Gp::Gp(double **X, double *Z, Base *old, bool economy) : Base(X, Z, old, economy) { assert(old->BaseModel() == GP); Gp* gp_old = (Gp*) old; /* F; copied from tree -- this should prolly be regenerated from scratch */ if(gp_old->F) F = new_dup_matrix(gp_old->F, col, n); else F = NULL; /* gp/linear parameters */ lambda = gp_old->lambda; s2 = gp_old->s2; tau2 = gp_old->tau2; /* beta parameters */ assert(gp_old->Vb); Vb = new_dup_matrix(gp_old->Vb, col, col); assert(gp_old->bmu); bmu = new_dup_vector(gp_old->bmu, col); assert(gp_old->bmle); bmle = new_dup_vector(gp_old->bmle, col); assert(gp_old->b); b = new_dup_vector(gp_old->b, col); /* correllation prior parameters are duplicated above in Base(X, Z, old) */ corr_prior = ((Gp_Prior*)prior)->CorrPrior(); /* correlation function; not using a corr->Dup() function * so as not to re-duplicate the correlation function * prior -- so generate a new one from the copied * prior and then use the copy constructor */ corr = corr_prior->newCorr(); *corr = *(gp_old->corr); /* if we're not being economical about memory, then copy the covariance matrices, etc., from the old correlation module */ if(!economy) corr->Cov(gp_old->corr); /* things that must be NULL */ FF = xxKx = xxKxx = NULL; } /* * Dup: * * create a new Gp base model from an old one; cannot use old->X * and old->Z because they are pointers to the old copy of the * treed partition from which this function is likely to have been * called. The economy argument allows a memory efficient * duplication which does not copy the covariance matrices, as these * can be recreated as necessary. * * This function basically allows tree to duplicate the base model * without knowing what it is. */ Base* Gp::Dup(double **X, double *Z, bool economy) { return new Gp(X, Z, this, economy); } /* * ~Gp: * * destructor function for the base Gp model */ Gp::~Gp(void) { Clear(); ClearPred(); if(b) free(b); if(corr) delete corr; if(Vb) delete_matrix(Vb); if(bmu) free(bmu); if(bmle) free(bmle); if(FF) delete_matrix(FF); } /* * init: * * initialize all of the parameters to this * tree partion */ void Gp::Init(double *dgp) { /* set base and corr priors */ Gp_Prior *p = (Gp_Prior*) prior; corr_prior = p->CorrPrior(); assert(corr_prior->BasePrior() == prior); /* re-init partition */ /* not sure if this is necessary when dgp != NULL */ Clear(); ClearPred(); /* see if we should read the parameterization from dgp */ if(dgp) { /* dgp[0] is lambda (which we're just recomputing for now) */ s2 = dgp[1]; tau2 = dgp[2]; dupv(b, &(dgp[3]), col); /* dgp[3+col + col + col*col] is bmu and Vb (which we're also just recomputing for now) */ if(!corr) corr = corr_prior->newCorr(); corr->Init(&(dgp[3+col + col + col*col])); /* could probably put id-Vb and zero-bmu/bmle, but don't need to because the gp is always init-ed with these in place anyways (base->Init(NULL) in tree constructor) */ } else { /* or instead init params from the prior */ /* partition parameters */ dupv(b, p->B(), col); s2 = p->S2(); tau2 = p->Tau2(); /* marginalized parameters */ id(Vb, this->col); zerov(bmu, this->col); zerov(bmle, this->col); lambda = 0; /* correlation function and variance parameters */ if(corr) delete corr; corr = corr_prior->newCorr(); } } /* * Clear: * * delete the current partition */ void Gp::Clear(void) { if(F) delete_matrix(F); X = F = NULL; Z = NULL; n = 0; if(corr) corr->deallocate_new(); } /* * ClearPred: * * destroys the predictive matrices for the * partition (usually used after a prune) */ void Gp::ClearPred(void) { if(xxKx) delete_matrix(xxKx); if(xxKxx) delete_matrix(xxKxx); if(FF) delete_matrix(FF); XX = FF = xxKx = xxKxx = NULL; nn = 0; } /* * Update: * * initializes a new partition at this (leaf) node based on * the current parameter settings */ void Gp::Update(double **X, unsigned int n, unsigned int d, double *Z) { /*checks */ assert(X && Z); if(F == NULL) assert(this->n == 0 && this->X == NULL && this->Z == NULL); else assert(this->n == n && this->X == X && this->Z == Z); /* data assignments */ this->X = X; this->n = n; this->Z = Z; if(! Linear()) corr->allocate_new(n); if(F == NULL) { F = new_matrix(this->col,n); X_to_F(n, X, F); } corr->Update(n, X); corr->Invert(n); if(((Gp_Prior*)prior)->BetaPrior() == BMLE) mle_beta(bmle, n, col, F, Z); wmean_of_rows(&mean, &Z, 1, n, NULL); } /* * UpdatePred: * * initializes the partition's predictive variables at this * (leaf) node based on the current parameter settings */ void Gp::UpdatePred(double **XX, unsigned int nn, unsigned int d, bool Ds2xy) { assert(this->XX == NULL); if(XX == NULL) { assert(nn == 0); return; } this->XX = XX; this->nn = nn; assert(!FF && !xxKx); FF = new_matrix(this->col,nn); X_to_F(nn, XX, FF); if(! Linear()) { xxKx = new_matrix(n,nn); corr->Update(nn, n, xxKx, X, XX); } if(Ds2xy && ! Linear()) { assert(!xxKxx); xxKxx = new_matrix(nn,nn); corr->Update(nn, xxKxx, XX); } } /* * Draw: * * draw new values for the parameters using a mixture of Gibbs and MH steps * (covariance matrices are recomputed, and old predictive ones invalidated * where appropriate) */ bool Gp::Draw(void *state) { Gp_Prior *p = (Gp_Prior*) prior; /* * start with draws from the marginal posterior of the corr function */ /* correlation function */ int success, i; for(i=0; i<5; i++) { success = corr->Draw(n, F, X, Z, &lambda, &bmu, Vb, tau2, itemp, state); if(success != -1) break; } /* handle possible errors in corr->Draw() */ if(success == -1) MYprintf(MYstderr, "NOTICE: max tree warnings (%d), ", i); else if(success == -2) MYprintf(MYstderr, "NOTICE: mixing problem, "); if(success < 0) { MYprintf(MYstderr, "backup to model\n"); return false; } /* check the updated-ness of xxKx and xxKxx */ if(success && xxKx) { delete_matrix(xxKx); if(xxKxx) { delete_matrix(xxKxx); } xxKx = xxKxx = NULL; } /* * then go to the others */ /* s2 */ if(p->BetaPrior() == BFLAT) s2 = sigma2_draw_no_b_margin(n, col, lambda, p->s2Alpha()-col,p->s2Beta(), state); else s2 = sigma2_draw_no_b_margin(n, col, lambda, p->s2Alpha(), p->s2Beta(), state); /* if beta draw is bad, just use mean, then zeros */ unsigned int info = beta_draw_margin(b, col, Vb, bmu, s2, state); if(info != 0) b[0] = mean; /* tau2: last because of Vb and lambda */ if(p->BetaPrior() != BFLAT && p->BetaPrior() != B0NOT && p->BetaPrior() != BMZNOT) tau2 = tau2_draw(col, p->get_Ti(), s2, b, p->get_b0(), p->tau2Alpha(), p->tau2Beta(), state); /* NOTE: that Compute() still needs to be called here, but we are delaying it until after the draws for the hierarchical params */ return true; } /* * predict: * * predict with the gaussian process model. It is assumed that, * if the argments are not null, then they are allocated with the * correct sizes */ void Gp::Predict(unsigned int n, double *zp, double *zpm, double *zpvm, double *zps2, unsigned int nn, double *zz, double *zzm, double *zzvm, double *zzs2, double **ds2xy, double *improv, double Zmin, bool err, void *state) { assert(this->n == n); assert(this->nn == nn); unsigned int warn = 0; /* try to make some predictions, but first: choose LLM or Gp */ if(Linear()) { /* under the limiting linear */ double *Kdiag = corr->CorrDiag(n,X); double *KKdiag = corr->CorrDiag(nn,XX); // MYprintf(MYstdout, "%g %g\n", KKdiag[0], KKdiag[nn/2]); predict_full_linear(n, zp, zpm, zpvm, zps2, Kdiag, nn, zz, zzm, zzvm, zzs2, KKdiag, ds2xy, improv, Z, col, F, FF, bmu, s2, Vb, Zmin, err, state); if(Kdiag) free(Kdiag); if(KKdiag) free(KKdiag); } else { /* full Gp prediction */ double *zpjitter = corr->Jitter(n, X); double *zzjitter = corr->Jitter(nn, XX); double *KKdiag; if(!xxKxx) KKdiag = corr->CorrDiag(nn,XX); else KKdiag = NULL; // printVector(KKdiag, nn, MYstdout, HUMAN); warn = predict_full(n, zp, zpm, zpvm, zps2, zpjitter, nn, zz, zzm, zzvm, zzs2, zzjitter, ds2xy, improv, Z, col, F, corr->get_K(), corr->get_Ki(), ((Gp_Prior*)prior)->get_T(), tau2, FF, xxKx, xxKxx, KKdiag, bmu, s2, Zmin, err, state); if(zpjitter) free(zpjitter); if(zzjitter) free(zzjitter); if(KKdiag) free(KKdiag); } /* print warnings if there were any */ if(warn) warning("(%d) from predict_full: n=%d, nn=%d", warn, n, nn); } /* * match: * * match the high-level linear parameters */ void Gp::Match(Base* old) { assert(old->BaseModel() == GP); Gp* gp_old = (Gp*) old; *corr = *(gp_old->corr); dupv(b, gp_old->b, col); s2 = gp_old->s2; tau2 = gp_old->tau2; } /* * Combine: * * used by the tree prune operation. Combine the relevant parameters * of two child Gps into this (the parent) Gp */ void Gp::Combine(Base *l, Base *r, void *state) { assert(l->BaseModel() == GP); assert(r->BaseModel() == GP); Gp* l_gp = (Gp*) l; Gp* r_gp = (Gp*) r; corr->Combine(l_gp->corr, r_gp->corr, state); tau2 = combine_tau2(l_gp->tau2, r_gp->tau2, state); } /* * Split: * * used by the tree grow operation. Split the relevant parameters * of parent Gp into two (left & right) children Gps */ void Gp::Split(Base *l, Base *r, void *state) { double tau2_new[2]; assert(l->BaseModel() == GP); assert(r->BaseModel() == GP); Gp *l_gp = (Gp*) l; Gp *r_gp = (Gp*) r; corr->Split(l_gp->corr, r_gp->corr, state); /* new tau2 parameters for the leaves */ split_tau2(tau2_new, state); l_gp->tau2 = tau2_new[0]; r_gp->tau2 = tau2_new[1]; } /* * split_tau2: * * propose new tau2 parameters for possible new children partitions. */ void Gp::split_tau2(double *tau2_new, void *state) { int i[2]; Gp_Prior *p = (Gp_Prior*) prior; /* make the larger partition more likely to get the smaller d */ propose_indices(i, 0.5, state); tau2_new[i[0]] = tau2; if(p->BetaPrior() == BFLAT || p->BetaPrior() == B0NOT) tau2_new[i[1]] = tau2; else tau2_new[i[1]] = tau2_prior_rand(p->tau2Alpha()/2, p->tau2Beta()/2, state); } /* * combine_tau2: * * combine left and right childs tau2 into a single tau2 */ double combine_tau2(double l_tau2, double r_tau2, void *state) { double tau2ch[2]; int ii[2]; tau2ch[0] = l_tau2; tau2ch[1] = r_tau2; propose_indices(ii, 0.5, state); return tau2ch[ii[0]]; } /* * Posterior: * * called by tree: for these Gps, the Posterior is the same as * the marginal Likelihood due to the proposals coming from priors */ double Gp::Posterior(void) { return MarginalLikelihood(itemp); } /* * MarginalLikelihood: * * computes the marginalized likelihood/posterior for this (leaf) node */ double Gp::MarginalLikelihood(double itemp) { assert(F != NULL); Gp_Prior *p = (Gp_Prior*) prior; /* the main posterior for the correlation function */ double post = post_margin_rj(n, col, lambda, Vb, corr->get_log_det_K(), p->get_T(), tau2, p->s2Alpha(), p->s2Beta(), itemp); #ifdef DEBUG if(ISNAN(post)) warning("nan in posterior"); if(!R_FINITE(post)) warning("inf in posterior"); #endif return post; } /* * Likelihood: * * computes the MVN (log) likelihood for this (leaf) node */ double Gp::Likelihood(double itemp) { /* sanity check */ assert(F != NULL); /* getting the covariance matrix and its determinant */ double **Ki; double *Kdiag; if(Linear()){ Ki = NULL; Kdiag = corr->CorrDiag(n, X); } else { Ki = corr->get_Ki(); Kdiag = NULL; } double log_det_K = corr->get_log_det_K(); /* the main posterior for the correlation function */ double llik = gp_lhood(Z, n, col, F, b, s2, Ki, log_det_K, Kdiag, itemp); if(Kdiag) free(Kdiag); #ifdef DEBUG if(ISNAN(llik)) warning("nan in likelihood"); if(!R_FINITE(llik)) warning("inf in likelihood"); #endif return llik; } /* * FullPosterior: * * return the full posterior (pdf) probability of * this Gaussian Process model */ double Gp::FullPosterior(double itemp) { /* calculate the likelihood of the data */ double post = Likelihood(itemp); /* for adding in priors */ Gp_Prior *p = (Gp_Prior*) prior; /* calculate the prior on the beta regression coeffs */ if(p->BetaPrior() == B0 || p->BetaPrior() == BMLE) { double **V = new_dup_matrix(p->get_T(), col, col); scalev(V[0], col*col, s2*tau2); post += mvnpdf_log(b, p->get_b0(), V, col); delete_matrix(V); } /* add in the correllation prior */ post += corr->log_Prior(); /* add in prior for s2 */ post += log_tau2_prior_pdf(s2, p->s2Alpha()/2.0, p->s2Beta()/2.0); /* add in prior for tau2 */ if(p->BetaPrior() != BFLAT && p->BetaPrior() != B0NOT) { post += log_tau2_prior_pdf(tau2, p->tau2Alpha()/2.0, p->tau2Beta()/2.0); } return post; } /* * MarginalPosterior: * * return the full marginal posterior (pdf) probability of * this Gaussian Process model -- i.e., with beta and s2 integrated out */ double Gp::MarginalPosterior(double itemp) { /* for adding in priors */ Gp_Prior *p = (Gp_Prior*) prior; double post = post_margin_rj(n, col, lambda, Vb, corr->get_log_det_K(), p->get_T(), tau2, p->s2Alpha(), p->s2Beta(), itemp); //assert(R_FINITE(post)); /* don't need to include prior for beta or s2, because its alread included in the above calculation */ /* add in the correllation prior */ post += corr->log_Prior(); /* don't need to include prior for beta, because its alread included in the above calculation */ /* add in prior for tau2 */ if(p->BetaPrior() != BFLAT && p->BetaPrior() != B0NOT) { post += log_tau2_prior_pdf(tau2, p->tau2Alpha()/2, p->tau2Beta()/2); } return post; } /* * Compute: * * compute marginal parameters: Vb, b, and lambda * how this is done depents on whether or not this is a * linear model or a Gp, and then also depends on the beta * prior model. */ void Gp::Compute(void) { Gp_Prior *p = (Gp_Prior*) prior; double *b0 = ((Gp_Prior*)p)->get_b0();; double** Ti = ((Gp_Prior*)p)->get_Ti(); /* sanity check for a valid partition */ assert(F); /* get the right b0 depending on the beta prior */ switch(p->BetaPrior()) { case BMLE: dupv(b0, bmle, col); break; case BFLAT: assert(b0[0] == 0.0 && Ti[0][0] == 0.0 && tau2 == 1.0); break; case B0NOT: assert(b0[0] == 0.0 && Ti[0][0] == 1.0 && tau2 == p->Tau2()); break; case BMZNOT: case BMZT: /*assert(b0[0] == 0.0 && Ti[0][0] == 1.0);*/ break; case B0: break; } /* compute the marginal parameters */ if(Linear()){ double *Kdiag = corr->CorrDiag(n, X); lambda = compute_lambda_noK(Vb, bmu, n, col, F, Z, Ti, tau2, b0, Kdiag, itemp); free(Kdiag); } else lambda = compute_lambda(Vb, bmu, n, col, F, Z, corr->get_Ki(), Ti, tau2, b0, itemp); } /* * all_params: * * copy this node's parameters (s2, tau2, d, nug) to * be return by reference, and return a pointer to b */ double* Gp::all_params(double *s2, double *tau2, Corr **corr) { *s2 = this->s2; *tau2 = this->tau2; *corr = this->corr; return b; } /* * get_b: * * returns the beta vector parameter */ double* Gp::get_b(void) { return b; } /* * get_Corr: * * return a pointer to the correlleation structure */ Corr* Gp::get_Corr(void) { return corr; } /* * printFullNode: * * print everything intertesting about the current tree node to a file */ void Gp::printFullNode(void) { Gp_Prior *p = (Gp_Prior*) prior; assert(X); matrix_to_file("X_debug.out", X, n, col-1); assert(F); matrix_to_file("F_debug.out", F, col, n); assert(Z); vector_to_file("Z_debug.out", Z, n); if(XX) matrix_to_file("XX_debug.out", XX, nn, col-1); if(FF) matrix_to_file("FF_debug.out", FF, col, n); if(xxKx) matrix_to_file("xxKx_debug.out", xxKx, n, nn); if(xxKxx) matrix_to_file("xxKxx_debug.out", xxKxx, nn, nn); assert(p->get_T()); matrix_to_file("T_debug.out", p->get_T(), col, col); assert(p->get_Ti()); matrix_to_file("Ti_debug.out", p->get_Ti(), col, col); corr->printCorr(n); assert(p->get_b0()); vector_to_file("b0_debug.out", p->get_b0(), col); assert(bmu); vector_to_file("bmu_debug.out", bmu, col); assert(Vb); matrix_to_file("Vb_debug.out", Vb, col, col); } /* * Var: * * return some notion of variance for this gaussian process */ double Gp::Var(void) { return s2; } /* * X_to_F: * * F is just a column of ones and then the X (design matrix) * * X[n][col], F[col][n] */ void Gp::X_to_F(unsigned int n, double **X, double **F) { unsigned int i,j; switch( ((Gp_Prior*) prior)->MeanFn() ){ case LINEAR: for(i=0; iTrace(&clen); /* calculate and allocate the new trace, which will include the corr trace */ *len = col + 3; /* add in bmu and Vb when full=TRUE */ if(full) *len += col + col*col; /* allocate the trace vector */ double* trace = new_vector(clen + *len); /* lambda (or phi in the paper) */ trace[0] = lambda; /* copy sigma^2 and tau^2 */ trace[1] = s2; trace[2] = tau2; /* then copy beta */ dupv(&(trace[3]), b, col); /* add in bmu and Vb when full=TRUE */ if(full) { dupv(&(trace[3+col]), bmu, col); dupv(&(trace[3+2*col]), Vb[0], col*col); } /* then copy in the corr trace */ dupv(&(trace[*len]), c, clen); /* new combined length, and free c */ *len += clen; if(c) free(c); else assert(clen == 0); return trace; } /* * TraceNames: * * returns the names of the traces recorded by Gp:Trace() */ char** Gp::TraceNames(unsigned int* len, bool full) { /* first get the correllation function parameters */ unsigned int clen; char **c = corr->TraceNames(&clen); /* calculate and allocate the new trace, which will include the corr trace */ *len = col + 3; /* add in bmu and Vb when full=TRUE */ if(full) *len += col + col*col; /* allocate the trace vector */ char** trace = (char**) malloc(sizeof(char*) * (clen + *len)); /* lambda (or phi in the paper) */ trace[0] = strdup("lambda"); /* copy sigma^2 and tau^2 */ trace[1] = strdup("s2"); trace[2] = strdup("tau2"); /* then copy beta */ for(unsigned int i=0; iitemp; if(this->itemp != itemp) { this->itemp = itemp; if(isleaf) Compute(); } return olditemp; } /* * Constant: * * return true of the model being fit is actually the * constant model */ bool Gp::Constant(void) { if(col == 1 && Linear()) return true; else return false; } /* * Gp_Prior: * * the usual constructor function */ Gp_Prior::Gp_Prior(unsigned int d, MEAN_FN mean_fn) : Base_Prior(d) { /* set the name & dim of the base model */ base_model = GP; /* * the rest of the parameters will be read in * from the control file (Gp_Prior::read_ctrlfile), or * from a double vector passed from R (Gp_Prior::read_double) */ corr_prior = NULL; beta_prior = BFLAT; /* B0, BMLE (Emperical Bayes), BFLAT, or B0NOT, BMZT, BMZNOT */ /* LINEAR, CONSTANT, or 2LEVEL, which determines col */ this->mean_fn = mean_fn; switch(mean_fn) { case CONSTANT: col = 1; break; case LINEAR: col = d+1; break; default: error("unrecognized mean function: %d", mean_fn); } /* regression coefficients */ b = new_zero_vector(col); s2 = 1.0; /* variance parammer */ tau2 = 1.0; /* linear variance parammer */ default_s2_priors(); /* set s2_a0 and s2_g0 */ default_s2_lambdas(); /* set s2_a0_lambda and s2_g0_lambda */ default_tau2_priors(); /* set tau2_a0 and tau2_g0 */ default_tau2_lambdas(); /* set tau2_a0_lambda and tau2_g0_lambda */ /* * other computed hierarchical priors */ /* mu = zeros(1,col)'; */ /* TREE.b0 = zeros(col,1); */ b0 = new_zero_vector(col); mu = new_zero_vector(col); rho = col+1; /* Ci = diag(ones(1,col)); */ /* Note: do not change this from an ID matrix, because there is code below (particularly log_Prior) which assumes it is */ Ci = new_id_matrix(col); /* V = diag(2*ones(1,col)); */ V = new_id_matrix(col); for(unsigned int i=0; iInit(&(hier[4+col+col*col])); } /* * InitT: * * (re-) initialize the T matrix based on the choice of beta * prior (assume memory has already been allocated). This is * required for the asserts in the Compute function. Might * consider getting rid of this later. */ void Gp_Prior::InitT(void) { assert(Ti && T && Tchol); if(beta_prior == BFLAT) { zero(Ti, col, col); zero(T, col, col); zero(Tchol, col, col); } else { id(Ti, col); id(T, col); id(Tchol, col); } } /* * Dup: * * duplicate the Gp_Prior, and set the corr prior properly */ Base_Prior* Gp_Prior::Dup(void) { Gp_Prior *prior = new Gp_Prior(this); prior->CorrPrior()->SetBasePrior(prior); return prior; } /* * Gp_Prior: * * duplication constructor function */ Gp_Prior::Gp_Prior(Base_Prior *prior) : Base_Prior(prior) { assert(prior); assert(prior->BaseModel() == GP); Gp_Prior *p = (Gp_Prior*) prior; /* linear parameters */ mean_fn = p->mean_fn; beta_prior = p->beta_prior; s2 = p->s2; tau2 = p->tau2; b = new_dup_vector(p->b, col); b0 = new_dup_vector(p->b0, col); mu = new_dup_vector(p->mu, col); rho = p->rho; /* linear prior matrices */ Ci = new_dup_matrix(p->Ci, col, col); V = new_dup_matrix(p->V, col, col); rhoVi = new_dup_matrix(p->rhoVi, col, col); T = new_dup_matrix(p->T, col, col); Ti = new_dup_matrix(p->Ti, col, col); Tchol = new_dup_matrix(p->Tchol, col, col); /* variance parameters */ s2_a0 = p->s2_a0; s2_g0 = p->s2_g0; s2_a0_lambda = p->s2_a0_lambda; s2_g0_lambda = p->s2_g0_lambda; fix_s2 = p->fix_s2; /* linear variance parameters */ tau2_a0 = p->tau2_a0; tau2_g0 = p->tau2_g0; tau2_a0_lambda = p->tau2_a0_lambda; tau2_g0_lambda = p->tau2_g0_lambda; fix_tau2 = p->fix_tau2; /* corr prior */ assert(p->corr_prior); corr_prior = p->corr_prior->Dup(); } /* * ~Gp_Prior: * * the usual destructor, nothing fancy */ Gp_Prior::~Gp_Prior(void) { free(b); free(mu); free(b0); delete_matrix(Ci); delete_matrix(V); delete_matrix(rhoVi); delete_matrix(T); delete_matrix(Ti); delete_matrix(Tchol); delete corr_prior; } /* * read_double * * takes params from a double array, * for use with communication with R */ void Gp_Prior::read_double(double * dparams) { int bp = (int) dparams[0]; /* read the beta linear prior model */ switch (bp) { case 0: beta_prior=B0; /* MYprintf(MYstdout, "linear prior: b0 hierarchical\n"); */ break; case 1: beta_prior=BMLE; /* MYprintf(MYstdout, "linear prior: emperical bayes\n"); */ break; case 2: beta_prior=BFLAT; /* MYprintf(MYstdout, "linear prior: flat\n"); */ break; case 3: beta_prior=B0NOT; /* MYprintf(MYstdout, "linear prior: cart\n"); */ break; case 4: beta_prior=BMZT; /* MYprintf(MYstdout, "linear prior: b0 fixed with free tau2\n"); */ break; case 5: beta_prior=BMZNOT; /* MYprintf(MYstdout, "linear prior: b0 fixed with fixed tau2\n"); */ break; default: error("bad linear prior model %d", (int)dparams[0]); break; } /* must properly initialize T, based on beta_prior */ InitT(); /* reset dparams to after the above parameters */ dparams += 1; /* read starting/prior beta linear regression parameter (mean) vector */ dupv(b, dparams, col); if(beta_prior != BFLAT) dupv(b0, dparams, col); /* MYprintf(MYstdout, "starting beta="); printVector(b, col, MYstdout, HUMAN); */ dparams += col; /* reset */ /* reading the starting/prior beta linear regression parameter (inv-cov) matrix */ if(beta_prior != BFLAT) { dupv(Ti[0], dparams, col*col); inverse_chol(Ti, T, Tchol, col); } dparams += col*col; /* read starting (initial values) parameter */ s2 = dparams[0]; if(beta_prior != BFLAT) tau2 = dparams[1]; // MYprintf(MYstdout, "starting s2=%g tau2=%g\n", s2, tau2); /* read s2 hierarchical prior parameters */ s2_a0 = dparams[2]; s2_g0 = dparams[3]; // MYprintf(MYstdout, "s2[a0,g0]=[%g,%g]\n", s2_a0, s2_g0); dparams += 4; /* reset */ /* s2 hierarchical lambda prior parameters */ if((int) dparams[0] == -1) { fix_s2 = true; /* MYprintf(MYstdout, "fixing s2 prior\n"); */ } else { s2_a0_lambda = dparams[0]; s2_g0_lambda = dparams[1]; // MYprintf(MYstdout, "s2 lambda[a0,g0]=[%g,%g]\n", s2_a0_lambda, s2_g0_lambda); } /* read tau2 hierarchical prior parameters */ if(beta_prior != BFLAT && beta_prior != B0NOT) { tau2_a0 = dparams[2]; tau2_g0 = dparams[3]; // MYprintf(MYstdout, "tau2[a0,g0]=[%g,%g]\n", tau2_a0, tau2_g0); } dparams += 4; /* reset */ /* tau2 hierarchical lambda prior parameters */ if(beta_prior != BFLAT && beta_prior != B0NOT) { if((int) dparams[0] == -1) { fix_tau2 = true; /* MYprintf(MYstdout, "fixing tau2 prior\n"); */ } else { tau2_a0_lambda = dparams[0]; tau2_g0_lambda = dparams[1]; // MYprintf(MYstdout, "tau2 lambda[a0,g0]=[%g,%g]\n", // tau2_a0_lambda, tau2_g0_lambda); } } dparams += 2; /* reset */ /* read the corr model */ switch ((int) dparams[0]) { case 0: corr_prior = new Exp_Prior(d); //MYprintf(MYstdout, "correlation: isotropic power exponential\n"); break; case 1: corr_prior = new ExpSep_Prior(d); //MYprintf(MYstdout, "correlation: separable power exponential\n"); break; case 2: corr_prior = new Matern_Prior(d); //MYprintf(MYstdout, "correlation: isotropic matern\n"); break; case 3: corr_prior = new MrExpSep_Prior(d-1); //MYprintf(MYstdout, "correlation: two-level seperable power mixture\n"); break; case 4: corr_prior = new Sim_Prior(d); //MYprintf(MYstdout, "correlation: sim power exponential\n"); break; case 5: corr_prior = new Twovar_Prior(d); //MYprintf(MYstdout, "correlation: sim power exponential\n"); break; default: error("bad corr model %d", (int)dparams[0]); } /* set the gp_prior for this corr_prior */ corr_prior->SetBasePrior(this); /* read the rest of the parameters into the corr prior module */ corr_prior->read_double(&(dparams[1])); } /* * read_ctrlfile: * * takes params from a control file */ void Gp_Prior::read_ctrlfile(ifstream *ctrlfile) { char line[BUFFMAX], line_copy[BUFFMAX]; /* check that col is valid for the mean function */ /* later we will just enforce this inside the C code, rather than reading col through the control file */ if(mean_fn == LINEAR && col != d+1) error("col should be d+1 for linear mean function"); else if(mean_fn == CONSTANT && col != 1) error("col should be 1 for constant mean function"); /* read the beta prior model */ /* B0, BMLE (Emperical Bayes), BFLAT, or B0NOT, BMZT, BMZNOT */ ctrlfile->getline(line, BUFFMAX); if(!strncmp(line, "bmznot", 7)) { beta_prior = BMZNOT; MYprintf(MYstdout, "beta prior: b0 fixed with fixed tau2 \n"); } else if(!strncmp(line, "bmzt", 5)) { beta_prior = BMZT; MYprintf(MYstdout, "beta prior: b0 fixed with free tau2 \n"); } else if(!strncmp(line, "bmle", 4)) { beta_prior = BMLE; MYprintf(MYstdout, "beta prior: emperical bayes\n"); } else if(!strncmp(line, "bflat", 5)) { beta_prior = BFLAT; MYprintf(MYstdout, "beta prior: flat \n"); } else if(!strncmp(line, "b0not", 5)) { beta_prior = B0NOT; MYprintf(MYstdout, "beta prior: cart \n"); } else if(!strncmp(line, "b0", 2)) { beta_prior = B0; MYprintf(MYstdout, "beta prior: b0 hierarchical \n"); } else { error("%s is not a valid beta prior", strtok(line, "\t\n#")); } /* must properly initialize T, based on beta_prior */ InitT(); /* read the beta regression coefficients from the control file */ ctrlfile->getline(line, BUFFMAX); read_beta(line); MYprintf(MYstdout, "starting beta="); printVector(b, col, MYstdout, HUMAN); /* read the s2 and tau2 initial parameter from the control file */ ctrlfile->getline(line, BUFFMAX); s2 = atof(strtok(line, " \t\n#")); if(beta_prior != BFLAT) tau2 = atof(strtok(NULL, " \t\n#")); MYprintf(MYstdout, "starting s2=%g tau2=%g\n", s2, tau2); /* read the s2-prior parameters (s2_a0, s2_g0) from the control file */ ctrlfile->getline(line, BUFFMAX); s2_a0 = atof(strtok(line, " \t\n#")); s2_g0 = atof(strtok(NULL, " \t\n#")); MYprintf(MYstdout, "s2[a0,g0]=[%g,%g]\n", s2_a0, s2_g0); /* read the tau2-prior parameters (tau2_a0, tau2_g0) from the ctrl file */ ctrlfile->getline(line, BUFFMAX); if(beta_prior != BFLAT && beta_prior != B0NOT) { tau2_a0 = atof(strtok(line, " \t\n#")); tau2_g0 = atof(strtok(NULL, " \t\n#")); MYprintf(MYstdout, "tau2[a0,g0]=[%g,%g]\n", tau2_a0, tau2_g0); } /* read the s2-prior hierarchical parameters * (s2_a0_lambda, s2_g0_lambda) from the control file */ fix_s2 = false; ctrlfile->getline(line, BUFFMAX); strcpy(line_copy, line); if(!strcmp("fixed", strtok(line_copy, " \t\n#"))) { fix_s2 = true; MYprintf(MYstdout, "fixing s2 prior\n"); } else { s2_a0_lambda = atof(strtok(line, " \t\n#")); s2_g0_lambda = atof(strtok(NULL, " \t\n#")); MYprintf(MYstdout, "s2 lambda[a0,g0]=[%g,%g]\n", s2_a0_lambda, s2_g0_lambda); } /* read the s2-prior hierarchical parameters * (tau2_a0_lambda, tau2_g0_lambda) from the control file */ fix_tau2 = false; ctrlfile->getline(line, BUFFMAX); strcpy(line_copy, line); if(beta_prior != BFLAT && beta_prior != B0NOT) { if(!strcmp("fixed", strtok(line_copy, " \t\n#"))) { fix_tau2 = true; MYprintf(MYstdout, "fixing tau2 prior\n"); } else { tau2_a0_lambda = atof(strtok(line, " \t\n#")); tau2_g0_lambda = atof(strtok(NULL, " \t\n#")); MYprintf(MYstdout, "tau2 lambda[a0,g0]=[%g,%g]\n", tau2_a0_lambda, tau2_g0_lambda); } } /* read the correlation model type */ /* EXP, EXPSEP, MATERN or MREXPSEP */ ctrlfile->getline(line, BUFFMAX); if(!strncmp(line, "expsep", 6)) { corr_prior = new ExpSep_Prior(d); // MYprintf(MYstdout, "correlation: separable power exponential\n"); } else if(!strncmp(line, "exp", 3)) { corr_prior = new Exp_Prior(d); // MYprintf(MYstdout, "correlation: isotropic power exponential\n"); } else if(!strncmp(line, "matern", 6)) { corr_prior = new Matern_Prior(d); // MYprintf(MYstdout, "correlation: isotropic matern\n"); } else if(!strncmp(line, "mrexpsep", 8)) { corr_prior = new MrExpSep_Prior(d-1); // MYprintf(MYstdout, "correlation: multi-res seperable power\n"); } else if(!strncmp(line, "sim", 3)) { corr_prior = new Sim_Prior(d); // MYprintf(MYstdout, "correlation: sim power exponential\n"); } else if(!strncmp(line, "twovar", 3)) { corr_prior = new Twovar_Prior(d); // MYprintf(MYstdout, "correlation: twovar linear\n"); } else { error("%s is not a valid correlation model", strtok(line, "\t\n#")); } /* set the gp_prior for this corr_prior */ corr_prior->SetBasePrior(this); /* read the rest of the parameters into the corr prior module */ corr_prior->read_ctrlfile(ctrlfile); } /* * default_s2_priors: * * set s2 prior parameters * to default values */ void Gp_Prior::default_s2_priors(void) { s2_a0 = 5; s2_g0 = 10; } /* * default_tau2_priors: * * set tau2 prior parameters * to default values */ void Gp_Prior::default_tau2_priors(void) { tau2_a0 = 5; tau2_g0 = 10; } /* * default_tau2_priors: * * set tau2 (lambda) hierarchical prior parameters * to default values */ void Gp_Prior::default_tau2_lambdas(void) { tau2_a0_lambda = 0.2; tau2_g0_lambda = 10; fix_tau2 = false; } /* * default_s2_lambdas: * * set s2 (lambda) hierarchical prior parameters * to default values */ void Gp_Prior::default_s2_lambdas(void) { s2_a0_lambda = 0.2; s2_g0_lambda = 10; fix_s2 = false; } /* * read_beta: * * read starting beta from the control file and * save it for later use */ void Gp_Prior::read_beta(char *line) { b[0] = atof(strtok(line, " \t\n#")); for(unsigned int i=1; iPrint(outfile); } /* * Draws: * * draws for the parameters to the hierarchical priors * depends on the top level-leaf parameters. * Also prints the state based on round r */ void Gp_Prior::Draw(Tree** leaves, unsigned int numLeaves, void *state) { double **b, **bmle, *s2, *tau2; unsigned int *n; Corr **corr; /* allocate temporary parameters for each leaf node */ allocate_leaf_params(col, &b, &s2, &tau2, &n, &corr, leaves, numLeaves); if(beta_prior == BMLE) bmle = new_matrix(numLeaves, col); else bmle = NULL; /* for use in b0 and Ti draws */ /* collect bmle parameters from the leaves */ if(beta_prior == BMLE) for(unsigned int i=0; iGetBase()))->Bmle(), col); /* draw hierarchical parameters */ if(beta_prior == B0 || beta_prior == BMLE) { b0_draw(b0, col, numLeaves, b, s2, Ti, tau2, mu, Ci, state); Ti_draw(Ti, col, numLeaves, b, bmle, b0, rho, V, s2, tau2, state); if(mean_fn == CONSTANT) this->T[0][0] = 1.0/Ti[0][0]; else inverse_chol(Ti, (this->T), Tchol, col); } /* update the corr and sigma^2 prior params */ /* tau2 prior first */ if(!fix_tau2 && beta_prior != BFLAT && beta_prior != B0NOT && beta_prior != BMZNOT) { unsigned int *colv = new_ones_uivector(numLeaves, col); sigma2_prior_draw(&tau2_a0,&tau2_g0,tau2,numLeaves,tau2_a0_lambda, tau2_g0_lambda,colv,state); free(colv); } /* subtract col from n for sigma2_prior_draw when using flat BETA prior */ if(beta_prior == BFLAT) for(unsigned int i=0; i= col); n[i] -= col; } /* then sigma2 prior */ if(!fix_s2) sigma2_prior_draw(&s2_a0,&s2_g0,s2,numLeaves,s2_a0_lambda, s2_g0_lambda,n,state); /* then corr prior */ corr_prior->Draw(corr, numLeaves, state); /* clean up the garbage */ deallocate_leaf_params(b, s2, tau2, n, corr); if(beta_prior == BMLE) delete_matrix(bmle); } /* * get_Ti: * * return Ti: inverse of the covariance matrix * for Beta prior */ double** Gp_Prior::get_Ti(void) { return Ti; } /* * get_T: * * return T: covariance matrix for the Beta prior */ double** Gp_Prior::get_T(void) { return T; } /* * get_b0: * * return b0: prior mean for Beta */ double* Gp_Prior::get_b0(void) { return b0; } /* * ForceLinear: * * Toggle the entire partition into Linear Model mode */ void Gp::ForceLinear(void) { if(! Linear()) { corr->ToggleLinear(); Update(X, n, d, Z); Compute(); } } /* * ForceNonlinear: * * Toggle the entire partition into GP mode */ void Gp::ForceNonlinear(void) { if(Linear()) { corr->ToggleLinear(); Update(X, n, d, Z); Compute(); } } /* * Linear: * * return true if this leav is under a linear model * false otherwise */ bool Gp::Linear(void) { return corr->Linear(); } /* * sum_b: * * return the count of the dimensions under the LLM */ unsigned int Gp::sum_b(void) { return corr->sum_b(); } /* * Bmle * * return ML estimate for beta */ double* Gp::Bmle(void) { return bmle; } /* * State: * * return some Gp state information (corr state information * in particular, for printing in the main meta model */ char* Gp::State(unsigned int which) { assert(corr); return(corr->State(which)); } /* * allocate_leaf_params: * * allocate arrays to hold the current parameter * values at each leaf (of numLeaves) of the tree */ void allocate_leaf_params(unsigned int col, double ***b, double **s2, double **tau2, unsigned int **n, Corr ***corr, Tree **leaves, unsigned int numLeaves) { *b = new_matrix(numLeaves, col); *s2 = new_vector(numLeaves); *tau2 = new_vector(numLeaves); *corr = (Corr **) malloc(sizeof(Corr *) * numLeaves); *n = new_uivector(numLeaves); /* collect parameters from the leaves */ for(unsigned int i=0; iGetBase()); dupv((*b)[i], gp->all_params(&((*s2)[i]), &((*tau2)[i]), &((*corr)[i])), col); (*n)[i] = gp->N(); } } /* * deallocate_leaf_params: * * deallocate arrays used to hold the current parameter * values at each leaf of numLeaves */ void deallocate_leaf_params(double **b, double *s2, double *tau2, unsigned int *n, Corr **corr) { delete_matrix(b); free(s2); free(tau2); free(corr); free(n); } /* * newBase: * * generate a new Gp base model whose * parameters have priors from the from this class */ Base* Gp_Prior::newBase(Model *model) { return new Gp(d, (Base_Prior*) this, model); } /* * log_HierPrior: * * return the (log) prior density of the Gp base * hierarchical prior parameters, e.g., B0, W (or T), * etc., and additionaly add in the prior of the parameters * to the correllation model prior */ double Gp_Prior::log_HierPrior(void) { double lpdf = 0.0; /* start with the b0 prior, if this part of the model is on */ if(beta_prior == B0 || beta_prior == BMLE) { /* this is probably overkill because Ci is an ID matrix */ lpdf += mvnpdf_log_dup(b0, mu, Ci, col); /* then do the wishart prior for T (which is called W in the paper) */ lpdf += wishpdf_log(Ti, rhoVi, col, rho); } /* hierarchical GP variance */ if(!fix_s2) lpdf += hier_prior_log(s2_a0, s2_g0, s2_a0_lambda, s2_g0_lambda); /* hierarchical Linear varaince */ if(!fix_tau2 && beta_prior != BFLAT && beta_prior != B0NOT) lpdf += hier_prior_log(tau2_a0, tau2_g0, tau2_a0_lambda, tau2_g0_lambda); /* then add the hierarchical part for the correllation function */ lpdf += corr_prior->log_HierPrior(); /* return the resulting log pdf*/ return lpdf; } /* * TraceNames: * * returns the names of the traces of the hierarchal parameters * recorded in Gp_Prior::Trace() */ char** Gp_Prior::TraceNames(unsigned int* len, bool full) { /* first get the correllation function parameters */ unsigned int clen; char **c = corr_prior->TraceNames(&clen); /* calculate and allocate the new trace, which will include the corr trace */ *len = 4 + col; /* if full=TRUE then add in Ti */ if(full) *len += col*col; /* allocate trace vector */ char** trace = (char**) malloc(sizeof(char*) * (clen + *len)); /* copy sigma^2 and tau^2 */ trace[0] = strdup("s2.a0"); trace[1] = strdup("s2.g0"); trace[2] = strdup("tau2.a0"); trace[3] = strdup("tau2.g0"); /* then copy beta */ for(unsigned int i=0; iTrace(&clen); /* calculate and allocate the new trace, which will include the corr trace */ *len = 4 + col; /* if full=TRUE, add in Ti */ if(full) *len += col*col; /* allocate the trace vector */ double* trace = new_vector(clen + *len); /* copy sigma^2 and tau^2 */ trace[0] = s2_a0; trace[1] = s2_g0; trace[2] = tau2_a0; trace[3] = tau2_g0; /* then copy beta */ dupv(&(trace[4]), b0, col); /* if full=TRUE, then add in Ti */ if(full) { dupv(&(trace[4+col]), Ti[0], col*col); } /* then copy in the corr trace */ dupv(&(trace[*len]), c, clen); /* new combined length, and free c */ *len += clen; if(c) free(c); else assert(clen == 0); return trace; } /* * GamLin: * * return gamlin[which] from corr_prior; must have * 0 <= which <= 2 */ double Gp_Prior::GamLin(unsigned int which) { assert(which < 3); double *gamlin = corr_prior->GamLin(); return gamlin[which]; } tgp/src/rand_pdf.h0000644000176200001440000000444313531032535013566 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __RAND_PDF_H__ #define __RAND_PDF_H__ void gampdf_log(double *p, double *x, double a, double b, unsigned int n); void gampdf_log_gelman(double *p, double *x, double a, double b, unsigned int n); void invgampdf_log_gelman(double *p, double *x, double a, double b, unsigned int n); void betapdf_log(double *p, double *x, double a, double b, unsigned int n); void normpdf_log(double *p, double *x, double mu, double s2, unsigned int n); void copyCovLower(double **cov, double **Sigma, unsigned int n, double scale); void copyCovUpper(double **cov, double **Sigma, unsigned int n, double scale); double mvnpdf_log_dup(double *x, double *mu, double **cov, unsigned int n); double mvnpdf_log(double *x, double *mu, double **cov, unsigned int n); double log_determinant(double **M, unsigned int n); double log_determinant_dup(double **M, unsigned int n); double log_determinant_chol(double **M, unsigned int n); double wishpdf_log(double **x, double **S, unsigned int n, unsigned int nu); double temper(double p, double temp, int uselog); void temper_invgam(double *a, double *b, double temp); void temper_gamma(double *a, double *b, double temp); void temper_wish(int *rho, double **V, unsigned int col, double temp); #endif tgp/src/lik_post.h0000644000176200001440000000315613531032535013635 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __LIK_POST_H__ #define __LIK_POST_H__ double post_margin_rj(unsigned int n, unsigned int col, double lambda, double **Vb, double log_detK, double **T, double tau2, double a0, double g0, double temp); double post_margin(unsigned int n, unsigned int col, double lambda, double **Vb, double log_detK, double a0, double g0, double temp); double gp_lhood(double *Z, unsigned int n, unsigned int col, double **F, double *beta, double s2, double **Ki, double log_det_K, double *Kdiag, double temp); #endif tgp/src/tgp.h0000644000176200001440000001202013531032535012571 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __TGP_H__ #define __TGP_H__ #include #include #include "model.h" #include "params.h" #include "temper.h" class Tgp { private: time_t itime; /* time stamp for periodic R interaction */ void *state; /* RNG (random number generator) state */ unsigned int n; /* n inputs (number of rows in X) */ unsigned int d; /* d covariates (number of cols in X) */ unsigned int nn; /* number of predictive locations (rows in XX) */ unsigned int nsplit; /* number of rows in Xsplit, nsplit likely n+nn */ bool trace; /* indicates whether traces for XX should be sent to files */ unsigned int B; /* number of burn-in rounds */ unsigned int T; /* total number of MCMC rounds (including burn-in) */ unsigned int E; /* sample from posterior (E)very somany rounds */ unsigned int R; /* number of times to (Re-) start over (>=1) */ int verb; /* indicates the verbosity of print statements */ double *tree; /* double-vector tree representation */ unsigned int treecol; /* number of cols in double-vector tree representation */ double *hier; /* double-vector hierarchical prior representation */ double *dparams; /* double-vector of user-specified parameterization */ Temper *its; /* set of inv-temperatures for importance tempering */ bool linburn; /* initialize with treed LM before burn in? */ bool pred_n; /* sample from posterior predictive at data locs? */ bool krige; /* gather kriging statistics? */ bool delta_s2; /* gather ALC statistics? */ int improv; /* gather IMPROV statistics -- at what power? */ bool sens; /* is this a Sensitivity Analysis? */ double **X; /* n-by-d input (design matrix) data */ double *Z; /* response vector of length n */ double **XX; /* nn-by-d (design matrix) of predictive locations */ double **Xsplit; /* (nsplit)-by-d rbind(X,XX) matrix for rect & tree splits */ Params *params; /* prior-parameters module */ double **rect; /* bounding rectangle of the (design matrix) data X */ Model *model; /* pointer to the (treed GP) model */ Preds *cump; /* data structure for gathering posterior pred samples */ Preds *preds; /* inv-temporary for posteior pred samples */ public: /* constructor and destructor */ Tgp(void *state, int n, int d, int nn, int B, int T, int E, int R, int linburn, bool pred_n, bool krige, bool delta_s2, int improv, bool sens, double *X, double *Z, double *XX, double *Xsplit, int nsplit, double *dparams, double *ditemps, bool trace, int verb, double *dtree, double *hier); ~Tgp(void); /* a function that should only be called just after constructor */ void Init(void); /* functions that do all the TGP modelling work */ void Rounds(void); void Predict(void); /* posterior predictive summary statistics */ void GetStats(bool report, double *Zp_mean, double *ZZ_mean, double *Zp_km, double *ZZ_km, double *Zp_kvm, double *ZZ_kvm, double *Zp_q, double *ZZ_q, bool zcov, double *Zp_s2, double *ZZ_s2, double *ZpZZ_s2, double *Zp_ks2, double *ZZ_ks2, double *Zp_q1, double *Zp_median, double *Zp_q2, double *ZZ_q1, double *ZZ_median, double *ZZ_q2, double *Ds2x, double *improvec, int numirank, int* irank, double *ess); /* Importance Tempering */ void GetPseudoPrior(double *ditemps); /* Sensitivity Analysis */ void Sens(int *ngrid_in, double *span_in, double *sens_XX, double *sens_ZZ_mean, double *sens_ZZ_q1,double *sens_ZZ_q2, double *sens_S, double *sens_T); /* printing */ void Print(FILE *outfile); int Verb(void); /* tree statistics */ void GetTreeStats(double *gpcs); }; /* input and output data processing */ double ** getXdataRect(double **X, unsigned int n, unsigned int d, double **XX, unsigned int nn); #endif tgp/src/rand_draws.h0000644000176200001440000000603413531032535014133 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __RAND_DRAWS_H__ #define __RAND_DRAWS_H__ #include #define CRAN 901 #define RK 902 #define ERAND 903 #define RNG RK void gamma_mult(double *x, double alpha, double beta, unsigned int cases, void *state); void gamma_mult_gelman(double *x, double alpha, double beta, unsigned int cases, void *state); void inv_gamma_mult_gelman(double *x, double alpha, double beta, unsigned int cases, void *state); void beta_mult(double *x, double alpha, double beta, unsigned int cases, void *state); void wishrnd(double **x, double **S, unsigned int n, unsigned int nu, void *state); void mvnrnd(double *x, double *mu, double **cov, unsigned int n, void *state); void mvnrnd_mult(double *x, double *mu, double **Sigma, unsigned int n, unsigned int cases, void *state); void rnor(double *x, void *state); void rnorm_mult(double *x, unsigned int n, void *state); double runi(void *state); void runif_mult(double* r, double a, double b, unsigned int n, void *state); void dsample(double *x_out, unsigned int *x_indx, unsigned int n, unsigned int num_probs, double *X, double *probs, void *state); void isample(int *x_out, unsigned int *x_indx, unsigned int n, unsigned int num_probs, int *X, double *probs, void *state); void isample_norep(int *x_out, unsigned int *x_indx, unsigned int n, unsigned int num_probs, int *X, double *probs, void *state); int sample_seq(int from, int to, void *state); double rgamma1(double aa, void *state); double rbet(double aa, double bb, void *state); unsigned int rpoiso(float xm, void *state); double* compute_probs(double* criteria, unsigned int nn, double alpha); void propose_indices(int *di, double prob, void *state); void get_indices(int *i, double *parameter); unsigned int* rand_indices(unsigned int N, void* state); void* newRNGstate(unsigned long s); void* newRNGstate_rand(void *s); void deleteRNGstate(void *seed); void printRNGstate(void *state, FILE* outfile); unsigned long three2lstate(int *state); #endif tgp/src/gp.h0000644000176200001440000001627613531032535012426 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __GP_H__ #define __GP_H__ #include #include "corr.h" #include "base.h" /* not including tree.h */ class Tree; #define BUFFMAX 256 typedef enum BETA_PRIOR {B0=801, BMLE=802, BFLAT=803, B0NOT=804, BMZT=805, BMZNOT=806} BETA_PRIOR; typedef enum MEAN_FN {LINEAR=901, CONSTANT=902, TWOLEVEL=903} MEAN_FN; class Gp : public Base { private: double **F; /* col x n, matrix */ double **FF; /* col x nn, matrix */ double **xxKx; /* nn x n, cross covariance between XX and X */ double **xxKxx; /* nn x nn, cross covariance between XX and XX */ double *b; /* dimension=col, beta: linear coefficients */ double s2; /* sigma^2: process variance */ double tau2; /* tau^2: linear variance */ Corr_Prior *corr_prior; /* prior model for the correlation function */ Corr *corr; /* unspecified correllation family */ double **Vb; /* variance of Gibbs beta step */ double *bmu; /* mean of gibbs beta step */ double *bmle; /* linear coefficients mle w/o Gp */ double lambda; /* parameter in marginalized beta */ public: Gp(unsigned int d, Base_Prior *prior, Model *model); Gp(double **X, double *Z, Base *gp_old, bool economy); virtual ~Gp(void); virtual Base* Dup(double **X, double *Z, bool economy); virtual void Clear(void); virtual void ClearPred(void); virtual void Update(double **X, unsigned int n, unsigned int d, double *Z); virtual void UpdatePred(double **XX, unsigned int nn, unsigned int d, bool Ds2xy); virtual bool Draw(void *state); virtual void Predict(unsigned int n, double *zp, double *zpm, double *zpvm, double *zps2, unsigned int nn, double *zz, double *zzm, double *zzvm, double *zzs2, double **ds2xy, double *improv, double Zmin, bool err, void *state); virtual void Match(Base* gp_old); virtual void Combine(Base *l_gp, Base *r_gp,void *state); virtual void Split(Base *l_gp, Base *r_gp, void *state); virtual double Posterior(void); virtual double MarginalLikelihood(double itemp); virtual double Likelihood(double itemp); virtual double FullPosterior(double itemp); virtual double MarginalPosterior(double itemp); virtual void Compute(void); virtual void ForceLinear(void); virtual void ForceNonlinear(void); virtual bool Linear(void); virtual bool Constant(void); virtual void printFullNode(void); virtual double Var(void); virtual char* State(unsigned int which); virtual unsigned int sum_b(void); virtual void Init(double *dgp); virtual void X_to_F(unsigned int n, double **X, double **F); virtual double* Trace(unsigned int* len, bool full); virtual char** TraceNames(unsigned int* len, bool full); virtual double NewInvTemp(double itemp, bool isleaf); double* get_b(void); double *Bmle(void); double* all_params(double *s2, double *tau2, Corr** corr); void split_tau2(double *tau2_new, void *state); Corr *get_Corr(void); }; double combine_tau2(double l_tau2, double r_tau2, void *state); class Gp_Prior : public Base_Prior { private: BETA_PRIOR beta_prior; /* indicator for type of Beta Prior */ MEAN_FN mean_fn; Corr_Prior *corr_prior; double *b; /* starting: col, GP linear regression coefficients */ double s2; /* starting: GP variance parameter */ double tau2; /* starting: GP linear variance parameter */ double *b0; /* hierarchical non-tree parameter b0 */ /* (the T matrix is called W in the paper) */ double **Ti; /* hierearical non-tree parameter Ti */ double **T; /* inverse of Ti */ double **Tchol; /* for help in T=inv(Ti) */ double *mu; /* mean prior for b0 */ double **Ci; /* prior covariance for b0 */ unsigned int rho; /* prior df for T */ double **V; /* prior covariance for T */ double **rhoVi; /* (rho*V)^(-1) for Ti pdf calculation */ double s2_a0; /* s2 prior alpha parameter */ double s2_g0; /* s2 prior beta parameter */ double s2_a0_lambda; /* hierarchical s2 inv-gamma alpha parameter */ double s2_g0_lambda; /* hierarchical s2 inv-gamma beta parameter */ bool fix_s2; /* estimate hierarchical s2 parameters or not */ double tau2_a0; /* tau2 prior alpha parameter */ double tau2_g0; /* tau2 prior beta parameter */ double tau2_a0_lambda; /* hierarchical tau2 inv-gamma alpha parameter */ double tau2_g0_lambda; /* hierarchical tau2 inv-gamma beta parameter */ bool fix_tau2; /* estimate hierarchical tau2 parameters or not */ void initT(void); public: /* start public functions */ Gp_Prior(unsigned int d, MEAN_FN mean_fn); Gp_Prior(Base_Prior* prior); virtual ~Gp_Prior(void); virtual void read_ctrlfile(std::ifstream* ctrlfile); virtual void read_double(double *dparams); virtual void Init(double *dhier); virtual void Draw(Tree** leaves, unsigned int numLeaves, void *state); virtual bool LLM(void); virtual double ForceLinear(void); virtual void ResetLinear(double gamb); virtual void Print(FILE* outfile); virtual Base* newBase(Model *model); virtual Base_Prior* Dup(void); virtual double log_HierPrior(void); virtual double* Trace(unsigned int* len, bool full); virtual char** TraceNames(unsigned int* len, bool full); virtual double GamLin(unsigned int which); void InitT(void); void read_beta(char *line); void default_s2_priors(void); void default_s2_lambdas(void); void default_tau2_priors(void); void default_tau2_lambdas(void); double s2Alpha(void); double s2Beta(void); double tau2Alpha(void); double tau2Beta(void); double *B(void); double S2(void); double Tau2(void); double** get_T(void); double** get_Ti(void); double* get_b0(void); Corr_Prior* CorrPrior(void); BETA_PRIOR BetaPrior(void); MEAN_FN MeanFn(void); }; void allocate_leaf_params(unsigned int col, double ***b, double **s2, double **tau2, unsigned int **n, Corr ***corr, Tree **leaves, unsigned int numLeaves); void deallocate_leaf_params(double **b, double *s2, double *tau2, unsigned int *n, Corr **corr); #endif tgp/src/sim.h0000644000176200001440000001066713531032535012606 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __SIM_H__ #define __SIM_H__ #include "corr.h" class Sim_Prior; /* * CLASS for the implementation of the single index model * power family of correlation functions */ class Sim : public Corr { private: double *d; /* index parameter parameter */ unsigned int dreject; /* d rejection counter */ public: Sim(unsigned int dim, Base_Prior *base_prior); virtual Corr& operator=(const Corr &c); virtual ~Sim(void); virtual void Update(unsigned int n1, unsigned int n2, double **K, double **X, double **XX); virtual void Update(unsigned int n1, double **X); virtual void Update(unsigned int n1, double **K, double **X); virtual int Draw(unsigned int n, double **F, double **X, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); virtual void Combine(Corr *c1, Corr *c2, void *state); virtual void Split(Corr *c1, Corr *c2, void *state); virtual char* State(unsigned int which); virtual bool DrawNugs(unsigned int n, double **X, double **F, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); virtual double* Trace(unsigned int* len); virtual char** TraceNames(unsigned int* len); virtual void Init(double *dexpsep); virtual double* Jitter(unsigned int n1, double **X); virtual double* CorrDiag(unsigned int n1, double **X); virtual void Invert(unsigned int n); /* unused functions */ virtual unsigned int sum_b(void); virtual void ToggleLinear(void); void get_delta_d(Sim* c1, Sim* c2, void *state); void propose_new_d(Sim* c1, Sim* c2, void *state); void propose_new_d(double* d_new, double *q_fwd, double *q_bak, void *state); virtual double log_Prior(void); void draw_d_from_prior(double *d_new, void *state); double *D(void); }; /* * CLASS for the prior parameterization of the separable * exponential power family of correlation functions */ class Sim_Prior : public Corr_Prior { private: double *d; double **dp_cov_chol; /* prior standard deviation for proposals */ // double **dp_Rho; /* prior standard deviation for proposals */ double **d_alpha; /* d gamma-mixture prior alphas */ double **d_beta; /* d gamma-mixture prior beta */ bool fix_d; /* estimate d-mixture parameters or not */ double d_alpha_lambda[2]; /* d prior alpha lambda parameter */ double d_beta_lambda[2]; /* d prior beta lambda parameter */ public: Sim_Prior(unsigned int dim); Sim_Prior(Corr_Prior *c); virtual ~Sim_Prior(void); virtual void read_double(double *dprior); virtual void read_ctrlfile(std::ifstream* ctrlfile); virtual Corr_Prior* Dup(void); virtual void Draw(Corr **corr, unsigned int howmany, void *state); virtual Corr* newCorr(void); virtual void Print(FILE *outfile); virtual Base_Prior* BasePrior(void); virtual void SetBasePrior(Base_Prior *base_prior); virtual double log_HierPrior(void); virtual double* Trace(unsigned int* len); virtual char** TraceNames(unsigned int* len); virtual void Init(double *dhier); void draw_d_from_prior(double *d_new, void *state); double* D(void); double** DAlpha(void); double** DBeta(void); double** DpCov_chol(void); // double** DpRho(void); void default_d_priors(void); void default_d_lambdas(void); double log_Prior(double *d); double log_DPrior_pdf(double *d); void DPrior_rand(double *d_new, void *state); }; #endif tgp/src/corr.h0000644000176200001440000001542513531032535012760 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __CORR_H__ #define __CORR_H__ extern "C" { #include "rhelp.h" } #include #define BUFFMAX 256 //#define PRINTNUG #define REJECTMAX 1000 typedef enum CORR_MODEL {EXP=701, EXPSEP=702, MATERN=703, MREXPSEP=704, SIM=705} CORR_MODEL; class Model; /* not including model.h */ class Corr_Prior; class Base_Prior; /* * CLASS for the generic implementation of a correlation * function with nugget */ class Corr { private: protected: Base_Prior *base_prior;/* Base prior module */ Corr_Prior *prior; /* generic prior parameterization for nugget */ unsigned int dim; /* # of columns in the matrix X */ unsigned int col; /* # of columns in the design matrix F */ unsigned int n; /* number of input data points-- rows in the design matrix */ /* actual current covariance matrices */ double **K; /* n x n, covariance matrix */ double **Ki; /* n x n, utility inverse covariance matrix */ double **Kchol; /* n x n, covatiance matrix cholesy decomp */ double log_det_K; /* log determinant of the K matrix */ bool linear; /* is this the linear model? (d ?= 0) */ /* new utility matrices */ double **Vb_new; /* Utility: variance of Gibbs beta step */ double *bmu_new; /* Utility: mean of gibbs beta step */ double lambda_new; /* Utility: parameter in marginalized beta */ double **K_new; /* n x n, new (proposed) covariance matrix */ double **Ki_new; /* n x n, new (proposed) utility inverse covariance matrix */ double **Kchol_new; /* n x n, new (proposed) covatiance matrix cholesy decomp */ double log_det_K_new; /* log determinant of the K matrix */ double nug; /* the nugget parameter */ public: Corr(unsigned int dim, Base_Prior* base_prior); virtual ~Corr(void); virtual Corr& operator=(const Corr &c)=0; virtual int Draw(unsigned int n, double **F, double **X, double *Z,double *lambda, double **bmu, double **Vb, double tau2, double temp, void *state)=0; virtual void Update(unsigned int n1, unsigned int n2, double **K, double **X, double **XX)=0; virtual void Update(unsigned int n1, double **X)=0; virtual void Update(unsigned int n1, double **K, double **X)=0; virtual void Combine(Corr *c1, Corr *c2, void *state)=0; virtual void Split(Corr *c1, Corr *c2, void *state)=0; virtual char* State(unsigned int which)=0; virtual double log_Prior(void)=0; virtual unsigned int sum_b(void)=0; virtual void ToggleLinear(void)=0; virtual bool DrawNugs(unsigned int n, double **X, double **F, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double temp, void *state)=0; virtual double* Trace(unsigned int *len)=0; virtual char** TraceNames(unsigned int *len)=0; virtual void Init(double *dcorr)=0; virtual double* Jitter(unsigned int n1, double **X)=0; virtual double* CorrDiag(unsigned int n1, double **X)=0; virtual void Invert(unsigned int n)=0; unsigned int N(); double** get_Ki(void); double** get_K(void); double get_log_det_K(void); bool Linear(void); void Cov(Corr *cc); void printCorr(unsigned int n); // Move all this to the member classes double get_delta_nug(Corr* c1, Corr* c2, void *state); void propose_new_nug(Corr* c1, Corr* c2, void *state); void CombineNug(Corr *c1, Corr *c2, void *state); void SplitNug(Corr *c1, Corr *c2, void *state); void swap_new(double **Vb, double **bmu, double *lambda); void allocate_new(unsigned int n); //void Invert(unsigned int n); void deallocate_new(void); double Nug(void); double log_NugPrior(void); void NugInit(double nug, bool linear); }; /* * generic CLASS for the prior to the correlation function * including a nugget parameter */ class Corr_Prior { private: /* starting nugget value */ double nug; /* mixture prior parameters */ double nug_alpha[2]; /* nug gamma-mixture prior alphas */ double nug_beta[2]; /* nug gamma-mixture prior beta */ bool fix_nug; /* estimate nug-mixture parameters or not */ double nug_alpha_lambda[2]; /* nug prior alpha lambda parameter */ double nug_beta_lambda[2]; /* nug prior beta lambda parameter */ protected: CORR_MODEL corr_model; /* indicator for type of correllation model */ Base_Prior *base_prior; /* prior for the base model */ unsigned int dim; double gamlin[3]; /* gamma for the linear pdf */ public: Corr_Prior(const unsigned int dim); Corr_Prior(Corr_Prior *c); virtual ~Corr_Prior(void); CORR_MODEL CorrModel(void); virtual void read_double(double *dprior)=0; virtual void read_ctrlfile(std::ifstream* ctrlfile)=0; virtual void Draw(Corr **corr, unsigned int howmany, void *state)=0; virtual Corr* newCorr(void)=0; virtual void Print(FILE *outfile)=0; virtual Corr_Prior* Dup(void)=0; virtual Base_Prior* BasePrior(void)=0; virtual void SetBasePrior(Base_Prior *base_prior)=0; virtual double log_HierPrior(void)=0; virtual double* Trace(unsigned int* len)=0; virtual char** TraceNames(unsigned int* len)=0; virtual void Init(double *dhier)=0; void read_double_nug(double *dprior); void read_ctrlfile_nug(std::ifstream* ctrlfile); double log_NugPrior(double nug); double log_NugHierPrior(void); double Nug(void); void DrawNugHier(Corr **corr, unsigned int howmany, void *state); void default_nug_priors(void); void default_nug_lambdas(void); void fix_nug_prior(void); double *NugAlpha(void); double *NugBeta(void); double NugDraw(void *state); double* GamLin(void); bool Linear(void); bool LLM(void); double ForceLinear(void); void ResetLinear(double gam); double* NugTrace(unsigned int* len); char** NugTraceNames(unsigned int* len); void NugInit(double *dhier); bool FixNug(void); void PrintNug(FILE *outfile); }; #endif tgp/src/dopt.c0000644000176200001440000001436113723730123012753 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #include #include "rand_draws.h" #include "rand_pdf.h" #include "lh.h" #include "matrix.h" #include "dopt.h" #include "rhelp.h" #include "gen_covar.h" #include #include #define PWR 2.0 double DOPT_D(unsigned int m) { return 0.001*sq(m); } double DOPT_NUG(void) { return 0.01; } /* * dopt_gp: * * R wrapper function for the dopt function below for a sequential * doptimal design. The chosen design, of nn_in points are taken * to from the candidates to be Xcand[fi,:] */ void dopt_gp(state_in, nn_in, X_in, n_in, m_in, Xcand_in, ncand_in, iter_in, verb_in, fi_out) int *state_in; unsigned int *nn_in, *n_in, *m_in, *ncand_in, *iter_in, *verb_in; double *X_in, *Xcand_in; int *fi_out; { unsigned int nn, n, m, ncand, iter, verb; double **Xall, **X, **Xcand, **fixed, **rect; unsigned long lstate; void *state; lstate = three2lstate(state_in); state = newRNGstate(lstate); /* integral dimension parameters */ n = (unsigned int) *n_in; m = (unsigned int) *m_in; nn = (unsigned int) *nn_in; ncand = (unsigned int) *ncand_in; iter = (unsigned int) *iter_in; verb = (unsigned int) *verb_in; Xall = new_matrix(n+ncand, m); dupv(Xall[0], X_in, n*m); dupv(Xall[n], Xcand_in, ncand*m); rect = get_data_rect(Xall, n+ncand, m); delete_matrix(Xall); /* copy X from input */ X = new_zero_matrix(n+nn, m); fixed = new_matrix(n, m); if(fixed) dupv(fixed[0], X_in, n*m); normalize(fixed, rect, n, m, 1.0); Xcand = new_zero_matrix(ncand, m); dupv(Xcand[0], Xcand_in, ncand*m); normalize(Xcand, rect, ncand, m, 1.0); delete_matrix(rect); /* call dopt */ dopt(X, fi_out, fixed, Xcand, m, n, ncand, nn, DOPT_D((unsigned)m), DOPT_NUG(), iter, verb, state); delete_matrix(X); if(fixed) delete_matrix(fixed); delete_matrix(Xcand); deleteRNGstate(state); } /* * dopt: * * produces a sequential D-optimal design where the fixed * configurations are automatically included in the design, * and n1 of the candidates Xcand are chosen by maximizing * the determinant of joint covariance matrix based on * X = cbind(fixed, Xcand[fi,:]) using stochastic search. * The chosen design is provided by the indices fi, and * the last n1 rows of X */ void dopt(X, fi, fixed, Xcand, m, n1, n2, n, d, nug, iter, verb, state) unsigned int m,n1,n2,n,iter,verb; /*double fixed[n1][m], Xcand[n2][m], X[n+n1][m], fi[n];*/ double **fixed, **Xcand, **X; int *fi; double d, nug; void *state; /* remember, column major! */ { unsigned int i,j, ai, fii, changes; double *aprobs, *fprobs; unsigned int *o, *avail; double **DIST, **K; double log_det, log_det_new; int a, f; assert(n2 >= n); /* MYprintf(MYstderr, "d=%g, nug=%g\n", d, nug); */ /* set fixed into X */ dup_matrix(X, fixed, n1, m); DIST = new_matrix(n+n1, n+n1); K = new_matrix(n+n1, n+n1); avail = new_uivector(n2-n); /* get indices to randomly permuted the Xcand matrix with */ o = rand_indices(n2, state); /* free = I(1:n); */ /* X = [fixed, Xcand(:,free)]; */ for(i=0; i n) { /* no need to do iterations if ncand == n */ changes = 0; for(i=0; i #include "exp.h" #include "corr.h" #include "params.h" extern "C" { #include "matrix.h" } #include "base.h" typedef enum TREE_OP {GROW=201, PRUNE=202, CHANGE=203, CPRUNE=204, SWAP=205, ROTATE=206} TREE_OP; /* dummy prototype */ class Model; class Tree { private: /*variables */ Rect *rect; unsigned int n; /* number of input data locations */ unsigned int nn; /* number of predictive input data locations */ unsigned int d; /* dimension of the input data */ double **X; /* n x (col-1), data: spatial locations */ int *p; /* n, indices into original data */ double *Z; /* n, f(X) */ double **XX; /* nn x (col-1), predictive spatial locations */ int *pp; /* nn, indices into original XX */ Model* model; /* point to the model this (sub-)tree is in */ Base *base; /* point to the base (e.g., Gp) model */ unsigned int var; /* split point dimension */ double val; /* split point value */ Tree* parent; /* parent partition */ Tree* leftChild; /* partition LEQ (<=) split point */ Tree* rightChild; /* partition GT (>) split point */ Tree* next; /* used for making lists of tree nodes */ unsigned int depth; /* depth of partition in tree */ FILE* OUTFILE; /* where to print tree-specific info */ int verb; /* printing level (0=none, ... , 3+=verbose); */ private: /* functions */ /* auxiliaty swap functions */ bool rotate(void *state); void rotate_right(void); void rotate_left(void); double pT_rotate(Tree* low, Tree* high); void swapData(Tree* t); void adjustDepth(int a); /* change point probability calculations & proposals */ void val_order_probs(double **Xo, double **probs, unsigned int var, double **rX, unsigned int rn); double split_prob(void); double propose_split(double *p, void *state); double propose_val(void *state); /* create lists of tree nodes, * and traverse them from first to next ... to last */ unsigned int leaves(Tree** first, Tree** last); unsigned int prunable(Tree** first, Tree** last); unsigned int internals(Tree **first, Tree **last); unsigned int swapable(Tree **first, Tree **last); /* creating new leaves, and removing them */ unsigned int grow_child(Tree** child, FIND_OP op); int part_child(FIND_OP op, double ***Xc, int **pnew, unsigned int *plen, double **Zc, Rect **newRect); bool grow_children(void); bool try_revert(bool success, Tree* oldLC, Tree* oldRC, int old_var, double old_val); bool match(Tree* oldT, void *state); /* compute lost of the posterior * (likelihood + plus some prior stuff) * of a particular lef, or all leaves */ double leavesPosterior(void); double Posterior(void); unsigned int leavesN(void); public: /* constructor, destructor and misc partition initialization */ Tree(double **X, int *p, unsigned int n, unsigned int d, double *Z, Rect* rect, Tree* parent, Model* model); Tree(const Tree *oldt, bool economy); void Init(double *dtree, unsigned int nrow, double **iface_rect); ~Tree(void); void delete_XX(void); /* things that model (module) will initiate * on ONLY leaf nodes */ void Predict(double *Zp, double *Zpm, double *Zpvm, double *Zps2,double *ZZ, double *ZZm, double *ZZvm, double *ZZs2, double *Ds2x, double *improv, double Zmin, unsigned int wZmin, bool err, void *state); /* propose tree operations */ bool grow(double ratio, void *state); bool prune(double ratio, void *state); bool change(void *state); bool swap(void *state); void cut_branch(void); void new_data(double **X_new, unsigned int n_new, unsigned int d_new, double *Z_new, int *p_new); /* access functions: * return current values of the parameters */ unsigned int getDepth(void) const; unsigned int getN(void) const; unsigned int getNN(void) const; Rect* GetRect(void) const; int* get_pp(void) const; double** get_XX(void) const; double** get_X(void) const; double* get_Z(void) const; Base* GetBase(void) const; Base_Prior* GetBasePrior(void) const; /* global computation functions */ void Update(void); void Compute(void); void ForceLinear(void); void ForceNonlinear(void); bool Linarea(unsigned int *sum_b, double *area) const; void NewInvTemp(double itemp); /* access function: info about nodes */ bool isLeaf(void) const; bool isRoot(void) const; char* State(unsigned int which); bool Draw(void* state); void Clear(void); /* create an arraw of typed tree nodes, * passing back the length of the array */ Tree** swapableList(unsigned int* len); Tree** leavesList(unsigned int* len); Tree** prunableList(unsigned int* len); Tree** internalsList(unsigned int* len); Tree** buildTreeList(unsigned int len); unsigned int numPrunable(void); bool isPrunable(void) const; unsigned int numLeaves(void); Tree* Parent(void) const; /* size checks */ double Area(void) const; bool wellSized(void) const; unsigned int Height(void) const; bool Singular(void) const; /* printing */ void PrintTree(FILE* outfile, double** rect, double scale, int root) const; void Outfile(FILE *file, int verb); /* seperating prediction from estimation */ unsigned int add_XX(double **X_pred, unsigned int n_pred, unsigned int d_new); void new_XZ(double **X_new, double *Z_new, unsigned int n_new, unsigned int d_new); unsigned int* dopt_from_XX(unsigned int N, unsigned int iter, void *state); /* computing the full posterior or likelihood of the tree */ double Prior(double itemp); double FullPosterior(double itemp, bool tprior); double MarginalPosterior(double itemp); double Likelihood(double itemp); /* gathering traces of parameters */ void Trace(unsigned int index, FILE* XXTRACEFILE); char** TraceNames(unsigned int *len, bool full); void Distance(double **XX, int *p, const unsigned int plen, double **d1, double *h, double **d2, double *ad); }; #endif tgp/src/exp.h0000644000176200001440000001032713531032535012603 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __EXP_H__ #define __EXP_H__ #include "corr.h" #include class Exp_Prior; /* * CLASS for the implementation of the exponential * power family of correlation functions */ class Exp : public Corr { private: double d; /* kernel correlation width parameter */ double **xDISTx; /* n x n, matrix of euclidean distances to the x spatial locations */ unsigned int nd; /* for keeping track of the current size of xDISTx (nd x nd) */ unsigned int dreject; /* d rejection counter */ public: Exp(unsigned int dim, Base_Prior *base_prior); virtual Corr& operator=(const Corr &c); virtual ~Exp(void); virtual void Update(unsigned int n1, unsigned int n2, double **K, double **X, double **XX); virtual void Update(unsigned int n1, double **X); virtual void Update(unsigned int n1, double **K, double **X); virtual int Draw(unsigned int n, double **F, double **X, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); virtual void Combine(Corr *c1, Corr *c2, void *state); virtual void Split(Corr *c1, Corr *c2, void *state); virtual char* State(unsigned int which); virtual double log_Prior(void); virtual unsigned int sum_b(void); virtual void ToggleLinear(void); virtual bool DrawNugs(unsigned int n, double **X, double **F, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); virtual double* Trace(unsigned int* len); virtual char** TraceNames(unsigned int* len); virtual void Init(double *dexp); virtual double* Jitter(unsigned int n1, double **X); virtual double* CorrDiag(unsigned int n1, double **X); virtual void Invert(unsigned int n); void get_delta_d(Exp* c1, Exp* c2, void *state); void propose_new_d(Exp* c1, Exp* c2, void *state); double D(void); }; /* * CLASS for the prior parameterization of exponential * power family of correlation functions */ class Exp_Prior : public Corr_Prior { private: double d; double d_alpha[2]; /* d gamma-mixture prior alphas */ double d_beta[2]; /* d gamma-mixture prior beta */ bool fix_d; /* estimate d-mixture parameters or not */ double d_alpha_lambda[2]; /* d prior alpha lambda parameter */ double d_beta_lambda[2]; /* d prior beta lambda parameter */ public: Exp_Prior(unsigned int dim); Exp_Prior(Corr_Prior *c); virtual ~Exp_Prior(void); virtual void read_double(double *dprior); virtual void read_ctrlfile(std::ifstream* ctrlfile); virtual void Draw(Corr **corr, unsigned int howmany, void *state); virtual Corr_Prior* Dup(void); virtual Corr* newCorr(void); virtual void Print(FILE *outfile); virtual Base_Prior* BasePrior(void); virtual void SetBasePrior(Base_Prior *base_prior); virtual double log_HierPrior(void); virtual double* Trace(unsigned int* len); virtual char** TraceNames(unsigned int* len); virtual void Init(double *dhier); double D(void); double* DAlpha(void); double* DBeta(void); void default_d_priors(void); void default_d_lambdas(void); double log_Prior(double d, bool linear); bool LinearRand(double d, void *state); }; #endif tgp/src/init.c0000644000176200001440000000247413726653664012773 0ustar liggesusers#include // for NULL #include /* .C calls */ extern void tgp(int*, double *, int *, int *, double *, double *, int *, double *, int *, int *, int *, int *, int *, int *, int *, double *, double *, int *, double *, double *, int *, int *, double *, double *, int *, int *, int *, int *, int *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, double *, int *, double *, double *, double *, double *, double *, double *, double *); extern void lh_sample(int *, int *, int *, double *, double *, double *, double *); extern void tgp_cleanup(void); extern void dopt_gp(int *, unsigned int *, double *, unsigned int *, unsigned int *, double *, unsigned int *, unsigned int *, unsigned int *, int *); static const R_CMethodDef CEntries[] = { {"tgp", (DL_FUNC) &tgp, 58}, {"lh_sample", (DL_FUNC) &lh_sample, 7}, {"tgp_cleanup", (DL_FUNC) &tgp_cleanup, 0}, {"dopt_gp", (DL_FUNC) &dopt_gp, 10}, {NULL, NULL, 0} }; void R_init_tgp(DllInfo *dll) { R_registerRoutines(dll, CEntries, NULL, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } tgp/src/twovar.cc0000644000176200001440000005262613726652677013524 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2016, The University of Chicago * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@chicagobooth.edu) * ********************************************************************************/ extern "C" { #include "matrix.h" #include "lh.h" #include "rand_draws.h" #include "rand_pdf.h" #include "all_draws.h" #include "gen_covar.h" #include "rhelp.h" } #include "corr.h" #include "params.h" #include "model.h" #include "twovar.h" #include #include #include #include #include #include using namespace std; #define BUFFMAX 256 #define PWR 2.0 /* * Twovar: * * constructor function */ Twovar::Twovar(unsigned int dim, Base_Prior *base_prior) : Corr(dim, base_prior) { assert(base_prior->BaseModel() == GP); prior = ((Gp_Prior*) base_prior)->CorrPrior(); assert(prior); nug = prior->Nug(); /* check if we should really be starting in the LLM */ if(!prior->Linear() && !prior->LLM()) linear = false; assert( ((Gp_Prior*) base_prior)->CorrPrior()->CorrModel() == EXP); d = ((Twovar_Prior*) prior)->D(); xDISTx = NULL; nd = 0; dreject = 0; } /* * Twovar (assignment operator): * * used to assign the parameters of one correlation * function to anothers. Both correlation functions * must already have been allocated. */ Corr& Twovar::operator=(const Corr &c) { Twovar *e = (Twovar*) &c; log_det_K = e->log_det_K; linear = e->linear; d = e->d; nug = e->nug; dreject = e->dreject; assert(prior->CorrModel() == EXP); assert(prior == ((Gp_Prior*) base_prior)->CorrPrior()); /* copy the covariance matrices -- no longer performed due to the economy argument in Gp/Base */ // Cov(e); return *this; } /* * ~Twovar: * * destructor */ Twovar::~Twovar(void) { if(xDISTx) delete_matrix(xDISTx); xDISTx = NULL; } /* * Init: * * initialise this corr function with the parameters provided * from R via the vector of doubles */ void Twovar::Init(double *dexp) { d = dexp[1]; NugInit(dexp[0], ! (bool) dexp[2]); } /* * Jitter: * * fill jitter[ ] with the variance inflation factor. That is, * the variance for an observation with covariates in the i'th * row of X will be s2*(1.0 + jitter[i]). In standard tgp, the * jitter is simply the nugget. But for calibration and mr tgp, * the jitter value depends upon X (eg real or simulated data). * */ double* Twovar::Jitter(unsigned int n1, double **X) { double *jitter = new_vector(n1); // for(unsigned int i=0; in); /* randomly reject 1/2 the time, to avoid having to do lots of matrix inversions -- as the nug mixes better than d already */ if(runi(state) > 0.5) return false; /* make the draw */ double nug_new = /* MODIFIED */ nug_draw_twovar(n, col, nug, F, Z, K, log_det_K, *lambda, Vb, K_new, Ki_new, Kchol_new, &log_det_K_new, &lambda_new, Vb_new, bmu_new, gp_prior->get_b0(), gp_prior->get_Ti(), gp_prior->get_T(), tau2, prior->NugAlpha(), prior->NugBeta(), gp_prior->s2Alpha(), gp_prior->s2Beta(), (int) linear, itemp, state); /* did we accept the draw? */ if(nug_new != nug) { nug = nug_new; success = true; swap_new(Vb, bmu, lambda); } return success; } /* * Update: (symmetric) * * compute correlation matrix K */ void Twovar::Update(unsigned int n, double **X) { if(linear) return; assert(this->n == n); /* if(!xDISTx || nd != n) { if(xDISTx) delete_matrix(xDISTx); xDISTx = new_matrix(n, n); nd = n; } dist_symm(xDISTx, dim, X, n, PWR); dist_to_K_symm(K, xDISTx, d, nug, n); */ id(K, n); for(unsigned int i=n/2; in); // inverse_chol(K, Ki, Kchol, n); id(Ki, n); for(unsigned i=n/2; i 0); // log_det_K = n * log(1.0 + nug); log_det_K = (n/2) * log(1.0) + (n/2) * log(1.0 + nug); } } /* * Draw: * * draw parameters for a new correlation matrix; * returns true if the correlation matrix (passed in) * has changed; otherwise returns false */ int Twovar::Draw(unsigned int n, double **F, double **X, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state) { int success = 0; /* double q_fwd , q_bak, d_new; */ #ifdef MODIFIED bool lin_new; /* sometimes skip this Draw for linear models for speed, and only draw the nugget */ if(linear && runi(state) > 0.5) return DrawNugs(n, X, F, Z, lambda, bmu, Vb, tau2, itemp, state); /* proppose linear or not */ if(prior->Linear()) lin_new = true; else { q_fwd = q_bak = 1.0; d_proposal(1, NULL, &d_new, &d, &q_fwd, &q_bak, state); if(prior->LLM()) lin_new = linear_rand(&d_new, 1, prior->GamLin(), state); else lin_new = false; } /* if not linear then compute new distances */ /* allocate K_new, Ki_new, Kchol_new */ if(! lin_new) { if(!xDISTx || nd != n) { if(xDISTx) delete_matrix(xDISTx); xDISTx = new_matrix(n, n); nd = n; } dist_symm(xDISTx, dim, X, n, PWR); allocate_new(n); assert(n == this->n); } /* d; rebuilding K, Ki, and marginal params, if necessary */ if(prior->Linear()) { d_new = d; success = 1; } else { Twovar_Prior* ep = (Twovar_Prior*) prior; Gp_Prior *gp_prior = (Gp_Prior*) base_prior; success = d_draw_margin(n, col, d_new, d, F, Z, xDISTx, log_det_K, *lambda, Vb, K_new, Ki_new, Kchol_new, &log_det_K_new, &lambda_new, Vb_new, bmu_new, gp_prior->get_b0(), gp_prior->get_Ti(), gp_prior->get_T(), tau2, nug, q_bak/q_fwd, ep->DAlpha(), ep->DBeta(), gp_prior->s2Alpha(), gp_prior->s2Beta(), (int) lin_new, itemp, state); } /* did we accept the new draw? */ if(success == 1) { d = d_new; linear = (bool) lin_new; swap_new(Vb, bmu, lambda); dreject = 0; } else if(success == -1) return success; else if(success == 0) dreject++; /* abort if we have had too many rejections */ if(dreject >= REJECTMAX) return -2; #endif /* draw nugget */ bool changed = DrawNugs(n, X, F, Z, lambda, bmu, Vb, tau2, itemp, state); success = success || changed; return success; } /* * Combine: * * used in tree-prune steps, chooses one of two * sets of parameters to correlation functions, * and choose one for "this" correlation function */ void Twovar::Combine(Corr *c1, Corr *c2, void *state) { get_delta_d((Twovar*)c1, (Twovar*)c2, state); CombineNug(c1, c2, state); } /* * Split: * * used in tree-grow steps, splits the parameters * of "this" correlation function into a parameterization * for two (new) correlation functions */ void Twovar::Split(Corr *c1, Corr *c2, void *state) { propose_new_d((Twovar*) c1, (Twovar*) c2, state); SplitNug(c1, c2, state); } /* * get_delta_d: * * compute d from two ds (used in prune) */ void Twovar::get_delta_d(Twovar* c1, Twovar* c2, void *state) { double dch[2]; int ii[2]; dch[0] = c1->d; dch[1] = c2->d; propose_indices(ii, 0.5, state); d = dch[ii[0]]; linear = linear_rand(&d, 1, prior->GamLin(), state); } /* * propose_new_d: * * propose new D parameters for possible * new children partitions. */ void Twovar::propose_new_d(Twovar* c1, Twovar* c2, void *state) { int i[2]; double dnew[2]; Twovar_Prior *ep = (Twovar_Prior*) prior; propose_indices(i, 0.5, state); dnew[i[0]] = d; if(prior->Linear()) dnew[i[1]] = d; else dnew[i[1]] = d_prior_rand(ep->DAlpha(), ep->DBeta(), state); c1->d = dnew[0]; c2->d = dnew[1]; c1->linear = (bool) linear_rand(&(dnew[0]), 1, prior->GamLin(), state); c2->linear = (bool) linear_rand(&(dnew[1]), 1, prior->GamLin(), state); } /* * State: * * return a string depecting the state * of the (parameters of) correlation function */ char* Twovar::State(unsigned int which) { char buffer[BUFFMAX]; #ifdef PRINTNUG string s = "(d="; #else string s = ""; if(which == 0) s.append("d="); #endif if(linear) sprintf(buffer, "0(%g)", d); else sprintf(buffer, "%g", d); s.append(buffer); #ifdef PRINTNUG sprintf(buffer, ", g=%g)", nug); s.append(buffer); #endif char* ret_str = (char*) malloc(sizeof(char) * (s.length()+1)); strncpy(ret_str, s.c_str(), s.length()); ret_str[s.length()] = '\0'; return ret_str; } /* * sum_b: * * return 1 if linear, 0 otherwise */ unsigned int Twovar::sum_b(void) { if(linear) return 1; else return 0; } /* * ToggleLinear: * * make linear if not linear, otherwise * make not linear */ void Twovar::ToggleLinear(void) { if(linear) { linear = false; } else { linear = true; } } /* * D: * * return the range parameter */ double Twovar::D(void) { return d; } /* * log_Prior: * * compute the (log) prior for the parameters to * the correlation function (e.g. d and nug) */ double Twovar::log_Prior(void) { /* double prob = ((Corr*)this)->log_NugPrior(); MODIFIED */ double prob = ((Twovar_Prior*) prior)->log_NugPrior(nug); prob += ((Twovar_Prior*) prior)->log_Prior(d, linear); return prob; } /* * TraceNames: * * return the names of the parameters recorded in Twovar::Trace() */ char** Twovar::TraceNames(unsigned int* len) { *len = 4; char **trace = (char**) malloc(sizeof(char*) * (*len)); trace[0] = strdup("nug"); trace[1] = strdup("d"); trace[2] = strdup("b"); /* determinant of K */ trace[3] = strdup("ldetK"); return trace; } /* * Trace: * * return the current values of the parameters * to this correlation function: nug, d, then linear */ double* Twovar::Trace(unsigned int* len) { *len = 4; double *trace = new_vector(*len); trace[0] = nug; trace[1] = d; trace[2] = (double) !linear; /* determinant of K */ trace[3] = log_det_K; return trace; } /* * newCorr: * * construct and return a new isotropic exponential correlation * function with this module governing its prior parameterization */ Corr* Twovar_Prior::newCorr(void) { return new Twovar(dim, base_prior); } /* * Twovar_Prior: * * constructor for the prior distribution for * the exponential correlation function */ Twovar_Prior::Twovar_Prior(unsigned int dim) : Corr_Prior(dim) { corr_model = EXP; /* defaults */ d = 0.5; default_d_priors(); default_d_lambdas(); } /* * Init: * * read hiererchial prior parameters from a double-vector * */ void Twovar_Prior::Init(double *dhier) { d_alpha[0] = dhier[0]; d_beta[0] = dhier[1]; d_alpha[1] = dhier[2]; d_beta[1] = dhier[3]; NugInit(&(dhier[4])); } /* * Dup: * * duplicate this prior for the isotropic exponential * power family */ Corr_Prior* Twovar_Prior::Dup(void) { return new Twovar_Prior(this); } /* * Twovar_Prior (new duplicate) * * duplicating constructor for the prior distribution for * the exponential correlation function */ Twovar_Prior::Twovar_Prior(Corr_Prior *c) : Corr_Prior(c) { Twovar_Prior *e = (Twovar_Prior*) c; assert(e->corr_model == EXP); corr_model = e->corr_model; dupv(gamlin, e->gamlin, 3); d = e->d; fix_d = e->fix_d; dupv(d_alpha, e->d_alpha, 2); dupv(d_beta, e->d_beta, 2); dupv(d_alpha_lambda, e->d_alpha_lambda, 2); dupv(d_beta_lambda, e->d_beta_lambda, 2); } /* * ~Twovar_Prior: * * destructor the the prior distribution for * the exponential correlation function */ Twovar_Prior::~Twovar_Prior(void) { } /* * read_double: * * read prior parameterization from a vector of doubles * passed in from R */ void Twovar_Prior::read_double(double *dparams) { /* read the parameters that have to do with the * nugget first */ read_double_nug(dparams); /* starting value for the range parameter */ d = dparams[1]; //MYprintf(MYstdout, "starting d=%g\n", d); /* reset dparams to start after the nugget gamlin params */ dparams += 13; /* initial parameter settings for alpha and beta */ get_mix_prior_params_double(d_alpha, d_beta, &(dparams[0]), "d"); dparams += 4; /* reset */ /* d hierarchical lambda prior parameters */ if((int) dparams[0] == -1) { fix_d = true; /*MYprintf(MYstdout, "fixing d prior\n");*/ } else { fix_d = false; get_mix_prior_params_double(d_alpha_lambda, d_beta_lambda, &(dparams[0]), "d lambda"); } dparams += 4; /* reset */ } /* * read_ctrlfile: * * read prior parameterization from a control file */ void Twovar_Prior::read_ctrlfile(ifstream *ctrlfile) { char line[BUFFMAX], line_copy[BUFFMAX]; /* read the parameters that have to do with the * nugget first */ read_ctrlfile_nug(ctrlfile); /* read the d parameter from the control file */ ctrlfile->getline(line, BUFFMAX); d = atof(strtok(line, " \t\n#")); MYprintf(MYstdout, "starting d=%g\n", d); /* read d and nug-hierarchical parameters (mix of gammas) */ ctrlfile->getline(line, BUFFMAX); get_mix_prior_params(d_alpha, d_beta, line, "d"); /* d hierarchical lambda prior parameters */ ctrlfile->getline(line, BUFFMAX); strcpy(line_copy, line); if(!strcmp("fixed", strtok(line_copy, " \t\n#"))) { fix_d = true; MYprintf(MYstdout, "fixing d prior\n"); } else { fix_d = false; get_mix_prior_params(d_alpha_lambda, d_beta_lambda, line, "d lambda"); } } /* * default_d_priors: * * set d prior parameters * to default values */ void Twovar_Prior::default_d_priors(void) { d_alpha[0] = 1.0; d_beta[0] = 20.0; d_alpha[1] = 10.0; d_beta[1] = 10.0; } /* * default_d_lambdas: * * set d (lambda) hierarchical prior parameters * to default values */ void Twovar_Prior::default_d_lambdas(void) { d_alpha_lambda[0] = 1.0; d_beta_lambda[0] = 10.0; d_alpha_lambda[1] = 1.0; d_beta_lambda[1] = 10.0; fix_d = false; //fix_d = true; } /* * D: * * return the default range parameter setting * for the exponential correllation function */ double Twovar_Prior::D(void) { return d; } /* * DAlpha: * * return the alpha prior parameter setting to the gamma * distribution prior for the range parameter */ double* Twovar_Prior::DAlpha(void) { return d_alpha; } /* * DBeta: * * return the beta prior parameter setting to the gamma * distribution prior for the range parameter */ double* Twovar_Prior::DBeta(void) { return d_beta; } /* * Draw: * * draws for the hierarchical priors for the Twovar * correlation function which are * contained in the params module */ void Twovar_Prior::Draw(Corr **corr, unsigned int howmany, void *state) { if(!fix_d) { double *d = new_vector(howmany); for(unsigned int i=0; iD(); mixture_priors_draw(d_alpha, d_beta, d, howmany, d_alpha_lambda, d_beta_lambda, state); free(d); } /* hierarchical prior draws for the nugget */ DrawNugHier(corr, howmany, state); } /* * log_Prior: * * compute the (log) prior for the parameters to * the correlation function (e.g. d and nug) : does * not include priors of hierarchical params. See * log_HierPrior, below */ double Twovar_Prior::log_Prior(double d, bool linear) { double prob = 0; /* force linear model */ if(gamlin[0] < 0) return prob; /* force gp model */ prob += log_d_prior_pdf(d, d_alpha, d_beta); if(gamlin[0] <= 0) return prob; /* using 1.0, because of 1.0 - lin_pdf, and will adjust later */ double lin_pdf = linear_pdf(&d, 1, gamlin); if(linear) prob += log(lin_pdf); else prob += log(1.0-lin_pdf); /* return the log pdf */ return prob; } /* * log_Prior: * * compute the (log) prior for the parameters to * the correlation function (nug) : does * not include priors of hierarchical params. See * log_HierPrior, below */ double Twovar_Prior::log_NugPrior(double nug) { return ((Corr_Prior*)this)->log_NugPrior(nug + 1.0 + NUGMIN); } /* * BasePrior: * * return the prior for the Base (eg Gp) model */ Base_Prior* Twovar_Prior::BasePrior(void) { return base_prior; } /* * SetBasePrior: * * set the base_prior field */ void Twovar_Prior::SetBasePrior(Base_Prior *base_prior) { this->base_prior = base_prior; } /* * Print: * * pretty print the correllation function parameters out * to a file */ void Twovar_Prior::Print(FILE *outfile) { MYprintf(MYstdout, "corr prior: isotropic power\n"); /* print nugget stuff first */ PrintNug(outfile); /* range parameter */ // MYprintf(outfile, "starting d=%g\n", d); /* range gamma prior */ MYprintf(outfile, "d[a,b][0,1]=[%g,%g],[%g,%g]\n", d_alpha[0], d_beta[0], d_alpha[1], d_beta[1]); /* range gamma hyperprior */ if(fix_d) MYprintf(outfile, "d prior fixed\n"); else { MYprintf(MYstdout, "d lambda[a,b][0,1]=[%g,%g],[%g,%g]\n", d_alpha_lambda[0], d_beta_lambda[0], d_alpha_lambda[1], d_beta_lambda[1]); } } /* * log_HierPrior: * * return the log prior of the hierarchial parameters * to the correllation parameters (i.e., range and nugget) */ double Twovar_Prior::log_HierPrior(void) { double lpdf; lpdf = 0.0; /* mixture prior for the range parameter, d */ if(!fix_d) { lpdf += mixture_hier_prior_log(d_alpha, d_beta, d_alpha_lambda, d_beta_lambda); } /* mixture prior for the nugget */ lpdf += log_NugHierPrior(); return lpdf; } /* * Trace: * * return the current values of the hierarchical * parameters to this correlation function: * nug(alpha,beta), d(alpha,beta), then linear */ double* Twovar_Prior::Trace(unsigned int* len) { /* first get the hierarchical nug parameters */ unsigned int clen; double *c = NugTrace(&clen); /* calculate and allocate the new trace, which will include the nug trace */ *len = 4; double* trace = new_vector(clen + *len); trace[0] = d_alpha[0]; trace[1] = d_beta[0]; trace[2] = d_alpha[1]; trace[3] = d_beta[1]; /* then copy in the nug trace */ dupv(&(trace[*len]), c, clen); /* new combined length, and free c */ *len += clen; if(c) free(c); else assert(clen == 0); return trace; } /* * TraceNames: * * return the names of the traces recorded in Twovar_Prior::Trace() */ char** Twovar_Prior::TraceNames(unsigned int* len) { /* first get the hierarchical nug parameters */ unsigned int clen; char **c = NugTraceNames(&clen); /* calculate and allocate the new trace, which will include the nug trace */ *len = 4; char** trace = (char**) malloc(sizeof(char*) * (clen + *len)); trace[0] = strdup("d.a0"); trace[1] = strdup("d.g0"); trace[2] = strdup("d.a1"); trace[3] = strdup("d.g1"); /* then copy in the nug trace */ for(unsigned int i=0; i #include #include #include #include #include using namespace std; #define BUFFMAX 256 #define PWR 2.0 /* * ExpSep: * * constructor function */ ExpSep::ExpSep(unsigned int dim, Base_Prior *base_prior) : Corr(dim, base_prior) { /* Sanity Checks */ assert(base_prior->BaseModel() == GP); assert( ((Gp_Prior*) base_prior)->CorrPrior()->CorrModel() == EXPSEP); /* set pointer to correllation prior from the base prior */ prior = ((Gp_Prior*) base_prior)->CorrPrior(); assert(prior); /* check if we should really be starting in the LLM */ if(!prior->Linear() && !prior->LLM()) linear = false; /* let the prior choose the starting nugget value */ nug = prior->Nug(); /* allocate and initialize (from prior) the range params */ d = new_dup_vector(((ExpSep_Prior*)prior)->D(), dim); /* start fully in the GP model, not LLM */ b = new_ones_ivector(dim, 1); pb = new_zero_vector(dim); /* memory allocated for effective range parameter -- deff = d*b */ d_eff = new_dup_vector(d, dim); /* counter of the number of d-rejections in a row */ dreject = 0; } /* * ExpSep (assignment operator): * * used to assign the parameters of one correlation * function to anothers. Both correlation functions * must already have been allocated */ Corr& ExpSep::operator=(const Corr &c) { ExpSep *e = (ExpSep*) &c; /* sanity check */ assert(prior == ((Gp_Prior*) base_prior)->CorrPrior()); /* copy everything */ log_det_K = e->log_det_K; linear = e->linear; dupv(d, e->d, dim); dupv(pb, e->pb, dim); dupv(d_eff, e->d_eff, dim); dupiv(b, e->b, dim); nug = e->nug; dreject = e->dreject; /* copy the covariance matrices -- no longer performed due to the new economy argument in Gp/Base */ // Cov(e); return *this; } /* * ~ExpSep: * * destructor */ ExpSep::~ExpSep(void) { free(d); free(b); free(pb); free(d_eff); } /* * Init: * * initialise this corr function with the parameters provided * from R via the vector of doubles */ void ExpSep::Init(double *dexpsep) { dupv(d, &(dexpsep[1]), dim); if(!prior->Linear() && prior->LLM()) linear_pdf_sep(pb, d, dim, prior->GamLin()); bool lin = true; for(unsigned int i=0; iLinear()) assert(lin); NugInit(dexpsep[0], lin); } /* * Jitter: * * fill jitter[ ] with the variance inflation factor. That is, * the variance for an observation with covariates in the i'th * row of X will be s2*(1.0 + jitter[i]). In standard tgp, the * jitter is simply the nugget. But for calibration and mr tgp, * the jitter value depends upon X (eg real or simulated data). * */ double* ExpSep::Jitter(unsigned int n1, double **X) { double *jitter = new_vector(n1); for(unsigned int i=0; in); /* with probability 0.5, skip drawing the nugget */ double ru = runi(state); if(ru > 0.5) return false; /* make the draw */ double nug_new = nug_draw_margin(n, col, nug, F, Z, K, log_det_K, *lambda, Vb, K_new, Ki_new, Kchol_new, &log_det_K_new, &lambda_new, Vb_new, bmu_new, gp_prior->get_b0(), gp_prior->get_Ti(), gp_prior->get_T(), tau2, prior->NugAlpha(), prior->NugBeta(), gp_prior->s2Alpha(), gp_prior->s2Beta(), (int) linear, itemp, state); /* did we accept the draw? */ if(nug_new != nug) { nug = nug_new; success = true; swap_new(Vb, bmu, lambda); } return success; } /* * Update: (symmetric) * * computes the internal correlation matrix K, * (INCLUDES NUGGET) */ void ExpSep::Update(unsigned int n, double **K, double **X) { exp_corr_sep_symm(K, dim, X, n, d_eff, nug, PWR); } /* * Update: (symmetric) * * takes in a (symmetric) distance matrix and * returns a correlation matrix (INCLUDES NUGGET) */ void ExpSep::Update(unsigned int n, double **X) { /* no need to update internal K if we're at LLM */ if(linear) return; /* sanity check */ assert(this->n == n); /* compute K */ exp_corr_sep_symm(K, dim, X, n, d_eff, nug, PWR); } /* * Update: (non-symmetric) * * takes in a distance matrix and returns a * correlation matrix (DOES NOT INCLUDE NUGGET) */ void ExpSep::Update(unsigned int n1, unsigned int n2, double **K, double **X, double **XX) { exp_corr_sep(K, dim, XX, n1, X, n2, d_eff, PWR); } /* * propose_new_d: * * propose new d and b values. Sometimes propose d's and b's for all * dimensions jointly, sometimes do just the d's with b==1, and * other times do only those with b==0. I have found that this improves * mixing */ bool ExpSep::propose_new_d(double* d_new, int * b_new, double *pb_new, double *q_fwd, double *q_bak, void *state) { *q_bak = *q_fwd = 1.0; /* copy old values into the new ones */ dupv(d_new, d, dim); dupv(pb_new, pb, dim); dupiv(b_new, b, dim); /* 1/3 of the time (or for 1-d data) -- just draw all the ds jointly */ if(dim==1 || runi(state) < 0.3333333333) { /* RW proposal for all d-values */ d_proposal(dim, NULL, d_new, d, q_fwd, q_bak, state); /* if we are allowing the LLM, then we need to draw the b_new conditional on d_new; otherwise just return */ if(prior->LLM()) { if(dim==1 || runi(state) < 0.5) /* sometimes skip drawing the bs (unless 1-d) */ return linear_rand_sep(b_new,pb_new,d_new,dim,prior->GamLin(), state); else return linear; } else return false; /* just draw the ds with bs == 1 or bs == 0, choosing one of those randomly */ } else { /* choose bs == 1 or bs == 0 */ FIND_OP find_op = NE; if(runi(state) < 0.5) find_op = EQ; /* find those ds which coincide with find_op */ unsigned int len = 0; int* zero = find(d_eff, dim, find_op, 0.0, &len); /* if there are no d's which coincide with find_op, then there is nothing to propose, so just return with the current LLM setting */ if(len == 0) { free(zero); return linear; } /* otherwise, draw length(zero) new d values, only at the indices of d_new indicated by zero */ d_proposal(len, zero, d_new, d, q_fwd, q_bak, state); /* done if forcing Gp model (not allowing the LLM) */ if(! prior->LLM()) { free(zero); return false; } /* otherwise, need to draw bs (booleans) conditional on the proposed d_new -- only do this 1/2 the time */ /* sometimes skip drawing the bs */ if(runi(state) < 0.5) { /* gather the ds, bs, and pbs into the "short" vectors, as indexed by the zero-vector */ double *d_short = new_vector(len); double *pb_short = new_zero_vector(len); int *b_short = new_ones_ivector(len, 0); /* make ones give zeros */ copy_sub_vector(d_short, zero, d_new, len); /* draw new bs conditional on the new ds */ linear_rand_sep(b_short,pb_short,d_short,len,prior->GamLin(), state); /* copy the new bs and pbs into the big "new" proposals */ copy_p_vector(pb_new, zero, pb_short, len); copy_p_ivector(b_new, zero, b_short, len); /* clean up */ free(d_short); free(pb_short); free(b_short); free(zero); /* only return true if we have actiually jumpted to the LLM; i.e., only when all the b_new's are 0 */ for(unsigned int i=0; i 0.5) return DrawNugs(n, X, F, Z, lambda, bmu, Vb, tau2, itemp, state); /* proposals happen when we're not forcing the LLM */ if(prior->Linear()) lin_new = true; else { /* allocate new d, b, and pb */ d_new = new_zero_vector(dim); b_new = new_ivector(dim); pb_new = new_vector(dim); /* make the RW proposal for d, and then b */ lin_new = propose_new_d(d_new, b_new, pb_new, &q_fwd, &q_bak, state); } /* calculate the effective model (d_eff = d*b), and allocate memory -- when we're not proposing the LLM */ double *d_new_eff = NULL; if(! lin_new) { /* calculate effective new d-vector, and determine if it is the same as the old one */ d_new_eff = new_zero_vector(dim); bool equal = true; for(unsigned int i=0; in); } } /* compute the acceptance ratio, unless we're forcing the LLM in which case we do nothing just return a successful "draw" */ if(prior->Linear()) success = 1; else { /* compute prior ratio and proposal ratio */ double pRatio_log = 0.0; double qRatio = q_bak/q_fwd; pRatio_log += ep->log_DPrior_pdf(d_new); pRatio_log -= ep->log_DPrior_pdf(d); /* MH acceptance ratio for the draw */ success = d_sep_draw_margin(d_new_eff, n, dim, col, F, X, Z, log_det_K,*lambda, Vb, K_new, Ki_new, Kchol_new, &log_det_K_new, &lambda_new, Vb_new, bmu_new, gp_prior->get_b0(), gp_prior->get_Ti(), gp_prior->get_T(), tau2, nug, qRatio, pRatio_log, gp_prior->s2Alpha(), gp_prior->s2Beta(), (int) lin_new, itemp, state); /* see if the draw was accepted; if so, we need to copy (or swap) the contents of the new into the old */ if(success == 1) { swap_vector(&d, &d_new); /* d_eff is zero if we're in the LLM */ if(!lin_new && d_new_eff) swap_vector(&d_eff, &d_new_eff); else if(lin_new) zerov(d_eff, dim); linear = (bool) lin_new; /* copy b and pb */ swap_ivector(&b, &b_new); swap_vector(&pb, &pb_new); /* only copy if linear or a new d_eff */ if(linear || d_new_eff) swap_new(Vb, bmu, lambda); } } /* if we're not forcing the LLM, then clean up */ if(! prior->Linear()) { free(d_new); free(pb_new); free(b_new); } /* if we didn't happen to jump to the LLM, then we have more cleaning up to do */ if(!lin_new && d_new_eff) free(d_new_eff); /* something went wrong, abort; otherwise keep track of the number of d-rejections in a row */ if(success == -1) return success; else if(success == 0) dreject++; else dreject = 0; /* abort if we have had too many rejections */ if(dreject >= REJECTMAX) return -2; /* draw nugget */ bool changed = DrawNugs(n, X, F, Z, lambda, bmu, Vb, tau2, itemp, state); success = success || changed; return success; } /* * Combine: * * used in tree-prune steps, chooses one of two * sets of parameters to correlation functions, * and choose one for "this" correlation function */ void ExpSep::Combine(Corr *c1, Corr *c2, void *state) { get_delta_d((ExpSep*)c1, (ExpSep*)c2, state); CombineNug(c1, c2, state); } /* * Split: * * used in tree-grow steps, splits the parameters * of "this" correlation function into a parameterization * for two (new) correlation functions */ void ExpSep::Split(Corr *c1, Corr *c2, void *state) { propose_new_d((ExpSep*) c1, (ExpSep*) c2, state); SplitNug(c1, c2, state); } /* * get_delta_d: * * compute d from two ds residing in c1 and c2 * and sample b conditional on the chosen d * * (used in prune) */ void ExpSep::get_delta_d(ExpSep* c1, ExpSep* c2, void *state) { /* create pointers to the two ds */ double **dch = (double**) malloc(sizeof(double*) * 2); dch[0] = c1->d; dch[1] = c2->d; /* randomly choose one of the d's */ int ii[2]; propose_indices(ii, 0.5, state); /* and copy the chosen one */ dupv(d, dch[ii[0]], dim); /* clean up */ free(dch); /* propose b conditional on the chosen d */ linear = linear_rand_sep(b, pb, d, dim, prior->GamLin(), state); /* compute d_eff = d * b for the chosen d and b */ for(unsigned int i=0; id for possible * new children partitions c1 and c2 * * (used in grow) */ void ExpSep::propose_new_d(ExpSep* c1, ExpSep* c2, void *state) { int i[2]; double **dnew = new_matrix(2, dim); /* randomply choose which of c1 and c2 will get a copy of this->d, and which will get a random d from the prior */ propose_indices(i, 0.5, state); /* from this->d */ dupv(dnew[i[0]], d, dim); /* from the prior */ draw_d_from_prior(dnew[i[1]], state); /* copy into c1 and c2 */ dupv(c1->d, dnew[0], dim); dupv(c2->d, dnew[1], dim); /* clean up */ delete_matrix(dnew); /* propose new b for c1 and c2, conditional on the two new d parameters */ c1->linear = (bool) linear_rand_sep(c1->b, c1->pb, c1->d, dim, prior->GamLin(), state); c2->linear = (bool) linear_rand_sep(c2->b, c2->pb, c2->d, dim, prior->GamLin(), state); /* compute d_eff = b*d for the two new b and d pairs */ for(unsigned int i=0; id_eff[i] = c1->d[i] * c1->b[i]; c2->d_eff[i] = c2->d[i] * c2->b[i]; } } /* * draw_d_from_prior: * * get draws of separable d parameter from * the prior distribution */ void ExpSep::draw_d_from_prior(double *d_new, void *state) { /* if forcing the linear, then there's nothing to draw; just copy d_new from this->d */ if(prior->Linear()) dupv(d_new, d, dim); /* otherwise draw from the prior */ else ((ExpSep_Prior*)prior)->DPrior_rand(d_new, state); } /* * State: * * return a string depecting the state * of the (parameters of) correlation function */ char* ExpSep::State(unsigned int which) { char buffer[BUFFMAX]; /* slightly different format if the nugget is going to get printed also */ #ifdef PRINTNUG string s = "(d"; sprintf(buffer, "%d=[", which); s.append(buffer); #else string s = ""; if(which == 0) s.append("d=["); else s.append("["); #endif /* if linear, then just put a zero and be done; otherwise, print the col d-values */ if(linear) sprintf(buffer, "0]"); else { for(unsigned int i=0; ilog_Prior(d, b, pb, linear); return prob; } /* * sum_b: * * return the count of the number of linearizing * booleans set to one (the number of linear dimensions) */ unsigned int ExpSep::sum_b(void) { unsigned int bs = 0; for(unsigned int i=0; in); inverse_chol(K, Ki, Kchol, n); log_det_K = log_determinant_chol(Kchol, n); } else { assert(n > 0); log_det_K = n * log(1.0 + nug); } } /* * ExpSep_Prior: * * constructor for the prior parameterization of the separable * exponential power distribution function */ ExpSep_Prior::ExpSep_Prior(unsigned int dim) : Corr_Prior(dim) { corr_model = EXPSEP; /* default starting values and initial parameterization */ d = ones(dim, 0.5); d_alpha = new_zero_matrix(dim, 2); d_beta = new_zero_matrix(dim, 2); default_d_priors(); /* set d_alpha and d_beta */ default_d_lambdas(); /* set d_alpha_lambda and d_beta_lambda */ } /* * Init: * * read hiererchial prior parameters from a double-vector * */ void ExpSep_Prior::Init(double *dhier) { for(unsigned int i=0; icorr_model == EXPSEP); /* copy all parameters of the prior */ corr_model = e->corr_model; dupv(gamlin, e->gamlin, 3); d = new_dup_vector(e->d, dim); fix_d = e->fix_d; d_alpha = new_dup_matrix(e->d_alpha, dim, 2); d_beta = new_dup_matrix(e->d_beta, dim, 2); dupv(d_alpha_lambda, e->d_alpha_lambda, 2); dupv(d_beta_lambda, e->d_beta_lambda, 2); } /* * ~ExpSep_Prior: * * destructor for the prior parameterization of the separable * exponential power distribution function */ ExpSep_Prior::~ExpSep_Prior(void) { free(d); delete_matrix(d_alpha); delete_matrix(d_beta); } /* * read_double: * * read the double parameter vector giving the user-secified * prior parameterization specified in R */ void ExpSep_Prior::read_double(double *dparams) { /* read the parameters that have to to with the nugget */ read_double_nug(dparams); /* read the starting value(s) for the range parameter(s) */ for(unsigned int i=0; igetline(line, BUFFMAX); d[0] = atof(strtok(line, " \t\n#")); for(unsigned int i=1; igetline(line, BUFFMAX); strcpy(line_copy, line); if(!strcmp("fixed", strtok(line_copy, " \t\n#"))) { fix_d = true; MYprintf(MYstdout, "fixing d prior\n"); } else { fix_d = false; get_mix_prior_params(d_alpha_lambda, d_beta_lambda, line, "d lambda"); } } /* * default_d_priors: * * set d prior parameters * to default values */ void ExpSep_Prior::default_d_priors(void) { for(unsigned int i=0; iparameters for the jth dimension from each of the "howmany" corr modules */ for(unsigned int i=0; iD())[j]; /* use those gathered d values to make a draw for the parameters for the prior of the jth d */ mixture_priors_draw(d_alpha[j], d_beta[j], d, howmany, d_alpha_lambda, d_beta_lambda, state); } /* clean up */ free(d); } /* hierarchical prior draws for the nugget */ DrawNugHier(corr, howmany, state); } /* * newCorr: * * construct and return a new separable exponential correlation * function with this module governing its prior parameterization */ Corr* ExpSep_Prior::newCorr(void) { return new ExpSep(dim, base_prior); } /* * log_Prior: * * compute the (log) prior for the parameters to * the correlation function (e.g. d and nug) */ double ExpSep_Prior::log_Prior(double *d, int *b, double *pb, bool linear) { double prob = 0; /* if forcing the LLM, just return zero (i.e. prior=1, log_prior=0) */ if(gamlin[0] < 0) return prob; /* sum the log priors for each of the d-parameters */ for(unsigned int i=0; ibase_prior = base_prior; } /* * Print: * * pretty print the correllation function parameters out * to a file */ void ExpSep_Prior::Print(FILE *outfile) { MYprintf(MYstdout, "corr prior: separable power\n"); /* print nugget stuff first */ PrintNug(outfile); /* range parameter */ /* MYprintf(outfile, "starting d=\n"); printVector(d, dim, outfile, HUMAN); */ /* range gamma prior, just print once */ MYprintf(outfile, "d[a,b][0,1]=[%g,%g],[%g,%g]\n", d_alpha[0][0], d_beta[0][0], d_alpha[0][1], d_beta[0][1]); /* print many times, one for each dimension instead? */ /* for(unsigned int i=1; i #include "gp.h" #include "base.h" //#define BUFFMAX 256 class Params { private: unsigned int d; /* dimenstion of the data */ unsigned int col; /* dimenstion of the design matrix */ double t_alpha; /* tree prior parameter alpha */ double t_beta; /* tree prior parameter beta */ unsigned int t_minpart; /* tree prior parameter minpart, smallest partition */ unsigned int t_splitmin; /* data col to start partitioning */ unsigned int t_basemax; /* data col to stop using the Base (then only use tree) */ Base_Prior *prior; public: /* start public functions */ Params(unsigned int d); Params(Params* params); ~Params(void); void read_ctrlfile(std::ifstream* ctrlfile); void read_double(double *dparams); void get_T_params(double *alpha, double *beta, unsigned int* minpart, unsigned int* splitmin, unsigned int *basemax); bool isTree(void); unsigned int T_minp(void); unsigned int T_smin(void); unsigned int T_bmax(void); Base_Prior* BasePrior(void); void Print(FILE *outfile); }; void get_mix_prior_params(double *alpha, double *beta, char *line, const char* which); void get_mix_prior_params_double(double *alpha, double *beta, double *alpha_beta, const char* which); #endif tgp/src/temper.h0000644000176200001440000000700413531032535013301 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __TEMPER_H__ #define __TEMPER_H__ typedef enum IT_LAMBDA {OPT=1101, NAIVE=1102, ST=1103} IT_LAMBDA; /* * structure for keeping track of annealed importance * sampling temperature (elements of the temperature ladder) */ class Temper { private: /* for stochastic approximation -- should prolly be ints */ double c0; double n0; int cnt; /* iteration number */ bool doSA; /* for turning SA on and off */ /* temperature ladder and pseudo-prior */ unsigned int numit; double *itemps; double *tprobs; IT_LAMBDA it_lambda; /* method of combining IS estimators */ /* occupation counts -- # of times each itemp is visited */ unsigned int *tcounts; unsigned int *cum_tcounts; /* keeping track of the current temperature and a proposed temperature */ int k; int knew; public: /* construction and duplication*/ Temper(double *ditemps, double *tprobs, unsigned int n, double c0, double n0, IT_LAMBDA lambda); Temper(double *ditemps); Temper(Temper *itemp); Temper& operator=(const Temper &temp); /* destruction */ ~Temper(void); /* accessors */ double Itemp(void); double Prob(void); double ProposedProb(void); unsigned int Numit(void); double C0(); double N0(); bool DoStochApprox(void); bool IT_ST_or_IS(void); bool IT_or_ST(void); bool IS(void); double* Itemps(void); /* random-walk proposition */ double Propose(double *q_fwd, double *q_bak, void* state); void Keep(double itemp_new, bool burnin); void Reject(double itemp_new, bool burnin); /* setting the pseudo-prior */ double* UpdatePrior(void); void UpdatePrior(double *tprobs, unsigned int n); void CopyPrior(double *dparams); void StochApprox(void); void ResetSA(void); void StopSA(void); void Normalize(void); /* combination heuristics */ double LambdaIT(double *w, double *itemp, unsigned int R, double *essd, unsigned int verb); double LambdaOpt(double *w, double *itemp, unsigned int n, double *essd, unsigned int verb); double LambdaST(double *w, double *itemp, unsigned int n, unsigned int verb); double LambdaNaive(double *w, unsigned int n, unsigned int verb); void EachESS(double *w, double *itemp, unsigned int n, double *essd); /* printing */ void Print(FILE *outfile); void AppendLadder(const char* file_str); }; /* calculating effective sample size */ double calc_ess(double *w, unsigned int n); double calc_cv2(double *w, unsigned int n); #endif tgp/src/params.cc0000644000176200001440000001647713531032535013444 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ extern "C" { #include "matrix.h" #include "rhelp.h" } #include "params.h" #include "gp.h" #include #include #include using namespace std; #include /* * Params: * * the usual constructor function */ Params::Params(unsigned int dim) { d = dim; /* * the rest of the parameters will be read in * from the control file (Params::read_ctrlfile), or * from a double vector passed from R (Params::read_double) */ col = dim+1; t_alpha = 0.95; /* alpha: tree priors */ t_beta = 2; /* beta: tree priors */ t_minpart = 5; /* minpart: tree priors, smallest partition */ t_splitmin = 0; /* data column where we start partitioning */ t_basemax = dim; /* last data column before we stop using the base model */ prior = NULL; } /* * Params: * * duplication constructor function */ Params::Params(Params *params) { /* generic and tree parameters */ d = params->d; col = params->col; /* copy the tree parameters */ t_alpha = params->t_alpha; t_beta = params->t_beta; t_minpart = params->t_minpart; t_splitmin = params->t_splitmin; t_basemax = params->t_basemax; /* copy the Gp prior */ assert(params->prior); prior = new Gp_Prior(params->prior); ((Gp_Prior*)prior)->CorrPrior()->SetBasePrior(prior); } /* * ~Params: * * the usual destructor, nothing fancy */ Params::~Params(void) { delete prior; } /* * read_double: * * takes params from a double array, * for use with communication with R */ void Params::read_double(double *dparams) { /* read tree prior values alpha, beta and minpart */ // printVector(dparams, 5, MYstdout, HUMAN); t_alpha = dparams[0]; t_beta = dparams[1]; t_minpart = (unsigned int) dparams[2]; /* read tree prior values splitmin and basemax */ t_splitmin = ((unsigned int) dparams[3]) - 1; assert(t_splitmin >= 0 && t_splitmin < d); t_basemax = ((unsigned int) dparams[4]); assert(t_basemax > 0 && t_basemax <= d); /* read the mean function form */ int mf = (int) dparams[5]; MEAN_FN mean_fn = LINEAR; switch (mf) { case 0: mean_fn=LINEAR; /* MYprintf(MYstdout, "linear mean\n"); */ break; case 1: mean_fn=CONSTANT;/* MYprintf(MYstdout, "constant mean\n");*/ break; default: error("bad mean function %d", (int)dparams[5]); break; } prior = new Gp_Prior(/*d*/ t_basemax, mean_fn); /* read the rest of the parameters into the corr prior module */ prior->read_double(&(dparams[6])); } /* * read_ctrlfile: * * read all of the parameters from the control file */ void Params::read_ctrlfile(ifstream* ctrlfile) { char line[BUFFMAX]; /* read the tree-parameters (alpha, beta and minpart) from the control file */ ctrlfile->getline(line, BUFFMAX); t_alpha = atof(strtok(line, " \t\n#")); t_beta = atof(strtok(NULL, " \t\n#")); t_minpart = atoi(strtok(NULL, " \t\n#")); assert(t_minpart > 1); /* read in splitmin and basemax */ t_splitmin = atoi(strtok(NULL, " \t\n#")) - 1; assert(t_splitmin >= 0 && t_splitmin < d); t_basemax = atoi(strtok(NULL, " \t\n#")); assert(t_basemax > 0 && t_basemax <= d); /* read the mean function form */ /* LINEAR, CONSTANT, or TWOLEVEL */ MEAN_FN mean_fn = LINEAR; ctrlfile->getline(line, BUFFMAX); if(!strncmp(line, "linear", 6)) { mean_fn = LINEAR; MYprintf(MYstdout, "mean function: linear\n"); } else if(!strncmp(line, "constant", 8)) { mean_fn = CONSTANT; MYprintf(MYstdout, "mean function: constant\n"); } else { error("%s is not a valid mean function", strtok(line, "\t\n#")); } /* This will be needed for MrTgp */ prior = new Gp_Prior(/*d*/ t_basemax, mean_fn); /* prints the tree prior parameter settings */ Print(MYstdout); /* read the rest of the parameters into the corr prior module */ prior->read_ctrlfile(ctrlfile); } /* * get_T_params: * * pass back the tree prior parameters * t_alpha nad t_beta */ void Params::get_T_params(double *alpha, double *beta, unsigned int *minpart, unsigned int *splitmin, unsigned int *basemax) { *alpha = t_alpha; *beta = t_beta; *minpart = t_minpart; *splitmin = t_splitmin; *basemax = t_basemax; } /* * isTree: * * return true if the tree-prior allows tree growth, * and false otherwise */ bool Params::isTree(void) { if(t_alpha > 0 && t_beta > 0) return true; else return false; } /* * T_minp: * * return minimim partition data number */ unsigned int Params::T_minp(void) { return t_minpart; } /* * T_smin: * * return minimim partition column number */ unsigned int Params::T_smin(void) { return t_splitmin; } /* * T_bmax: * * return maximum Base model column number */ unsigned int Params::T_bmax(void) { return t_basemax; } /* * get_mix_prior_params: * * reading the mixture hierarchical priors from a string */ void get_mix_prior_params(double *alpha, double *beta, char *line, const char* which) { alpha[0] = atof(strtok(line, " \t\n#")); assert(alpha[0] > 0); beta[0] = atof(strtok(NULL, " \t\n#")); assert(beta[0] > 0); alpha[1] = atof(strtok(NULL, " \t\n#")); assert(alpha[1] > 0); beta[1] = atof(strtok(NULL, " \t\n#")); assert(beta[1] > 0); /* MYprintf(MYstdout, "%s[a,b][0,1]=[%g,%g],[%g,%g]\n", which, alpha[0], beta[0], alpha[1], beta[1]); */ } /* * get_mix_prior_params_double: * * reading the mixture hierarchical priors from a string * zero-values in alpha[0] indicate that the prior fixes * the parameter to beta[0] in the prior */ void get_mix_prior_params_double(double *alpha, double *beta, double *alpha_beta, const char* which) { alpha[0] = alpha_beta[0]; assert(alpha[0] >= 0); beta[0] = alpha_beta[1]; assert(beta[0] >= 0); alpha[1] = alpha_beta[2]; assert(alpha[1] >= 0); beta[1] = alpha_beta[3]; assert(beta[1] >= 0); /* MYprintf(MYstdout, "%s[a,b][0,1]=[%g,%g],[%g,%g]\n", which, alpha[0], beta[0], alpha[1], beta[1]); */ } /* * BasePrior: * * return the Base (e.g., Gp) prior module */ Base_Prior* Params::BasePrior(void) { return prior; } /* * Print: * * print the settings of the tree parameters -- these * are currently the only parameters governed by the * module */ void Params::Print(FILE *outfile) { MYprintf(outfile, "T[alpha,beta,nmin,smin,bmax]=[%g,%g,%d,%d,%d]\n", t_alpha, t_beta, t_minpart, t_splitmin+1, t_basemax); } tgp/src/rand_draws.c0000644000176200001440000004504113531032535014127 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #include #include "rand_pdf.h" #include "rand_draws.h" #include "matrix.h" #include "linalg.h" #include "lh.h" #include "rhelp.h" #include #include #include #include #include "randomkit.h" /* for Windows and other OS's without drand support, * so the compiler won't warn */ double erand48(unsigned short xseed[3]); int getrngstate = 1; /* * newRNGstate: * * seeding the random number generator, * from jenise */ void* newRNGstate(s) unsigned long s; { switch (RNG) { case CRAN: #ifdef RPRINT if(getrngstate) GetRNGstate(); else warning("cannot generate multiple CRAN RNG states"); getrngstate = 0; return NULL; # else error("cannot use R RNG when not compiling from within R"); #endif case RK: { rk_state* state = (rk_state*) malloc(sizeof(rk_state)); rk_seed(s, state); return (void*) state; } case ERAND: { unsigned short *state = (unsigned short*) new_uivector(3); state[0] = s / 1000000; s = s % 1000000; state[1] = s / 1000; state[2] = s % 1000; return (void*) state; } default: error("RNG type not found"); } } /* * newRNGstate_rand: * * randomly generate a new RNG state based on a random draw from the * current state */ void* newRNGstate_rand(s) void *s; { unsigned long lstate; int state[3]; state[0] = 100*runi(s); state[1] = 100*runi(s); state[2] = 100*runi(s); lstate = three2lstate(state); return(newRNGstate(lstate)); } /* * three2lstate: * * given three integers (positive) , turning it into * a long-state for the RNG seed */ unsigned long three2lstate(int *state) { unsigned long lstate; assert(state[0] >= 0); assert(state[1] >= 0); assert(state[2] >= 0); lstate = state[0] * 1000000 + state[1] * 1000 + state[2]; return(lstate); } /* * deleteRNGstate: * * free memory for RNG seed */ void deleteRNGstate(void *state) { switch (RNG) { case CRAN: #ifdef RPRINT if(!getrngstate) PutRNGstate(); getrngstate = 1; break; #else error("cannot use R RNG when not compiling from within R"); #endif case RK: free((rk_state*) state); break; case ERAND: assert(state); free((unsigned short*) state); break; default: error("RNG type not found"); } } /* * printRNGstate: * * printRNGstate info out to the outfile */ void printRNGstate(void *state, FILE* outfile) { switch (RNG) { case CRAN: assert(!state); MYprintf(outfile, "RNG state CRAN comes from R\n"); break; case RK: assert(state); MYprintf(outfile, "RNG state RK using rk_seed\n"); break; case ERAND: { unsigned short *s = (unsigned short *) state; assert(s); MYprintf(outfile, "RNG state = %d %d %d\n", s[0], s[1], s[2]); } break; default: error("RNG type not found"); } } /* * runi: * * one from a uniform(0,1) * from jenise */ double runi(void *state) { switch (RNG) { case CRAN: assert(!state); return unif_rand(); case RK: { unsigned long rv; assert(state); rv = rk_random((rk_state*) state); /* MYprintf(MYstderr, "(%d)", ((int)(10000000 * (((double) rv)/RK_MAX)))); if(((int)(10000000 * (((double) rv)/RK_MAX))) == 7294478) assert(0); */ return ((double) rv) / RK_MAX; } case ERAND: assert(state); return erand48(state); default: error("RNG type not found"); } } /* * runif: * * n draws from a uniform(a,b) */ void runif_mult(double* r, double a, double b, unsigned int n, void *state) { double scale; int i; scale = b - a; for(i=0; i1.); e=sqrt((-2.*log(w))/w); x[0] = v2*e; x[1] = v1*e; } /* * rnorm_mult: * * multiple draws from the standard normal */ void rnorm_mult(x, n, state) unsigned int n; double *x; void *state; { unsigned int j; double aux[2]; if(n == 0) return; for(j=0;j 0); /* int done = 0; */ uniform0 = runi(state); uniform1 = runi(state); if (uniform0 > M_E/(alpha + M_E)) { random = 0.0 -log((alpha + M_E)*(1-uniform0)/(alpha*M_E)); if ( uniform1 > pow(random,alpha - 1)) return -1; else return random; } else { x = (alpha + M_E) * uniform0 / M_E; random = pow(x,1/alpha); if ( uniform1 > exp(-random)) return -1; else return random; } } /* * rgamma2: * * Generates a draw from a gamma distribution with alpha > 1 * * from William Brown */ double rgamma2(double alpha, void *state) { double uniform1,uniform2; double c1,c2,c3,c4,c5,w; double random; int done = 1; /* sanity check */ assert(alpha > 0); c1 = alpha - 1; c2 = (alpha - 1/(6 * alpha))/c1; c3 = 2 / c1; c4 = c3 + 2; c5 = 1 / sqrt(alpha); do { uniform1 = runi(state); uniform2 = runi(state); if (alpha > 2.5) { uniform1 = uniform2 + c5 * (1 - 1.86 * uniform1); } } while ((uniform1 >= 1) || (uniform1 <= 0)); w = c2 * uniform2 / uniform1; if ((c3 * uniform1 + w + 1/w) > c4) { if ((c3 * log(uniform1) - log(w) + w) >= 1) { done = 0; } } if (done == 0) return -1; random = c1 * w; return random; } /* * rgamma_wb: * * Generates from a general gamma(alpha,beta) distribution * from Willia Brown (via Milovan / Draper, UCSC) * Parametrization as in the Gelman's book ( E(x) = alpha/beta ) */ double rgamma_wb(double alpha, double beta, void *state) { double random = 0; /* sanity checks */ assert(alpha>0 && beta>0); if (alpha < 1) do { random = rgamma1(alpha, state)/beta; } while (random < 0 ); if (alpha == 1) random = rexpo(1.0, state)/beta; if (alpha > 1) do { random = rgamma2(alpha, state)/beta; } while (random < 0); return random; } /* * inv_gamma_mult_gelman: * * GELMAN PARAMATERIZATION; cases draws from a inv-gamma * distribution with parameters alpha and beta * x must be an alloc'd cases-array */ void inv_gamma_mult_gelman(x, alpha, beta, cases, state) unsigned int cases; double *x; double alpha, beta; void *state; { int i; /* sanity checks */ assert(alpha>0 && beta >0); /* get CASES draws from a gamma */ for(i=0; i< cases; i++) x[i] = 1.0 / rgamma_wb(alpha, beta, state); return; } /* * gamma_mult_gelman: * * GELMAN PARAMATERIZATION; cases draws from a gamma * distribution with parameters alpha and beta * x must be an alloc'd cases-array */ void gamma_mult_gelman(x, alpha, beta, cases, state) unsigned int cases; double *x; double alpha, beta; void *state; { int i; /* get CASES draws from a gamma */ for(i=0; i< cases; i++) x[i] = rgamma_wb(alpha, beta, state); return; } /* * rbeta: * * one random draw from the beta distribution * with parameters alpha and beta. */ double rbet(alpha, beta, state) double alpha, beta; void *state; { double g1,g2; g1 = rgamma_wb(alpha, 1.0, state); g2 = rgamma_wb(beta, 1.0, state); return g1/(g1+g2); } /* * beta_mult: * * cases draws from a beta distribtion with * parameters alpha and beta. * x must be an alloc'd cases-array */ void beta_mult(x, alpha, beta, cases, state) unsigned int cases; double *x; double alpha, beta; void *state; { int i; /* get CASES draws from a beta */ for(i=0; i< cases; i++) { x[i] = rbet(alpha,beta,state); } return; } /* * wishrnd: * * single n x n draw from a Wishart distribtion with * positive definite mean S, and degrees of freedom nu. * uses method from Gelman appendix (nu > n) * * x[n][n], S[n][n]; */ void wishrnd(x, S, n, nu, state) unsigned int n, nu; double **x, **S; void *state; { /*double alphaT[n][nu], alpha[nu][n], cov[n][n]; double mu[n];*/ double **alphaT, **alpha, **cov; double *mu; int i; /* sanity checks */ assert(n > 0); assert(nu > n); zero(x, n, n); /* draw from the multivariate normal */ cov = new_matrix(n,n); alphaT = new_matrix(n,nu); copyCovLower(cov, S, n, 1.0); mu = (double*) malloc(sizeof(double) * n); for(i=0; i 0); assert(n > 0); assert(probs[0] >= 0); cumprob[0] = probs[0]; for(i=1; i= 0); cumprob[i] = cumprob[i-1] + probs[i]; } if(cumprob[num_probs-1] < 1.0) cumprob[num_probs-1] = 1.0; for(i=0; i 0); assert(n > 0); assert(probs[0] >= 0); cumprob[0] = probs[0]; for(i=1; i= 0); cumprob[i] = cumprob[i-1] + probs[i]; } if(cumprob[num_probs-1] < 1.0) cumprob[num_probs-1] = 1.0; for(i=0; i indx) k = j-1; p[k] = p_old[j] / p_not; x[k] = x_old[j]; xi[k] = xi_old[j]; } free(x_old); free(p_old); free(xi_old); /* draw the ith sample */ isample(&out, &indx, 1, num_probs-i, x, p, state); x_out[i] = out; x_indx[i] = xi[indx]; assert(X[xi[indx]] == x_out[i]); } /* clean up */ free(p); free(x); free(xi); } /* * sample_seq: * * returns a single uniform sample from * the integral range [from...to]. */ int sample_seq(int from, int to, void *state) { unsigned int len, indx; int k_d; int *one2len; double *probs; if(from == to) return from; len = abs(from-to)+1; assert(from <= to); one2len = iseq(from,to); probs = ones(len, 1.0/len); isample(&k_d, &indx, 1, len, one2len, probs, state); free(one2len); free(probs); return (int) k_d; } /* * rpoiso: * * Draws frrom Pois(xm); * From NUMERICAL RECIPIES with a few minor modifications * * Returns as a floating-point number an integer value that is a * random deviate drawn from a Poisson distribution of mean xm * * NOT THREAD SAFE */ unsigned int rpoiso(float xm, void *state) { /* NOT THREAD SAFE */ static double sq,alxm,g,oldm=(-1.0); /*oldm is a flag for whether xm has changed since last call.*/ double em,t,y; if (xm < 12.0) { /*Use direct method.*/ if (xm != oldm) { oldm=xm; g=exp(-xm); /* If xm is new, compute the exponential. */ } em = 0.0-1.0; t=1.0; do { /* Instead of adding exponential deviates it is equivalent to multiply uniform deviates. We never actually have to take the log, merely compare to the pre-computed exponential. */ ++em; t *= runi(state); } while (t > g); } else { /* Use rejection method. */ if (xm != oldm) { /*If xm has changed since the last call, then precompute some functions that occur below.*/ oldm=xm; sq=sqrt(2.0*xm); alxm=log(xm); g=xm*alxm-lgammafn(xm+1.0); } do { do { /* y is a deviate from a Lorentzian comparison function. */ y=tan(M_PI*runi(state)); em=sq*y+xm; /* em is y, shifted and scaled. */ } while (em < 0.0); /* Reject if in regime of zero probability. */ em=floor(em); /* The trick for integer-valued distributions. */ t=0.9*(1.0+y*y)*exp(em*alxm-lgammafn(em+1.0)-g); /* The ratio of the desired distribution to the comparison function; * accept or reject by comparing to another uniform deviate. * The factor 0.9 is chosen so that t never exceeds 1. */ } while (runi(state) > t); } return (unsigned int) em; } /* * compute_probs: * * get probablity distribution based on the * some criteria; alpha is a power to be applied to the prob. */ double* compute_probs(double* criteria, unsigned int nn, double alpha) { double *probs; double sum; unsigned int i; probs = (double*) malloc(sizeof(double) * nn); sum = 0; for(i=0; i parameter[1]) { i[1] = 0; i[0] = 1; } else { i[1] = 1; i[0] = 0; } } /* * rand_indices: * * return a random permutation of the * indices 1...N */ unsigned int* rand_indices(unsigned int N, void *state) { int *o; double *nall = new_vector(N); runif_mult(nall, 0.0, 1.0, N, state); o = order(nall, N); free(nall); return (unsigned int *) o; } tgp/src/lh.c0000644000176200001440000002570213531032535012410 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #include #include #include #include #include #include "lh.h" #include "matrix.h" #include "rhelp.h" #include "rand_draws.h" int compareRank(const void* a, const void* b); int compareDouble(const void* a, const void* b); /* * structure for ranking */ typedef struct rank { double s; int r; } Rank; /* * rect_sample_lh: * * returns a unidorm sample of (n) points * within a regular (dim)-dimensional cube. * (n*dim matrix returned) */ double** rect_sample(int dim, int n, void *state) { int i,j; double **s = new_matrix(dim, n); for(i=0; i= 0); if(n == 0) return NULL; z = e = s = NULL; /* We could just draw random permutations of (1..n) here, which is effectively what we are doing. This ranking scheme could be valuable, though, in drawing lhs for correlated variables. In that case, s would instead be a sample from the correct joint distribution, and the quantile functions at the end would have to correspond to the marginal distributions for each variable. See Stein, 1987 (Technometrics). This would have to be coded on a case to case basis though. */ /* get initial sample */ s = rect_sample(dim, n, state); /* get ranks */ r = (int**) malloc(sizeof(int*) * dim); for(i=0; is = s[i][j]; sr[j]->r = j; } qsort((void*)sr, n, sizeof(Rank*), compareRank); /* assign ranks */ for(j=0; jr] = j+1; free(sr[j]); } free(sr); } /* Draw random variates */ e = rect_sample(dim, n, state); /* Obtain latin hypercube sample on the unit cube: The alpha parameters for each beta quantile function are calculated from the (re-scaled) mode and the shape parameter. */ z = new_matrix(dim,n); for(i=0; i 1.0 || mode[i] < 0) mscaled=0.5; else mscaled = mode[i]; for(j=0; j mscaled || 1 < mscaled ) mscaled=0.5; if(shape[i] < 1) shape[i] = 1; /* only concave betas, else uniform */ alpha = (1 + mscaled*(shape[i]-2))/(1-mscaled); assert( alpha > 0 ); for(j=0; j= 0); if(n == 0) return NULL; z = e = s = NULL; /* get initial sample */ s = rect_sample(dim, n, state); /* get ranks */ r = (int**) malloc(sizeof(int*) * dim); for(i=0; is = s[i][j]; sr[j]->r = j; } qsort((void*)sr, n, sizeof(Rank*), compareRank); /* assign ranks */ for(j=0; jr] = j+1; free(sr[j]); } free(sr); } /* Draw random variates */ if(er) e = rect_sample(dim, n, state); /* Obtain latin hypercube sample */ z = new_matrix(dim,n); for(i=0; is < bb->s) return -1; else return 1; } /* * compareDouble: * * comparison function double sorting ranking */ int compareDouble(const void* a, const void* b) { double aa = (double)(*(double *)a); double bb = (double)(*(double *)b); if(aa < bb) return -1; else return 1; } /* * rect_scale: * * shift/scale a draws from a unit cube into * the specified rectangle */ void rect_scale(double** z, int d, int n, double** rect) { int i,j; double scale, shift; for(i=0; is = s[j]; sr[j]->r = j; } qsort((void*)sr, n, sizeof(Rank*), compareRank); /* assign ranks */ for(j=0; jr +1; free(sr[j]); } free(sr); return r; } /* * rank: * * obtain the integer rank of the elemts of s */ int* rank(double *s, unsigned int n) { int j; int *r; Rank ** sr; r = new_ivector(n); sr = (Rank**) malloc(sizeof(Rank*) * n); for(j=0; js = s[j]; sr[j]->r = j; } qsort((void*)sr, n, sizeof(Rank*), compareRank); /* assign ranks */ for(j=0; jr] = j+1; free(sr[j]); } free(sr); return r; } tgp/src/linalg.h0000644000176200001440000000606213531032535013256 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __LINALG_H__ #define __LINALG_H__ #include "matrix.h" #include "rhelp.h" #ifndef CBLAS_ENUM_DEFINED_H #define CBLAS_ENUM_DEFINED_H enum CBLAS_ORDER {CblasRowMajor=101, CblasColMajor=102 }; enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113, AtlasConj=114}; enum CBLAS_UPLO {CblasUpper=121, CblasLower=122}; enum CBLAS_DIAG {CblasNonUnit=131, CblasUnit=132}; enum CBLAS_SIDE {CblasLeft=141, CblasRight=142}; #endif #define FORTPACK #define FORTBLAS #ifdef FORTPACK #include #define dpotrf dpotrf_ #define dtrsv dtrsv_ #define dposv dposv_ #define dgesv dgesv_ #endif #ifdef FORTBLAS #include #define dgemm dgemm_ #define dsymm dsymm_ #define dgemv dgemv_ #define dsymv dsymv_ #define ddot ddot_ #define daxpy daxpy_ #define dtrsv dtrsv_ #endif void linalg_dtrsv(const enum CBLAS_TRANSPOSE TA, int n, double **A, int lda, double *Y, int ldy); void linalg_daxpy(int n, double alpha, double *X, int ldx, double *Y, int ldy); double linalg_ddot(int n, double *X, int ldx, double *Y, int ldy); void linalg_dgemm(const enum CBLAS_TRANSPOSE TA, const enum CBLAS_TRANSPOSE TB, int m, int n, int k, double alpha, double **A, int lda, double **B, int ldb, double beta, double **C, int ldc); void linalg_dsymm(const enum CBLAS_SIDE side, int m, int n, double alpha, double **A, int lda, double **B, int ldb, double beta, double **C, int ldc); void linalg_dgemv(const enum CBLAS_TRANSPOSE TA, int m, int n, double alpha, double **A, int lda, double *X, int ldx, double beta, double *Y, int ldy); void linalg_dsymv(int n, double alpha, double **A, int lda, double *X, int ldx, double beta, double *Y, int ldy); int linalg_dposv(int n, double **Mutil, double **Mi); int linalg_dgesv(int n, double **Mutil, double **Mi); int linalg_dpotrf(int n, double **var); /* iterative */ int solve_cg_symm(double *x, double *x_star, double **A, double *b, double theta, unsigned int n); #endif tgp/src/gen_covar.h0000644000176200001440000000506213531032535013752 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __GEN_COVAR_H__ #define __GEN_COVAR_H__ void dist(double **DIST, unsigned int m, double **X1, unsigned int n1, double **X2, unsigned int n2, double pwr); void exp_corr_sep(double **K, unsigned int m, double **X1, unsigned int n1, double **X2, unsigned int n2, double *d, double pwr); void sim_corr(double **K, unsigned int m, double **X1, unsigned int n1, double **X2, unsigned int n2, double *d, double pwr); void dist_symm(double **DIST, unsigned int m, double **X, unsigned int n, double pwr); void exp_corr_sep_symm(double **K, unsigned int m, double **X, unsigned int n, double *d, double nug, double pwr); void sim_corr_symm(double **K, unsigned int m, double **X, unsigned int n, double *d, double nug, double pwr); void dist_to_K(double **K, double **DIST, double d, double nug, unsigned int m, unsigned int n); void dist_to_K_symm(double **K, double **DIST, double d, double nug, unsigned int n); void matern_dist_to_K(double **K, double **DIST, double d, double nu, double *bk, double nug, unsigned int m, unsigned int n); void matern_dist_to_K_symm(double **K, double **DIST, double d, double nu, double *bk, double nug, unsigned int n); void inverse_chol(double **M, double **Mi, double **Mutil, unsigned int n); void inverse_lu(double **M, double **Mi, double **Mutil, unsigned int n); void solve_chol(double *x, double **A, double *b, unsigned int n); double log_bessel_k(double x, double nu, double exp0, double *bk, long bn); #endif tgp/src/model.h0000644000176200001440000001624113531032535013110 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __MODEL_H__ #define __MODEL_H__ #include "tree.h" #include "list.h" #include "params.h" #include "mstructs.h" #include "temper.h" /*#define PARALLEL*/ /* should prediction be done with pthreads */ #define NUMTHREADS 2 /* number of pthreads for prediction */ #define QUEUEMAX 100 /* maximum queue size for partitions on which to predict */ #define PPMAX 100 /* maximum partitions accumulated before sent to queue */ class Model { private: unsigned int d; /* X input dimension */ double **iface_rect; /* X-input bounding rectangle */ int Id; /* identification number for this model */ Params *params; /* hierarchical and initial parameters */ Base_Prior *base_prior; /* base model (e.g., GP) prior module */ Tree* t; /* root of the partition tree */ double **Xsplit; /* locations at which trees can split */ unsigned int nsplit; /* number of locations in Xsplit */ double Zmin; /* global minimum Z-value used in EGO/Improve calculations */ unsigned int wZmin; /* index of minimum Z-value in Z-vector */ /* for computing acceptance proportions of tree proposals */ int swap,change,grow,prune,swap_try,grow_try,change_try,prune_try; bool parallel; /* use pthreads or not */ void *state_to_init_consumer; /* to initialize consumer state variables */ List *PP; /* producer wait queue (before producing to tlist) */ #ifdef PARALLEL pthread_t** consumer; /* consumer thread handle */ pthread_mutex_t* l_mut; /* locking the prediction list */ pthread_cond_t* l_cond_nonempty; /* cond variable signals nonempty list */ pthread_cond_t* l_cond_notfull; /* cond variable signals nonempty list */ List* tlist; /* list of prediction leaves */ unsigned int num_consumed; /* number of consumed leaves total */ unsigned int num_produced; /* number of produced leaves total */ pthread_mutex_t* l_trace_mut; /* locking the XX_trace file */ #endif FILE *PARTSFILE; /* what file to write partitions to */ FILE *POSTTRACEFILE; /* what file to write posterior traces to */ FILE *XXTRACEFILE; /* files for writing traces to for each XX */ FILE *HIERTRACEFILE; /* files for writing traces to hierarchical params */ double partitions; /* counter for the averave number of partitions */ FILE* OUTFILE; /* file for MCMC status output */ int verb; /* printing level (0=none, ... , 3+=verbose) */ bool trace; /* should a trace of the MC be written to files? */ Posteriors *posteriors; /* for keeping track of the best tree posteriors */ Linarea *lin_area; /* if so, we need a pointer to the area structure */ Temper *its; /* inv-temperature for importance-tempering */ bool Tprior; /* whether to temper the (tree) prior or not */ public: /* init and destruct */ Model(Params *params, unsigned int d, double **rect, int Id, bool trace, void *state_to_init_conumer); ~Model(void); void Init(double **X, unsigned int d, unsigned int n, double *Z, Temper *it, double *dtree, unsigned int ncol, double* hier); /* MCMC */ void rounds(Preds *preds, unsigned int B, unsigned int T, void *state); void Linburn(unsigned int B, void *state); void Burnin(unsigned int B, void *state); void StochApprox(unsigned int B, void *state); void Sample(Preds *preds, unsigned int R, void *state); void Predict(Preds *preds, unsigned int R, void *state); /* tree operations and modifications */ bool modify_tree(void *state); bool change_tree(void *state); bool grow_tree(void *state); bool swap_tree(void *state); bool prune_tree(void *state); void set_TreeRoot(Tree *t); Params* get_params(void); Tree* get_TreeRoot(void); double** get_Xsplit(unsigned int *nsplit); void set_Xsplit(double **X, unsigned int n, unsigned int d); void predict_master(Tree *leaf, Preds *preds, int index, void* state); void Predict(Tree* leaf, Preds* preds, unsigned int index, bool dnorm, void *state); Tree** CopyPartitions(unsigned int *numLeaves); void MAPreplace(void); void predict_xx(Tree* ll, Preds* preds, int index, bool dnorm, void *state); void cut_branch(void *state); void cut_root(void); void new_data(double **X, unsigned int n, unsigned int d, double* Z, double **rect); /* parallel prediction functions */ void init_parallel_preds(void); void close_parallel_preds(void); void predict_consumer(void); void predict_producer(Tree *leaf, Preds* preds, int index, bool dnorm); void consumer_finish(void); void consumer_start(void); void wrap_up_predictions(void); void produce(void); /* printing functions */ FILE* Outfile(int* verb); void Outfile(FILE *file, int verb); double Partitions(void); FILE* OpenFile(const char *prefix, const char *type); void PrintPartitions(void); void PrintBestPartitions(); void PrintTree(FILE* outfile); double Posterior(bool record); void PrintState(unsigned int r, unsigned int numLeaves, Tree** leaves); void PrintPosteriors(void); Tree* maxPosteriors(void); void Print(void); void PrintTreeStats(FILE* outfile); void TreeStats(double *gpcs); void PrintHiertrace(void); void ProcessLinarea(Tree **leaves, unsigned int numLeaves); /* LLM functions */ double Linear(void); void ResetLinear(double gam); void PrintLinarea(void); /* recording traces of Base parameters for XX in leaves */ void Trace(Tree *leaf, unsigned int index); void TraceNames(FILE * outfile, bool full); void PriorTraceNames(FILE * outfile, bool full); /* tempered importance sampling */ double iTemp(void); void DrawInvTemp(void* state, bool burnin); double* update_tprobs(void); void DupItemps(Temper *its); }; unsigned int new_index(double *quantiles, unsigned int n, unsigned int r); void* predict_consumer_c(void* m); void print_parts(FILE *PARTSFILE, Tree *t, double **iface_rect); #endif tgp/src/matern.h0000644000176200001440000001074513531032535013301 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __MATERN_H__ #define __MATERN_H__ #include "corr.h" class Matern_Prior; /* * CLASS for the implementation of the matern * family of correlation functions */ class Matern : public Corr { private: double nu; /* matern smoothing parameter */ double *bk; /* vector of len floor(nu)+1 for K_bessel */ long nb; /* floor(nu)+1 */ double d; /* kernel correlation range parameter */ double **xDISTx; /* n x n, matrix of euclidean distances to the x spatial locations */ unsigned int nd; /* for keeping track of the current size of xDISTx (nd x nd) */ unsigned int dreject; /* d rejection counter */ public: Matern(unsigned int dim, Base_Prior *base_prior); virtual Corr& operator=(const Corr &c); virtual ~Matern(void); virtual void Update(unsigned int n1, unsigned int n2, double **K, double **X, double **XX); virtual void Update(unsigned int n1, double **X); virtual void Update(unsigned int n1, double **K, double **X); virtual int Draw(unsigned int n, double **F, double **X, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); virtual void Combine(Corr *c1, Corr *c2, void *state); virtual void Split(Corr *c1, Corr *c2, void *state); virtual char* State(unsigned int which); virtual double log_Prior(void); virtual unsigned int sum_b(void); virtual void ToggleLinear(void); virtual bool DrawNugs(unsigned int n, double **X, double **F, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); virtual double* Trace(unsigned int* len); virtual char** TraceNames(unsigned int* len); virtual void Init(double *dmat); virtual double* Jitter(unsigned int n1, double **X); virtual double* CorrDiag(unsigned int n1, double **X); virtual void Invert(unsigned int n); void get_delta_d(Matern* c1, Matern* c2, void *state); void propose_new_d(Matern* c1, Matern* c2, void *state); double D(void); double NU(void); }; /* * CLASS for the prior parameterization of exponential * power family of correlation functions */ class Matern_Prior : public Corr_Prior { private: double nu; /* matern smoothing parameter */ double d; double d_alpha[2]; /* d gamma-mixture prior alphas */ double d_beta[2]; /* d gamma-mixture prior beta */ bool fix_d; /* estimate d-mixture parameters or not */ double d_alpha_lambda[2]; /* d prior alpha lambda parameter */ double d_beta_lambda[2]; /* d prior beta lambda parameter */ public: Matern_Prior(unsigned int dim); Matern_Prior(Corr_Prior *c); virtual ~Matern_Prior(void); virtual void read_double(double *dprior); virtual void read_ctrlfile(std::ifstream* ctrlfile); virtual void Draw(Corr **corr, unsigned int howmany, void *state); virtual Corr_Prior* Dup(void); virtual Corr* newCorr(void); virtual void Print(FILE *outfile); virtual Base_Prior* BasePrior(void); virtual void SetBasePrior(Base_Prior *base_prior); virtual double log_HierPrior(void); virtual double* Trace(unsigned int* len); virtual char** TraceNames(unsigned int* len); virtual void Init(double *dhier); double NU(void); double D(void); double* DAlpha(void); double* DBeta(void); void default_d_priors(void); void default_d_lambdas(void); double log_Prior(double d, bool linear); bool LinearRand(double d, void *state); }; #endif tgp/src/predict_linear.c0000644000176200001440000003530713531032535014773 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #include #include #include #include "rhelp.h" #include "rand_draws.h" #include "matrix.h" #include "predict_linear.h" #include "predict.h" #include "linalg.h" /* #define DEBUG */ /* * predictive_mean_noK: * * compute the predictive mean of a single observation * used by predict_data and predict * * FFrow[col], b[col] */ double predictive_mean_noK(n1, col, FFrow, i, b) unsigned int n1, col; int i; double *FFrow, *b; { double zm; /* f(x)' * beta */ zm = linalg_ddot(col, FFrow, 1, b, 1); return zm; } /* * predict_data_noK: * * used by the predict_full funtion below to fill * z[n1] with predicted values based on the input coded in * terms of Frow,FW,W,xxKx,IDpFWF,IDpFWFi,b,ss2,Kdiag * returns the number of warnings * * b[col], z[n1], FFrow[n1][col]; */ void predict_data_noK(zpm,zps2,n1,col,FFrow,b,ss2,Kdiag) unsigned int n1, col; double *b, *zpm, *zps2, *Kdiag; double **FFrow; double ss2; { int i; /* for each point at which we want a prediction */ for(i=0; i 0);*/ Qy = new_vector(n1); for(i=0; i= 0); } /* clean up */ free(Qy); } /* * predictive_var_noK: * * computes the predictive variance for a single location * used by predict. Also returns Q, rhs, Wf, and s2corr * which are useful for computeing Delta-sigma * * Q[n1], rhs[n1], Wf[col], FFrow[n1], FW[col][n1], * IDpFWFi[n1][n1], W[col][col]; */ double predictive_var_noK(n1, col, Q, rhs, Wf, s2cor, ss2, f, FW, W, tau2, IDpFWFi, corr_diag) unsigned int n1, col; double *Q, *rhs, *Wf, *f, *s2cor; double **FW, **IDpFWFi, **W; double corr_diag, ss2, tau2; { double s2, kappa, fWf, last; /* Var[Z(x)] = s2*[corr_diag + fWf - Q (K + FWF)^{-1} Q] */ /* where Q = k + FWf */ /* Q = tau2*FW*f(x); */ zerov(Q, n1); linalg_dgemv(CblasNoTrans,n1,col,tau2,FW,n1,f,1,0.0,Q,1); /* rhs = IDpFWFi * Q */ linalg_dgemv(CblasNoTrans,n1,n1,1.0,IDpFWFi,n1,Q,1,0.0,rhs,1); /* Q (tau2*FWF)^{-1} Q */ /* last = Q*rhs = Q*KpFWFi*Q */ last = linalg_ddot(n1, Q, 1, rhs, 1); /* W*f(x) */ linalg_dsymv(col,1.0,W,col,f,1,0.0,Wf,1); /* f(x)*Wf */ fWf = linalg_ddot(col, f, 1, Wf, 1); /* finish off the variance */ /* Var[Z(x)] = s2*[corr_diag + fWf - Q (Id + FWF)^{-1} Q] */ /* Var[Z(x)] = s2*[kappa - Q C^{-1} Q] */ kappa = corr_diag + tau2*fWf; *s2cor = kappa - last; s2 = ss2*(*s2cor); /* this is to catch bad s2 calculations; */ if(s2 <= 0) { s2 = 0; *s2cor = corr_diag-1.0; } return s2; } /* * predict_delta_noK: * * used by the predict_full funtion below to fill * zmean and zs [n2] with predicted mean and var * values based on the input coded in * terms of FF,FW,W,xxKx,IDpFWF,IDpFWFi,b,ss2,Kdiag * * Also calls delta_sigma2 at each predictive location, * because it uses many of the same computed quantaties * as needed to compute the predictive variance. * * b[col], z[n2] FFrow[n2][col] IDpFWFi[n1][n1], * FW[col][n1], W[col][col], Ds2xy[n2][n2]; */ void predict_delta_noK(zzm,zzs2,Ds2xy,n1,n2,col,FFrow,FW,W,tau2,IDpFWFi,b,ss2,KKdiag) unsigned int n1, n2, col; double *b, *zzm, *zzs2, *KKdiag; double **FFrow, **IDpFWFi, **FW, **W, **Ds2xy; double ss2, tau2; { int i; double s2cor; /*double Q[n1], rhs[n1], Wf[col];*/ double *Q, *rhs, *Wf; /* zero stuff out before starting the for-loop */ rhs = new_zero_vector(n1); Wf = new_zero_vector(col); Q = new_vector(n1); /* for each point at which we want a prediction */ for(i=0; i #include #include //class GP_Prior; class Base_Prior; /* * Base: * * constructor for the base (e.g., GP) model; * most things are set to null values */ Base::Base(unsigned int d, Base_Prior *prior, Model *model) { /* data size */ this->n = 0; this->d = d; nn = 0; col = prior->Col(); /* null everything */ X = XX = NULL; Z = NULL; mean = 0; /* model references */ this->prior = prior; pcopy = false; OUTFILE = model->Outfile(&verb); /* annleaing temper comes from model */ itemp = model->iTemp(); } /* * Base: * * duplication constructor; params any "new" variables are also * set to NULL values; the economy argument is not used here */ Base::Base(double **X, double *Z, Base *old, bool economy) { /* simple non-pointer copies */ d = old->d; col = old->col; n = old->n; /* pointers to data */ this->X = X; this->Z = Z; mean = old->mean; /* prior parameters; forces a copy to be made */ prior = old->prior->Dup(); pcopy = true; /* copy the importance annealing temperature */ itemp = old->itemp; /* things that must be NULL */ XX = NULL; nn = 0; OUTFILE = old->OUTFILE; } /* * ~Base: * * destructor function for the base (e.g., GP) model */ Base::~Base(void) { if(pcopy) delete prior; } /* * N: * * sanity check, and return n, the size of the data * under this GP */ unsigned int Base::N(void) { if(n == 0) { assert(X == NULL); return 0; } else { assert(X != NULL); return n; } } /* * BaseModel: * * return s the "prior" base model */ BASE_MODEL Base::BaseModel(void) { return prior->BaseModel(); } /* * BasePrior: * * return the prior used by this base * */ Base_Prior* Base::Prior(void) { return prior; } /* * Base_Prior: * * the usual constructor function */ Base_Prior::Base_Prior(unsigned int d) { this->d = d; } /* * Base_Prior: * * duplication constructor function */ Base_Prior::Base_Prior(Base_Prior *p) { assert(p); base_model = p->base_model; /* generic and tree parameters */ d = p->d; col = p->col; } /* * BaseModel: * * return the base model indicator */ BASE_MODEL Base_Prior::BaseModel(void) { return base_model; } /* * Col * */ unsigned int Base_Prior::Col(void) { return col; } /* * ~Base_Prior: * * the usual destructor, nothing to do */ Base_Prior::~Base_Prior(void) { } tgp/src/Makevars0000644000176200001440000000134513726652677013357 0ustar liggesusers# un-comment the -DPARALLEL in order to get the pthreads parallel # implementation (you may also have to appropriate pthreads flags # to PKG_LIBS for your operating system) # comment out the (3) lines below in order to enable ATLAS (step 1) PKG_CFLAGS = -DRPRINT # -UNDEBUG PKG_CXXFLAGS = -DRPRINT ## -DDO_NOT_USE_CXX_HEADERS -UNDEBUG -DPARALLEL PKG_LIBS = ${LAPACK_LIBS} ${BLAS_LIBS} ${FLIBS} #-pthread LDFLAGS = -L/usr/lib -L/usr/lib/R/lib -L/usr/local/lib # Uncomment and modify the (3) lines below to enable ATLAS (steps 1 & 2) #PKG_CXXFLAGS = -DRPRINT #-DPARALLEL #PKG_CFLAGS = -DRPRINT -I/cse/grads/rbgramacy/atlas/OSX_PPCG5AltiVec_2/include #PKG_LIBS = -L/cse/grads/rbgramacy/atlas/OSX_PPCG5AltiVec_2/lib -llapack -lcblas -latlas tgp/src/predict.c0000644000176200001440000005532513531032535013443 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #include #include #include #include #include "rand_draws.h" #include "rand_pdf.h" #include "matrix.h" #include "predict.h" #include "linalg.h" #include "rhelp.h" #include "lh.h" #include /* #define DEBUG */ /* * predictive_mean: * * compute the predictive mean of a single observation * used by predict_data and predict * * FFrow[col], KKrow[n1], KiZmFb[n1], b[col] */ double predictive_mean(n1, col, FFrow, KKrow, b, KiZmFb) unsigned int n1, col; double *FFrow, *KKrow, *KiZmFb, *b; { double zzm; /* Note that KKrow has been passed without any jitter. */ /* f(x)' * beta */ zzm = linalg_ddot(col, FFrow, 1, b, 1); /* E[Z(x)] = f(x)' * beta + k'*Ki*(Zdat - F*beta) */ zzm += linalg_ddot(n1, KKrow, 1, KiZmFb, 1); #ifdef DEBUG /* check to make sure the prediction is not too big; an old error */ if(abs(zzm) > 10e10) warning("(predict) abs(zz)=%g > 10e10", zzm); #endif return zzm; } /* * predict_data: * * used by the predict_full funtion below to fill * zmean and zs [n1] with predicted mean and var values * at the data locations, X * * b[col], KiZmFb[n1], z[n1], FFrow[n1][col], K[n1][n1]; */ void predict_data(zpm,zps2,n1,col,FFrow,K,b,ss2,zpjitter,KiZmFb) unsigned int n1, col; double *b, *KiZmFb, *zpm, *zps2, *zpjitter; double **FFrow, **K; double ss2; { int i; /* Note that now K is passed with jitter included. This was previously removed in the predict_full fn. */ /* printf("zp: "); printVector(zpjitter,5,MYstdout, HUMAN); */ /* for each point at which we want a prediction */ for(i=0; i 0);*/ Qy = new_vector(n1); for(i=0; i= 0); } /* clean up */ free(Qy); } /* * predictive_var: * * computes the predictive variance for a single location * used by predict. Also returns Q, rhs, Wf, and s2corr * which are useful for computing Delta-sigma * * Q[n1], rhs[n1], Wf[col], KKrow[n1], FFrow[n1], FW[col][n1], * KpFWFi[n1][n1], W[col][col]; */ double predictive_var(n1, col, Q, rhs, Wf, s2cor, ss2, k, f, FW, W, tau2, KpFWFi, corr_diag) unsigned int n1, col; double *Q, *rhs, *Wf, *k, *f, *s2cor; double **FW, **KpFWFi, **W; double ss2, corr_diag, tau2; { double s2, kappa, fWf, last; /* Var[Z(x)] = s2*[KKii + jitter + fWf - Q (K + FWF)^{-1} Q] */ /* where Q = k + FWf */ /* Q = k + tau2*FW*f(x); */ dupv(Q, k, n1); linalg_dgemv(CblasNoTrans,n1,col,tau2,FW,n1,f,1,1.0,Q,1); /* rhs = KpFWFi * Q */ linalg_dgemv(CblasNoTrans,n1,n1,1.0,KpFWFi,n1,Q,1,0.0,rhs,1); /* Q (K + tau2*FWF)^{-1} Q */ /* last = Q*rhs = Q*KpFWFi*Q */ last = linalg_ddot(n1, Q, 1, rhs, 1); /* W*f(x) */ linalg_dsymv(col,1.0,W,col,f,1,0.0,Wf,1); /* f(x)*Wf */ fWf = linalg_ddot(col, f, 1, Wf, 1); /* finish off the variance */ /* Var[Z(x)] = s2*[KKii + jitter + fWf - Q (K + FWF)^{-1} Q] */ /* Var[Z(x)] = s2*[kappa - Q C^{-1} Q] */ /* of course corr_diag = 1.0 + nug, for non-mr_tgp & non calibration */ kappa = corr_diag + tau2*fWf; *s2cor = kappa - last; s2 = ss2*(*s2cor); /* this is to catch bad s2 calculations; note that jitter = nug for non-mr_tgp */ if(s2 <= 0) { s2 = 0; *s2cor = corr_diag-1.0; } return s2; } /* * predict_delta: * * used by the predict_full funtion below to fill * zmean and zs [n2] with predicted mean and var * values based on the input coded in terms of * FF,FW,W,xxKx,KpFWF,KpFWFi,b,ss2,nug,KiZmFb * * Also calls delta_sigma2 at each predictive location, * because it uses many of the same computed quantaties * as needed to compute the predictive variance. * * b[col], KiZmFb[n1], z[n2] FFrow[n2][col], KKrow[n2][n1], * xxKxx[n2][n2], KpFWFi[n1][n1], FW[col][n1], W[col][col], * Ds2xy[n2][n2]; */ void predict_delta(zzm,zzs2,Ds2xy,n1,n2,col,FFrow,FW,W,tau2,KKrow,xxKxx,KpFWFi,b, ss2, zzjitter,KiZmFb) unsigned int n1, n2, col; double *b, *KiZmFb, *zzm, *zzs2, *zzjitter; double **FFrow, **KKrow, **xxKxx, **KpFWFi, **FW, **W, **Ds2xy; double ss2, tau2; { int i; double s2cor; /*double Q[n1], rhs[n1], Wf[col];*/ double *Q, *rhs, *Wf; /* zero stuff out before starting the for-loop */ rhs = new_zero_vector(n1); Wf = new_zero_vector(col); Q = new_vector(n1); /* for each point at which we want a prediction */ for(i=0; i 0) improv[i] = diff; */ if(improv[i] < 0) improv[i] = 0.0; } } /* * predicted_improv: * * compute the improvement statistic for * posterior predictive data z * * This more raw statistic allows * a full summary of the Improvement I(X) distribution, * rather than the expected improvement provided by * expected_improv. * * Samples z(X) are (strongly) preferred over the data * Z(X), and likewise for zz(XX) rather than zz-hat(XX) * * Note that there is no predictive-variance argument. */ void predicted_improv(n, nn, improv, Zmin, zp, zz) unsigned int n, nn; double *improv, *zp, *zz; double Zmin; { unsigned int which, i; double fmin, diff; /* shouldn't be called if improv is NULL */ assert(improv); /* calculate best minimum so far */ fmin = min(zp, n, &which); if(Zmin < fmin) fmin = Zmin; for(i=0; i 0) improv[i] = diff; else improv[i] = 0.0; } } /* * GetImprovRank: * * implements Matt Taddy's algorithm for determining the order * in which the nn points -- whose improv samples are recorded * in the cols of Imat_in over R rounds -- should be added into * the design in order to get the largest expected improvement. * w are R importance tempering (IT) weights */ unsigned int* GetImprovRank(int R, int nn, double **Imat_in, int g, int numirank, double *w) { /* duplicate Imat, since it will be modified by this method */ unsigned int j, i, k, /* m,*/ maxj; double *colmean, *maxcol; double **Imat; /* double maxmean; */ unsigned int *pntind; /* allocate the ranking vector */ pntind = new_zero_uivector(nn); assert(numirank >= 0 && numirank <= nn); if(numirank == 0) return pntind; /* duplicate the Improv matrix so we can modify it */ Imat = new_dup_matrix(Imat_in, R, nn); /* first, raise improv to the appropriate power */ for (j=0; j 0.0) Imat[i][j] = 1.0; else for(k=1; k MYfmax(fabs(XX[i]-Xo[l]), fabs(XX[i]-Xo[u]))) search = 0; else{ l++; u++; } } /*printf("l=%d, u=%d, Xo[l]=%g, Xo[u]=%g, XX[i]=%g \n", l, u, Xo[l],Xo[u],XX[i]);*/ /* width of the window in X-space */ range = MYfmax(fabs(XX[i]-Xo[l]), fabs(XX[i]-Xo[u])); /* calculate the weights in the window; * every weight outside the window will be zero */ zerov(w,n); for(j=l; j<=u; j++){ dist = fabs(XX[i]-Xo[j])/range; w[j] = (1.0-dist)*(1.0-dist); } /* record the (normalized) weighted average in the window */ sumW = sumv(&(w[l]), q); YY[i] = vmult(&(w[l]), &(Yo[l]), q)/sumW; /*printf("YY = "); printVector(YY, nn, MYstdout, HUMAN);*/ } /* clean up */ free(w); free(o); free(Xo); free(Yo); } /* * sobol_indices: * * calculate the Sobol S and T indices using samples of the * posterior predictive distribution (ZZm and ZZvar) at * nn*(d+2) locations */ void sobol_indices(double *ZZ, unsigned int nn, unsigned int m, double *S, double *T) { /* pointers to responses for the original two LHSs */ unsigned int j, k; double dnn, sqEZ, lVZ, ponent, U, Uminus; double *fN; double *fM1 = ZZ; double *fM2 = ZZ + nn; /* accumilate means and variances */ double EZ, EZ2, Evar; Evar = EZ = EZ2 = 0.0; for(j=0; j #include #include "rand_pdf.h" #include "rand_draws.h" #include "matrix.h" #include "linalg.h" #include "gen_covar.h" #include "lik_post.h" #include "all_draws.h" #include "rhelp.h" #include #include /* constants used below */ #define GA 1.0 /* 5.0 */ #define PWR 2.0 /* calculate the prior probability of the LLM */ #define LINEAR(gamma, min, max, d) min + max / (1.0 + exp(0.0-gamma*(d-0.5))); /* minimum values for the nugget and s2_g0 */ #define S2G0MIN 1e-10 /* * mle_beta: * * compute the maximum likelihood estimate for the regression * coefficnents, beta; for use in the emperical Bayes BMLE * model */ void mle_beta(mle, n, col, F, Z) unsigned int n, col; double *Z, *mle; double **F; { double **aux1, **Vb; double *by; /* int info; */ /* zero out by and b */ by = new_zero_vector(col); zerov(mle, col); /* aux1 = F'F*/ aux1 = new_zero_matrix(col, col); linalg_dgemm(CblasTrans,CblasNoTrans,col,col,n, 1.0,F,n,F,n,0.0,aux1,col); /* Vb = inv(F'*F) */ Vb = new_id_matrix(col); /* info = */ linalg_dgesv(col, aux1, Vb); delete_matrix(aux1); /* by = Z*F */ linalg_dgemv(CblasTrans,n,col,1.0,F,n,Z,1,0.0,by,1); /* mle = by*Vb */ linalg_dsymv(col,1.0,Vb,col,by,1,0.0,mle,1); delete_matrix(Vb); free(by); } /* * compute_b_and_Vb_noK: * * b and Vb are needed by compute_lambda and beta_draw * and others: b and Vb must be pre-allocated. * These are two of the three "margin" variables. * DOES NOT INVOLVE THE COVARIANCE MATRIX (K) * * Z[n], b0[col], b[col], TiB0[col], by[col], F[col][n], Ki[n][n], * Ti[col][col], Vb[col][col]; */ void compute_b_and_Vb_noK(Vb, b, by, TiB0, n, col, F, Z, Ti, tau2, b0, Kdiag, itemp) unsigned int n, col; double *Z, *b0, *b, *TiB0, *by, *Kdiag; double **F, **Ti, **Vb; double tau2, itemp; { double **Vbi, **Fgi; /* int info; */ unsigned int i, j; /* sanity check for inv-temperature */ assert(itemp >= 0); /* zero out by and b */ zerov(by, col); zerov(b, col); /* Vbi = F'*diag(1+g)*F + Ti/tau2; with tempering Vbi = itemp * F'*diag(1+g)*F + Ti/tau2 */ Vbi = new_dup_matrix(Ti, col, col); /* This is equivilant to multiplying F by a diagonal matrix with Kdiag., the covariance matrix for the llm. Used again below for b */ Fgi = new_dup_matrix(F, col, n); for(i=0; i= 0); /* itemp = pow(itemp, 2.0/n); */ /* init alloc */ TiB0 = new_vector(col); by = new_vector(col); compute_b_and_Vb_noK(Vb, b, by, TiB0, n, col, F, Z, Ti, tau2, b0, Kdiag, itemp); /* lambda = Z*Z' + b0'*Ti*b0 - B'*VBi*B; */ /* as performed in many steps below */ /* adjust for beta[0]=mu in prior */ /* ZZ = Z'Z/(Kdiag) */ Zgi = new_dup_vector(Z, n); for(i=0; i tempered K is Kdiag/itemp */ ZZ = itemp * ZZ; /* clean up */ free(Zgi); /* Tib0 = by ... we already did this above */ /* b0Tib0 = b0 * by / tau2 */ b0Tib0 = linalg_ddot(col, b0, 1, TiB0, 1) / tau2; free(TiB0); /* B' * Vbi * B = b * by */ BVBiB = linalg_ddot(col,b,1,by,1); free(by); /* now for lambda */ lambda = ZZ + b0Tib0 - BVBiB; /* MYprintf(MYstderr, "noK: n=%d, itemp=%g, ZZ=%g, tau2=%g, b0Tib0/tau2=%g, BVBiB=%g, lambda=%g\n", n, itemp, ZZ, tau2, b0Tib0, BVBiB, lambda); */ /* this is here because when itemp=0 lambda should be 0, but sometimes there are numerical issues where we get e^-17 */ if(itemp == 0.0) lambda = 0.0; return lambda; } /* * compute_b_and_Vb: * * b and Vb are needed by compute_lambda and beta_draw * and others: b and Vb must be pre-allocated. * These are two of the three "margin" variables. * * Z[n], b0[col], b[col], TiB0[col], by[col], F[col][n], * Ki[n][n], Ti[col][col], Vb[col][col] */ void compute_b_and_Vb(Vb, b, by, TiB0, n, col, F, Z, Ki, Ti, tau2, b0, itemp) unsigned int n, col; double *Z, *b0, *b, *TiB0, *by; double **F, **Ki, **Ti, **Vb; double tau2, itemp; { double **KiF, **Vbi; /* int info; */ /* sanity check for temperature */ assert(itemp >= 0); /* KiF = Ki * F; when tempered KiF = itemp * Ki * F */ KiF = new_zero_matrix(col, n); linalg_dsymm(CblasLeft,n,col,itemp,Ki,n,F,n,0.0,KiF,n); /* aux1 = F'*KiF + Ti/tau2 */ Vbi = new_dup_matrix(Ti, col, col); linalg_dgemm(CblasTrans,CblasNoTrans,col,col,n, 1.0,F,n,KiF,n,1.0/tau2,Vbi,col); /* Vb = inv(F'*KiF + Ti/tau2) */ id(Vb, col); // printMatrix(Vb, col, col, MYstdout); // printMatrix(Vbi, col, col, MYstdout); if(col==1) Vb[0][0] = 1.0/Vbi[0][0]; else /* info = */ linalg_dgesv(col, Vbi, Vb); delete_matrix(Vbi); /* by = Z*KiF + b0'*Ti/tau2 */ /* first set: by = b0'*Ti */ zerov(by, col); linalg_dsymv(col,1.0,Ti,col,b0,1,0.0,by,1); /* save the result for later */ dupv(TiB0, by, col); /* use vector stuff for the last part */ linalg_dgemv(CblasTrans,n,col,1.0,KiF,n,Z,1,1.0/tau2,by,1); delete_matrix(KiF); /* b = by*Vb */ zerov(b, col); if(col==1) b[0] = by[0]*Vb[0][0]; else linalg_dsymv(col,1.0,Vb,col,by,1,0.0,b,1); } /* * compute_lambda: * * code for computing the lambda intermediate variable * required by functions which use a marginalized posterior: * (margin_lik, sigma_no_beta, etc...) * * Z[n], b0[col], b[col]; F[col][n], Ki[n][n], Ti[col][col], Vb[col][col] */ double compute_lambda(Vb, b, n, col, F, Z, Ki, Ti, tau2, b0, itemp) unsigned int n, col; double *Z, *b0, *b; double **F, **Ki, **Ti, **Vb; double tau2, itemp; { /*double TiB0[col], KiZ[n], by[col];*/ double *TiB0, *KiZ, *by; double lambda, ZKiZ, BVBiB, b0Tib0; /* sanity check for inv-temperature */ assert(itemp >= 0); /* itemp = pow(itemp, 1.0/n); */ /* init alloc */ TiB0 = new_vector(col); KiZ = new_vector(n); by = new_vector(col); compute_b_and_Vb(Vb, b, by, TiB0, n, col, F, Z, Ki, Ti, tau2, b0, itemp); /* lambda = Z*Ki*Z' + b0'*Ti*b0 - B'*VBi*B; */ /* as performed in many steps below */ /* KiZ = Ki * Z; when tempered KiZ = itemp * Ki * Z */ zerov(KiZ, n); linalg_dsymv(n,itemp,Ki,n,Z,1,0.0,KiZ,1); /* ZKiZ = Z * KiZ */ ZKiZ = linalg_ddot(n,Z,1,KiZ,1); free(KiZ); /* Tib0 = by ... we already did this above */ /* b0Tib0 = b0 * Tib0 */ b0Tib0 = linalg_ddot(col, b0, 1, TiB0, 1); free(TiB0); /* B' * Vbi * B = b * by */ BVBiB = linalg_ddot(col,b,1,by,1); free(by); /* now for lambda */ lambda = ZKiZ + b0Tib0/tau2 - BVBiB; /* MYprintf(MYstderr, "n=%d, itemp=%g, ZKiZ=%g, tau2=%g, b0Tib0/tau2=%g, BVBiB=%g, lambda=%g\n", n, itemp, ZKiZ, tau2, b0Tib0/tau2, BVBiB, lambda); */ /* this is here because when itemp=0 lambda should be 0, but sometimes there are numerical issues where we get e^-17 */ if(itemp == 0.0) lambda = 0.0; return lambda; } /* * beta_draw_margin: * * Gibbs draw for Beta given bmu and Vb marginalzed parameters * * b[col], bmu[col], Vb[col][col] */ unsigned int beta_draw_margin(b, col, Vb, bmu, s2, state) unsigned int col; double *b, *bmu; double **Vb; double s2; void *state; { unsigned int i,j; /*double V[col][col];*/ double **V; int info; /* compute s2*Vb */ V = new_matrix(col, col); /*for(i=0; i 1) info = linalg_dpotrf(col, V); else info = 0; /* now get the draw using the choleski decomposition */ if(info != 0) zerov(b, col); else if(col > 1) mvnrnd(b, bmu, V, col, state); else { /* when beta[0]=mu then we only need one draw */ rnorm_mult(b, 1, state); b[0] *= sqrt(V[0][0]); b[0] += bmu[0]; } delete_matrix(V); return info; } /* * sigma2_draw_no_b_margin: * * draw sigma^2 without dependence on beta */ double sigma2_draw_no_b_margin(n, col, lambda, alpha0, beta0, state) unsigned int n, col; double alpha0, beta0, lambda; void *state; { double alpha, g, x; /* alpha = (alpha0 + length(Z) + length(b))/2; */ alpha = (alpha0 + n)/2; /* just in case */ if(lambda < 0) lambda = 0; /* g = (gamma0 + BLAH)/2; */ g = (beta0 + lambda)/2; /* s2 = 1/gamrnd(alpha, 1/g, 1) */ /* return 1.0 / (1.0/g * rgamma(alpha)); */ inv_gamma_mult_gelman(&x, alpha, g, 1, state); /* MYprintf(MYstderr, "alpha = %g, beta = %g => x = %g\n", alpha, g, x); */ return x; } /* * tau2_draw: * * draws from tau^2 given the rest of the parameters * NOTE: this code was not augmented to use Fb or ZmFb as arguments * because it was not in general use in the code when these * more global changes were made. * * b0[col], b[col], Ti[col][col]; */ double tau2_draw(col, Ti, s2, b, b0, alpha0, beta0, state) unsigned int col; double *b, *b0; double **Ti; double alpha0, beta0, s2; void *state; { /*double bmb0[col], Tibmb0[col];*/ double *bmb0, *Tibmb0; double right, alpha, g, x; /* bmb0 = b-b0 */ bmb0 = new_dup_vector(b, col); linalg_daxpy(col,-1.0,b0,1,bmb0,1); /* right = (bmb0)' * Ti * (bmb0) */ Tibmb0 = new_zero_vector(col); linalg_dsymv(col,1.0,Ti,col,bmb0,1,0.0,Tibmb0,1); right = linalg_ddot(col,bmb0,1,Tibmb0,1) / s2; free(bmb0); free(Tibmb0); /* alpha of gamma distribution */ alpha = (alpha0 + col)/2; /* beta of a gamma distribution */ g = (beta0 + right)/2; /* tau2 = 1/gamrnd(alpha, 1/g, 1) */ /* return 1.0 / (1.0/g * rgamma(alpha)); */ inv_gamma_mult_gelman(&x, alpha, g, 1, state); return x; } /* * gamma_mixture_pdf: * * PDF: mixture prior for d and nug, * works in log space -- returns the log density value */ double gamma_mixture_pdf(d, alpha, beta) double d; double alpha[2], beta[2]; { double p1, p2, lp; gampdf_log_gelman(&p1, &d, alpha[0], beta[0], 1); gampdf_log_gelman(&p2, &d, alpha[1], beta[1], 1); lp = log(0.5*(exp(p1)+exp(p2))); return(lp); } /* * log_d_prior_pdf: * * PDF: mixture prior for d * returns the log pdf */ double log_d_prior_pdf(d, alpha, beta) double d; double alpha[2], beta[2]; { return(gamma_mixture_pdf(d, alpha, beta)); } /* * d_prior_rand: * * rand draws from mixture prior for d */ double d_prior_rand(alpha, beta, state) double alpha[2], beta[2]; void *state; { return(gamma_mixture_rand(alpha, beta, state)); } /* * linear_rand: * * rand draws for the linearization boolean for d */ int linear_rand(d, n, gamlin, state) unsigned int n; double *d, *gamlin; void *state; { double p; if(gamlin[0] == 0) return 0; if(gamlin[0] < 0) return 1; p = linear_pdf(d, n, gamlin); if(runi(state) < p) return 1; else return 0; } /* * linear_rand_sep: * * rand draws for the linearization boolean for d * draws are returned via b (pre-allocated) * b has indicators OPPOSITE of the return value * (e.g. b[i]=0 -> linear d[i], b[i]=1 -> GP) */ int linear_rand_sep(b, pb, d, n, gamlin, state) unsigned int n; double *d, *gamlin, *pb; int *b; void *state; { int bb; unsigned int i; assert(b); assert(d); /* force the GP model */ if(gamlin[0] == 0) { for(i=0; i 0 && gamlin[1] >= 0 && gamlin[1] <= 1 && gamlin[2] >= 0 && gamlin[2] <= 1); /* product of LLM prob in each dimension */ for(i=0; i 0 && gamlin[1] >= 0 && gamlin[1] <= 1 && gamlin[2] >= 0 && gamlin[2] <= 1); /* calculate each dimension separately, save it, and then accumulate the product */ for(i=0; i0); for(i=0; i 0); /* && draw > 2e-20); */ return draw; } /* * unif_propose_pos: * * propose a new positive "ret" based on an old value "last" * by proposing uniformly in [3last/4, 4last/3], and return * the forward and backward probabilities; */ #define PNUM 3.0 #define PDENOM 4.0 double unif_propose_pos(last, q_fwd, q_bak, state) double last; double *q_fwd, *q_bak; void *state; { double left, right, ret; /* propose new d, and compute proposal probability */ left = PNUM*last/(PDENOM); right = PDENOM*last/(PNUM); assert(left > 0 && left < right); runif_mult(&ret, left, right, 1, state); *q_fwd = 1.0/(right - left); /* compute backwards probability */ left = PNUM*ret/(PDENOM); right = PDENOM*ret/(PNUM); assert(left >= 0 && left < right); *q_bak = 1.0/(right - left); assert(*q_bak > 0); /* make sure this is reversible */ assert(last >= left && last <= right); if(ret > 10e10) { warning("unif_propose_pos (%g) is bigger than max", ret); ret = 10; } assert(ret > 0); return ret; } /* * nug_draw: * * unif_propose_pos with adjustment for NUGMIN */ double nug_draw(last, q_fwd, q_bak, state) double last; double *q_fwd, *q_bak; void *state; { return unif_propose_pos(last-NUGMIN, q_fwd, q_bak, state) + NUGMIN; } /* * mixture_priors_ratio: * * evaluationg the posterior for proposed alpha and beta * values: parameters for the hierarchical d prior * * works in log space -- but returns in real (exponentiated) * probabilities */ double mixture_priors_ratio(double *alpha_new, double *alpha, double *beta_new, double *beta, double *d, unsigned int n, double *alpha_lambda, double *beta_lambda) { int i; double log_p, p, p_new; log_p = 0; /* ratio of p(d) under prior */ for(i=0; i alpha_new[0]) { a = mixture_priors_ratio(alpha_new, alpha, beta_new, beta, d, n, alpha_lambda, beta_lambda); a = a*(q_bak/q_fwd); /* accept or reject */ if(runi(state) >= a) { alpha_new[0] = alpha[0]; beta_new[0] = beta[0]; } } /* draws for alpha_new[1] and beta_new[1] conditional on alpha_new[1] and beta_new[1] */ alpha_new[1] = unif_propose_pos(alpha[1], &q_fwd, &q_bak, state); beta_new[1] = unif_propose_pos(beta[1], &q_fwd, &q_bak, state); if(beta_new[1] > alpha_new[1]) { a = mixture_priors_ratio(alpha_new, alpha, beta_new, beta, d, n, alpha_lambda, beta_lambda); a = a*(q_bak/q_fwd); /* accept or reject */ if(runi(state) >= a) { alpha_new[1] = alpha[1]; beta_new[1] = beta[1]; } } } /* * d_draw_margin: * * draws for d given the rest of the parameters * except b and s2 marginalized out * * F[col][n], DIST[n][n], Kchol[n][n], K_new[n][n], Ti[col][col], T[col][col] * Vb[col][col], Vb_new[col][col], Ki_new[n][n], Kchol_new[n][n] b0[col], Z[n] * * return 1 if draw accepted, 0 if rejected, -1 if error */ int d_draw_margin(n, col, d, dlast, F, Z, DIST, log_det_K, lambda, Vb, K_new, Ki_new, Kchol_new, log_det_K_new, lambda_new, Vb_new, bmu_new, b0, Ti, T, tau2, nug, qRatio, d_alpha, d_beta, a0, g0, lin, itemp, state) unsigned int n, col; int lin; double **F, **DIST, **K_new, **Ti, **T, **Vb, **Vb_new, **Ki_new, **Kchol_new; double *b0, *Z; double d_alpha[2], d_beta[2]; double d, dlast, nug, a0, g0, lambda, tau2, log_det_K, qRatio, itemp; double *lambda_new, *bmu_new, *log_det_K_new; void *state; { double pd, pdlast, alpha; double *Kdiag; unsigned int m = 0; /* check if we are sticking with linear model */ assert(dlast != 0.0); /* Knew = dist_to_K(dist, d, nugget); compute lambda, Vb, and bmu, for the NEW d */ if(! lin) { /* regular */ dist_to_K_symm(K_new, DIST, d, nug, n); inverse_chol(K_new, Ki_new, Kchol_new, n); *log_det_K_new = log_determinant_chol(Kchol_new, n); *lambda_new = compute_lambda(Vb_new, bmu_new, n, col, F, Z, Ki_new, Ti, tau2, b0, itemp); } else { /* linear */ *log_det_K_new = n*log(1.0 + nug); Kdiag = ones(n,1.0+nug); *lambda_new = compute_lambda_noK(Vb_new, bmu_new, n, col, F, Z, Ti, tau2, b0, Kdiag, itemp); free(Kdiag); } if(T[0][0] == 0) m = col; /* start computation of posterior distribution */ pd = post_margin(n,col,*lambda_new,Vb_new,*log_det_K_new,a0-m,g0,itemp); pd += log_d_prior_pdf(d, d_alpha, d_beta); pdlast = post_margin(n,col,lambda,Vb,log_det_K,a0-m,g0,itemp); pdlast += log_d_prior_pdf(dlast, d_alpha, d_beta); /* if(lin && pd > pdlast) MYprintf(MYstderr, "pd=%g, pdlast=%g, qRatio=%g\n", pd, pdlast, qRatio); */ /* compute acceptance prob */ /*alpha = exp(pd - pdlast + plin)*(q_bak/q_fwd);*/ alpha = exp(pd - pdlast)*qRatio; if(ISNAN(alpha)) return -1; if(runi(state) < alpha) return 1; else return 0; } /* * d_sep_draw_margin: * * draws for d given the rest of the parameters except b and s2 marginalized out * * F[col][n], Kchol[n][n], K_new[n][n], Ti[col][col], T[col][col] Vb[col][col], * Vb_new[col][col], Ki_new[n][n], Kchol_new[n][n], b0[col], Z[n], dlast[dim], * d_alpha[dim][2], d_beta[dim][2] * * if input d=NULL and lin_new=0, then the MH ratio is just a prior ratio * (plus proposal probabilities) * * return 1 if draw accepted, 0 if rejected, -1 if error */ int d_sim_draw_margin(d, n, dim, col, F, X, Z, log_det_K, lambda, Vb, K_new, Ki_new, Kchol_new, log_det_K_new, lambda_new, Vb_new, bmu_new, b0, Ti, T, tau2, nug, qRatio, pRatio_log, a0, g0, itemp, state) unsigned int n, dim, col; double **F, **X, **K_new, **Ti, **T, **Vb, **Vb_new, **Ki_new, **Kchol_new; double *b0, *Z, *d, *log_det_K_new; double nug, a0, g0, lambda, tau2, log_det_K, qRatio, pRatio_log, itemp; double *lambda_new, *bmu_new; void *state; { double pd, pdlast, alpha; unsigned int m = 0; /* d could be null if d_new == d_new_eff, and in this case the acceptance ratio would be based solely on the prior (& qRatio) */ /* Knew = dist_to_K(dist, d, nugget) compute lambda, Vb, and bmu, for the NEW d */ sim_corr_symm(K_new, dim, X, n, d, nug, PWR); inverse_chol(K_new, Ki_new, Kchol_new, n); *log_det_K_new = log_determinant_chol(Kchol_new, n); *lambda_new = compute_lambda(Vb_new, bmu_new, n, col, F, Z, Ki_new, Ti, tau2, b0, itemp); if(d) { /* adjustment for BFLAT */ if(T[0][0] == 0) m = col; /* posteriors */ pd = post_margin(n,col,*lambda_new,Vb_new,*log_det_K_new,a0-m,g0,itemp); pdlast = post_margin(n,col,lambda,Vb,log_det_K,a0-m,g0,itemp); /* or, no posterior contribution */ } else { pd = 0.0; pdlast = 0.0; } /* compute acceptance prob; and accept or reject */ alpha = exp(pd - pdlast + pRatio_log)*qRatio; if(ISNAN(alpha)) return -1; if(runi(state) < alpha) return 1; else return 0; } /* * d_sep_draw_margin: * * draws for d given the rest of the parameters except b and s2 marginalized out * * F[col][n], Kchol[n][n], K_new[n][n], Ti[col][col], T[col][col] Vb[col][col], * Vb_new[col][col], Ki_new[n][n], Kchol_new[n][n], b0[col], Z[n], dlast[dim], * d_alpha[dim][2], d_beta[dim][2] * * if input d=NULL and lin_new=0, then the MH ratio is just a prior ratio * (plus proposal probabilities) * * return 1 if draw accepted, 0 if rejected, -1 if error */ int d_sep_draw_margin(d, n, dim, col, F, X, Z, log_det_K, lambda, Vb, K_new, Ki_new, Kchol_new, log_det_K_new, lambda_new, Vb_new, bmu_new, b0, Ti, T, tau2, nug, qRatio, pRatio_log, a0, g0, lin, itemp, state) unsigned int n, dim, col; int lin; double **F, **X, **K_new, **Ti, **T, **Vb, **Vb_new, **Ki_new, **Kchol_new; double *b0, *Z, *d, *log_det_K_new; double nug, a0, g0, lambda, tau2, log_det_K, qRatio, pRatio_log, itemp; double *lambda_new, *bmu_new; void *state; { double pd, pdlast, alpha; double *Kdiag; unsigned int m = 0; /* d could be null if d_new == d_new_eff, and in this case the acceptance ratio would be based solely on the prior (& qRatio) */ /* Knew = dist_to_K(dist, d, nugget) compute lambda, Vb, and bmu, for the NEW d */ if(!lin && d) { /* regular */ exp_corr_sep_symm(K_new, dim, X, n, d, nug, PWR); inverse_chol(K_new, Ki_new, Kchol_new, n); *log_det_K_new = log_determinant_chol(Kchol_new, n); *lambda_new = compute_lambda(Vb_new, bmu_new, n, col, F, Z, Ki_new, Ti, tau2, b0, itemp); } else if(lin) { /* linear */ *log_det_K_new = n*log(1.0 + nug); Kdiag = ones(n, 1.0 + nug); *lambda_new = compute_lambda_noK(Vb_new, bmu_new, n, col, F, Z, Ti, tau2, b0, Kdiag, itemp); free(Kdiag); } if(d || lin) { /* adjustment for BFLAT */ if(T[0][0] == 0) m = col; /* posteriors */ pd = post_margin(n,col,*lambda_new,Vb_new,*log_det_K_new,a0-m,g0,itemp); pdlast = post_margin(n,col,lambda,Vb,log_det_K,a0-m,g0,itemp); /* or, no posterior contribution */ } else { pd = 0.0; pdlast = 0.0; } /* compute acceptance prob; and accept or reject */ alpha = exp(pd - pdlast + pRatio_log)*qRatio; if(ISNAN(alpha)) return -1; if(runi(state) < alpha) return 1; else return 0; } /* * matern d_draw_margin: * * draws for d given the rest of the parameters * except b and s2 marginalized out * * F[col][n], DIST[n][n], Kchol[n][n], K_new[n][n], Ti[col][col], T[col][col] * Vb[col][col], Vb_new[col][col], Ki_new[n][n], Kchol_new[n][n] b0[col], Z[n] * * return 1 if draw accepted, 0 if rejected, -1 if error */ int matern_d_draw_margin(n, col, d, dlast, F, Z, DIST, log_det_K, lambda, Vb, K_new, Ki_new, Kchol_new, log_det_K_new, lambda_new, Vb_new, bmu_new, b0, Ti, T, tau2, nug, nu, bk, qRatio, d_alpha, d_beta, a0, g0, lin, itemp, state) unsigned int n, col; int lin; double **F, **DIST, **K_new, **Ti, **T, **Vb, **Vb_new, **Ki_new, **Kchol_new; double *b0, *Z, *bk; double d_alpha[2], d_beta[2]; double d, dlast, nug, nu, a0, g0, lambda, tau2, log_det_K, qRatio, itemp; double *lambda_new, *bmu_new, *log_det_K_new; void *state; { double pd, pdlast, alpha; double *Kdiag; unsigned int m = 0; /* check if we are sticking with linear model */ assert(dlast != 0.0); /* Knew = dist_to_K(dist, d, nugget); compute lambda, Vb, and bmu, for the NEW d */ if(! lin) { /* regular */ matern_dist_to_K_symm(K_new, DIST, d, nu, bk, nug, n); inverse_chol(K_new, Ki_new, Kchol_new, n); *log_det_K_new = log_determinant_chol(Kchol_new, n); *lambda_new = compute_lambda(Vb_new, bmu_new, n, col, F, Z, Ki_new, Ti, tau2, b0, itemp); } else { /* linear */ *log_det_K_new = n*log(1.0 + nug); Kdiag = ones(n, 1.0 + nug); *lambda_new = compute_lambda_noK(Vb_new, bmu_new, n, col, F, Z, Ti, tau2, b0, Kdiag, itemp); free(Kdiag); } if(T[0][0] == 0) m = col; /* start computation of posterior distribution */ pd = post_margin(n,col,*lambda_new,Vb_new,*log_det_K_new,a0-m,g0,itemp); pd += log_d_prior_pdf(d, d_alpha, d_beta); pdlast = post_margin(n,col,lambda,Vb,log_det_K,a0-m,g0,itemp); pdlast += log_d_prior_pdf(dlast, d_alpha, d_beta); /* compute acceptance prob */ /*alpha = exp(pd - pdlast + plin)*(q_bak/q_fwd);*/ alpha = exp(pd - pdlast)*qRatio; if(ISNAN(alpha)) return -1; if(runi(state) < alpha) return 1; else return 0; } /* * nug_draw_margin: * * draws for nug given the rest of the parameters * except b and s2 marginalized out * * F[col][n], K[n][n], Kchol[n][n], K_new[n][n], Ti[col][col], T[col][col], * Vb[col][col], Vb_new[col][col], Ki_new[n][n], Kchol_new[n][n] b0[col], Z[n] */ double nug_draw_margin(n, col, nuglast, F, Z, K, log_det_K, lambda, Vb, K_new, Ki_new, Kchol_new, log_det_K_new, lambda_new, Vb_new, bmu_new, b0, Ti, T, tau2, nug_alpha, nug_beta, a0, g0, linear, itemp, state) unsigned int n, col; int linear; double **F, **K, **K_new, **Ti, **T, **Vb, **Vb_new, **Ki_new, **Kchol_new; double *b0, *Z, *log_det_K_new; double nug_alpha[2], nug_beta[2]; double nuglast, a0, g0, lambda, tau2, log_det_K, itemp; double *lambda_new, *bmu_new; void *state; { double q_fwd, q_bak, nug, pnug, pnuglast, alpha; double *Kdiag; unsigned int i; unsigned int m = 0; /* do nothing if the prior says to fix the nug */ if(nug_alpha[0] == 0) return nuglast; /* propose new d, and compute proposal probability */ nug = nug_draw(nuglast, &q_fwd, &q_bak, state); /* new covariace matrix based on new nug */ if(linear) { *log_det_K_new = n * log(1.0 + nug); Kdiag = ones(n, 1.0 + nug); *lambda_new = compute_lambda_noK(Vb_new, bmu_new, n, col, F, Z, Ti, tau2, b0, Kdiag, itemp); free(Kdiag); } else { dup_matrix(K_new, K, n, n); for(i=0; i nug=%g : alpha=%g\n", nuglast, nug, alpha); */ if(runi(state) > alpha) { /* MYprintf(MYstderr, " -- rejected\n");*/ return nuglast; } else { /*MYprintf(MYstderr, " -- accepted\n");*/ return nug; } } /* * nug_draw_twovar: * * draws for nug given the rest of the parameters * except b and s2 marginalized out * * F[col][n], K[n][n], Kchol[n][n], K_new[n][n], Ti[col][col], T[col][col], * Vb[col][col], Vb_new[col][col], Ki_new[n][n], Kchol_new[n][n] b0[col], Z[n] */ double nug_draw_twovar(n, col, nuglast, F, Z, K, log_det_K, lambda, Vb, K_new, Ki_new, Kchol_new, log_det_K_new, lambda_new, Vb_new, bmu_new, b0, Ti, T, tau2, nug_alpha, nug_beta, a0, g0, linear, itemp, state) unsigned int n, col; int linear; double **F, **K, **K_new, **Ti, **T, **Vb, **Vb_new, **Ki_new, **Kchol_new; double *b0, *Z, *log_det_K_new; double nug_alpha[2], nug_beta[2]; double nuglast, a0, g0, lambda, tau2, log_det_K, itemp; double *lambda_new, *bmu_new; void *state; { double q_fwd, q_bak, nug, pnug, pnuglast, alpha; double *Kdiag; unsigned int i; unsigned int m = 0; /* do nothing if the prior says to fix the nug */ if(nug_alpha[0] == 0) return nuglast; /* propose new d, and compute proposal probability */ /* nug = nug_draw(nuglast, &q_fwd, &q_bak, state); */ /* MODIFIED */ nug = unif_propose_pos(nuglast+1.0, &q_fwd, &q_bak, state) - 1.0; /* new covariace matrix based on new nug */ if(linear) { /* MODIFIED */ // *log_det_K_new = n * log(1.0 + nug); *log_det_K_new = (n/2) * log(1.0) + (n/2) * log(1.0 + nug); // Kdiag = ones(n, 1.0 + nug); Kdiag = ones(n, 1.0); for(i=n/2; i nug=%g : alpha=%g\n", nuglast, nug, alpha); */ if(runi(state) > alpha) { /* MYprintf(MYstderr, " -- rejected\n");*/ return nuglast; } else { /*MYprintf(MYstderr, " -- accepted\n");*/ return nug; } } /* * mr_nug_draw_margin: * * draws for nug given the rest of the parameters * except b and s2 marginalized out * * F[col][n], K[n][n], Kchol[n][n], K_new[n][n], Ti[col][col], T[col][col], * Vb[col][col], Vb_new[col][col], Ki_new[n][n], Kchol_new[n][n] b0[col], Z[n] */ double* mr_nug_draw_margin(n, col, nug, nugfine, X, F, Z, K, log_det_K, lambda, Vb, K_new, Ki_new, Kchol_new, log_det_K_new, lambda_new, Vb_new, bmu_new, b0, Ti, T, tau2, nug_alpha, nug_beta, nugf_alpha, nugf_beta, delta, a0, g0, linear, itemp, state) unsigned int n, col; int linear; double **F, **K, **K_new, **Ti, **T, **Vb, **Vb_new, **Ki_new, **Kchol_new, **X; double *b0, *Z, *log_det_K_new; double nug_alpha[2], nug_beta[2], nugf_alpha[2], nugf_beta[2]; double nug, nugfine, a0, g0, lambda, tau2, log_det_K, delta, itemp; double *lambda_new, *bmu_new; void *state; { double q_fwd, q_bak, q_fwdf, q_bakf, pnug, pnuglast, alpha; unsigned int i; unsigned int m = 0; double* newnugs = new_vector(2); /* propose new d, and compute proposal probability */ newnugs[0] = nug_draw(nug, &q_fwd, &q_bak, state); newnugs[1] = nug_draw(nugfine, &q_fwdf, &q_bakf, state); /* new covariace matrix based on new nug */ if(linear) { double *Kdiag = new_vector(n); *log_det_K_new = 0.0; for(i=0; i alpha){ /* printf("nugs %g %g\n",nug, nugfine); */ /*printVector(newnugs, 2, MYstdout, HUMAN); */ newnugs[0] = nug; newnugs[1] = nugfine; } return newnugs; } /* * Ti_draw: * * draws for Ti given the rest of the parameters * * b0[col], s2[ch] b[ch][col], V[col][col], Ti[col][col] */ void Ti_draw(Ti, col, ch, b, bmle, b0, rho, V, s2, tau2, state) unsigned int col, ch, rho; double *b0, *s2, *tau2; double **b, **V, **Ti, **bmle; void *state; { double **sbb0, **S; double *bmb0; int i, nu /* , info*/; /* sbb0 = zeros(length(b0)); */ sbb0 = new_zero_matrix(col, col); S = new_id_matrix(col); /* for i=1:length(s2) sbb0 = sbb0 + (b(:,i)-b0) * (b(:,i)-b0)'/s2(i); end */ bmb0 = new_vector(col); for(i=0; i #include #include /* * the usual constructor function * for NODE */ LNode::LNode(void* entry) { this->entry = entry; prev = next = NULL; list = NULL; } /* * the usual destructor function * for NODE */ LNode::~LNode(void) { } /* * return the next node in the list */ LNode* LNode::Next(void) { return next; } /* * return the previous node in the list */ LNode* LNode::Prev(void) { return prev; } /* * return the data entry for the node */ void* LNode::Entry(void) { return entry; } /* ************************ * BEGIN List FUNCTIONS * ************************ */ /* * the usual constructor function * for LIST */ List::List(void) { first = last = curr = NULL; len = 0; } /* * the usual destructor function * for LIST */ List::~List(void) { curr = first; if(curr) warning("nonempty list deleted"); while(curr) { LNode* temp = curr; curr = curr->next; delete temp; } } /* * insert a new node at the beginning * of the list */ LNode* List::EnQueue(void* entry) { if(first == NULL) { assert(last == NULL); assert(len == 0); first = new LNode(entry); last = first; } else { assert(last != NULL); assert(len > 0); LNode* newnode = new LNode(entry); newnode->next = first; assert(first->prev == NULL); first->prev = newnode; first = newnode; } len++; first->list = this; return first; } /* * remove a node from the end * of the list */ void * List::DeQueue(void) { if(last == NULL) { assert(first == NULL); assert(len == 0); return NULL; } else { LNode* temp = last; if(first == last) { first = NULL; } else { assert(last->prev != NULL); last->prev->next = NULL; } last = last->prev; len--; assert(len >= 0); void* entry = temp->Entry(); temp->list = NULL; delete temp; return entry; } } /* * check if the list is empty */ bool List::isEmpty(void) { if(first == NULL) { assert(last == NULL); assert(len == 0); return true; } else { assert(last != NULL); assert(len > 0); return false; } } /* * return the length of the list */ unsigned int List::Len(void) { return len; } /* * detach and delete the node from the list */ void* List::detach_and_delete(LNode* node) { assert(node); if(node->list == NULL) { void* entry = node->Entry(); delete node; return entry; } assert(node->list == this); if(node == first) { assert(node->prev == NULL); if(node == last) { /* first and last (one node list) */ assert(node->next == NULL); first = last = NULL; } else { /* first but not last */ assert(node->next != NULL); first = node->next; node->next = NULL; first->prev = NULL; } } else if(node == last) { /* last but not first */ assert(node->next == NULL); assert(node->prev != NULL); last = node->prev; node->prev = NULL; last->next = NULL; } else { /* not last or first */ node->prev->next = node->next; node->next->prev = node->prev; node->next = NULL; node->prev = NULL; } void* entry = node->Entry(); node->list = NULL; delete node; node = NULL; len--; assert(len >= 0); return entry; } /* * return the first node in the list */ LNode* List::First(void) { return first; } tgp/src/mr_exp_sep.h0000644000176200001440000001465413531032535014157 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C ) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __MR_EXP_SEP_H__ #define __MR_EXP_SEP_H__ #include "corr.h" class MrExpSep_Prior; /* * CLASS for the implementation of the separable exponential * power family of correlation functions */ class MrExpSep : public Corr { private: double *d; /* kernel correlation width parameter */ int *b; /* dimension-wize linearization */ double *d_eff; /* dimension-wize linearization */ double *pb; /* prob of dimension-wize linearization */ unsigned int dreject; /* d rejection counter */ double delta; /* fine variance discount factor */ double nugaux; /* observation nugget for fine level proc */ public: MrExpSep(unsigned int dim, Base_Prior *base_prior); virtual Corr& operator=(const Corr &c); virtual ~MrExpSep(void); virtual void Update(unsigned int n1, unsigned int n2, double **K, double **X, double **XX); virtual void Update(unsigned int n1, double **X); virtual void Update(unsigned int n1, double **K, double **X); virtual int Draw(unsigned int n, double **F, double **X, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); virtual void Combine(Corr *c1, Corr *c2, void *state); virtual void Split(Corr *c1, Corr *c2, void *state); virtual char* State(unsigned int which); virtual unsigned int sum_b(void); virtual void ToggleLinear(void); virtual bool DrawNugs(unsigned int n, double **X, double **F, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); virtual double* Trace(unsigned int* len); virtual char** TraceNames(unsigned int* len); virtual void Init(double *dmrexpsep); virtual double* Jitter(unsigned int n1, double **X); virtual double* CorrDiag(unsigned int n1, double **X); virtual void Invert(unsigned int n); void get_delta_d(MrExpSep* c1, MrExpSep* c2, void *state); void propose_new_d(MrExpSep* c1, MrExpSep* c2, void *state); bool propose_new_d(double* d_new, int * b_new, double *pb_new, double *q_fwd, double *q_bak, void *state); virtual double log_Prior(void); void draw_d_from_prior(double *d_new, void *state); int d_draw(double *d, unsigned int n, unsigned int col, double **F, double **X, double *Z, double log_det_K, double lambda, double **Vb, double **K_new, double **Ki_new, double **Kchol_new, double *log_det_K_new, double *lambda_new, double **VB_new, double *bmu_new, double *b0, double **Ti, double **T, double tau2, double nug, double nugaux, double qRatio, double pRatio_log, double a0, double g0, int lin, double itemp, void *state); double *D(void); double Delta(void); void SetDelta(double deltanew); void SetNugaux(double nugauxnew); double CombineNugaux(MrExpSep *c1, MrExpSep *c2, void *state); double CombineDelta(MrExpSep *c1, MrExpSep *c2, void *state); void SplitNugaux(MrExpSep *c1, MrExpSep *c2, void *state); void SplitDelta(MrExpSep *c1, MrExpSep *c2, void *state); void corr_symm(double **K, unsigned int m, double **X, unsigned int n, double *d, double nug, double nugaux, double delta, double pwr); void corr_unsymm(double **K, unsigned int m, double **X1, unsigned int n1, double **X2, unsigned int n2, double *d, double delta, double pwr); bool DrawDelta(unsigned int n, double **X, double **F, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); double Nugaux(void); }; /* * CLASS for the prior parameterization of the separable * exponential power family of correlation functions */ class MrExpSep_Prior : public Corr_Prior { private: double *d; double **d_alpha; /* d gamma-mixture prior alphas */ double **d_beta; /* d gamma-mixture prior beta */ bool fix_d; /* estimate d-mixture parameters or not */ double d_alpha_lambda[2]; /* d prior alpha lambda parameter */ double d_beta_lambda[2]; /* d prior beta lambda parameter */ double delta; /* fine variance discount factor */ double *delta_alpha; double *delta_beta; double nugaux; double *nugaux_alpha; double *nugaux_beta; public: MrExpSep_Prior(unsigned int dim); MrExpSep_Prior(Corr_Prior *c); virtual ~MrExpSep_Prior(void); virtual void read_double(double *dprior); virtual void read_ctrlfile(std::ifstream* ctrlfile); virtual Corr_Prior* Dup(void); virtual void Draw(Corr **corr, unsigned int howmany, void *state); virtual Corr* newCorr(void); virtual void Print(FILE *outfile); virtual Base_Prior* BasePrior(void); virtual void SetBasePrior(Base_Prior *base_prior); virtual double log_HierPrior(void); virtual double* Trace(unsigned int* len); virtual char** TraceNames(unsigned int* len); virtual void Init(double *hier); void draw_d_from_prior(double *d_new, void *state); double* D(void); double Delta(void); double DeltaDraw(void *state); double NugauxDraw(void *state); double** DAlpha(void); double** DBeta(void); double* Delta_alpha(void); double* Delta_beta(void); void default_d_priors(void); void default_d_lambdas(void); double log_Prior(double *d, int *b, double *pb, bool linear); double log_DPrior_pdf(double *d); void DPrior_rand(double *d_new, void *state); double Nugaux(void); double* Nugaux_alpha(void); double* Nugaux_beta(void); }; #endif tgp/src/tree.cc0000644000176200001440000015367713531032535013124 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #include "R.h" extern "C" { #include "matrix.h" #include "gen_covar.h" #include "all_draws.h" #include "rand_pdf.h" #include "rand_draws.h" #include "lh.h" #include "dopt.h" #include "rhelp.h" } #include "tree.h" #include "base.h" #include "model.h" #include "params.h" #include #include #include // #define DEBUG #define CPRUNEOP TREE_OP tree_op; /* * Tree: * * the usual class constructor function */ Tree::Tree(double **X, int* p, unsigned int n, unsigned int d, double *Z, Rect *rect, Tree* parent, Model* model) { this->rect = rect; this->model = model; /* data size */ this->n = n; this->d = d; /* data storage */ this->X = X; this->p = p; XX = NULL; pp = NULL; nn = 0; this->Z = Z; /* tree pointers */ leftChild = NULL; rightChild = NULL; if(parent != NULL) depth = parent->depth+1; else depth = 0; this->parent = parent; /* changepoint (split) variables */ var = 0; val = 0; /* output file for progress printing, and printing level */ OUTFILE = model->Outfile(&verb); /* create the GP model */ Base_Prior *prior = model->get_params()->BasePrior(); base = prior->newBase(model); base->Init(NULL); } /* * Tree: * * duplication constructor function only copies information about X (not XX) * then generates XX stuff from rect, and params. Any "new" variables are * also set to NULL values -- the economy argument is passed to the base model * duplicator and meant to indicate a memory efficient copy (i.e., don't * copy the GP covariance matrices as these can be re-generated) */ Tree::Tree(const Tree *told, bool economy) { /* simple non-pointer copies */ d = told->d; n = told->n; /* tree parameters */ var = told->var; val = told->val; depth = told->depth; parent = leftChild = rightChild = next = NULL; /* things that must be NULL * because they point to other tree nodes */ XX = NULL; pp = NULL; nn = 0; /* data */ assert(told->rect); rect = new_dup_rect(told->rect); assert(told->X); X = new_dup_matrix(told->X, n, d); assert(told->Z); Z = new_dup_vector(told->Z, n); assert(told->p); p = new_dup_ivector(told->p, n); /* copy the core GP model: * must pass in the new X and Z values because they * are stored as pointers in the GP module */ /* there should be a switch statement here, or maybe I should use a copy constructor */ model = told->model; base = told->base->Dup(X, Z, economy); OUTFILE = told->OUTFILE; /* recurse down the leaves */ if(! told->isLeaf()) { leftChild = new Tree(told->leftChild, economy); rightChild = new Tree(told->rightChild, economy); } } /* * ~Tree: * * the usual class destructor function */ Tree::~Tree(void) { delete base; delete_matrix(X); if(Z) free(Z); if(XX) delete_matrix(XX); if(p) free(p); if(pp) free(pp); if(leftChild) delete leftChild; if(rightChild) delete rightChild; if(rect) delete_rect(rect); } /* * Init: * * update and compute for the base model in the tree; * the arguments represent a tree encoded as a matrix * (where the number of rows is specified as nrow) * flattened into a double vector */ void Tree::Init(double *dtree, unsigned int ncol, double **rect) { /* when no tree information is provided */ if(ncol == 0) { /* sanity checks */ assert(!dtree); assert(isLeaf()); /* prepare this leaf for the big time */ Update(); Compute(); } else { /* read the tree information */ unsigned int row = (unsigned int) dtree[0]; /* check if this should be a leaf */ if(dtree[1] < 0.0) { /* yes */ /* cut off rows, var, and val before passing to base */ base->Init(&(dtree[3])); /* make sure base model is ready to go @ this leaf */ Update(); Compute(); } else { /* not a leaf */ /* read split dim (var) */ var = (unsigned int) dtree[1]; /* calculate normd location (val) -- should made a function */ double norm = fabs(rect[1][var] - rect[0][var]); if(norm == 0) norm = fabs(rect[0][var]); if(rect[0][var] < 0) val = (dtree[2] + fabs(rect[0][var])) / norm; else val = (dtree[2] - rect[0][var]) / norm; /* create children split at (var,val) */ bool success = grow_children(); assert(success); if(success == false) MYprintf(MYstdout, "bad grow_children\n"); /* recursively read the left and right children from dtree */ unsigned int left = 1; while(((unsigned int)dtree[ncol*left]) != 2*row) left++; leftChild->Init(&(dtree[ncol*left]), ncol, rect); rightChild->Init(&(dtree[ncol*(left+1)]), ncol, rect); /* no need to Update() or Compute() on an internal node */ } } } /* * Add_XX: * * deal with the new predictive data; figuring out which XX locations * (and pp) belong in this partition, return the count of XX determined * via matrix_constrained */ unsigned int Tree::add_XX(double **X_pred, unsigned int n_pred, unsigned int d_pred) { // fprintf(MYstderr, "d_pred = %d, d = %d\n", d_pred, d); assert(d_pred == d); assert(isLeaf()); /* do not recompute XX if it has already been computed */ if(XX) { assert(pp); warning("failed add_XX in leaf"); return 0; } int *p_pred = new_ivector(n_pred); nn = matrix_constrained(p_pred, X_pred, n_pred, d, rect); XX = new_matrix(nn, d); pp = new_ivector(nn); unsigned int k=0; for(unsigned int i=0; iClear(); int *p_new = new_ivector(n_new); n = matrix_constrained(p_new, X_new, n_new, d, rect); assert(n > 0); X = new_matrix(n, d); Z = new_vector(n); p = new_ivector(n); unsigned int k=0; for(unsigned int i=0; inew_data(Xc, plen, d_new, Zc, pnew); success = part_child(GT, &Xc, &pnew, &plen, &Zc, &newRect); assert(success); /* rectangles must be equal */ if(success == false) MYprintf(MYstdout, "bad part_child\n"); delete_rect(newRect); rightChild->new_data(Xc, plen, d_new, Zc, pnew); } /* * delete_XX: * * free everything having to do with predictive locations */ void Tree::delete_XX(void) { if(XX) delete_matrix(XX); if(pp) free(pp); pp = NULL; XX = NULL; base->ClearPred(); nn = 0; } /* * predict: * * prediction based on the current parameter settings: (predictive variables * recomputed and/or initialised when appropriate) */ void Tree::Predict(double *Zp, double *Zpm, double *Zpvm, double *Zps2, double *ZZ, double *ZZm, double *ZZvm, double *ZZs2, double *Ds2x, double *Improv, double Zmin, unsigned int wZmin, bool err, void *state) { if(!n) warning("n = %d\n", n); assert(isLeaf() && n); if(Zp == NULL && nn == 0) return; /* set the partition */ if(nn > 0) base->UpdatePred(XX, nn, d, (bool) Ds2x); /* ready the storage for predictions */ double *zp, *zpm, *zpvm, *zps2, *zz, *zzm, *zzvm, *zzs2, *improv; double **ds2xy; /* allocate necessary space for predictions */ zp = zpm = zpvm = zps2 = zz = zzm = zzvm = zzs2 = NULL; if(Zp) { zp = new_vector(n); zpm = new_vector(n); zpvm = new_vector(n); zps2 = new_vector(n); } if(nn > 0) { zz = new_vector(nn); zzm = new_vector(nn); zzvm = new_vector(nn); zzs2 = new_vector(nn); } assert(zp != NULL || zz != NULL); /* allocate space for Delta-sigma */ ds2xy = NULL; if(Ds2x) ds2xy = new_matrix(nn, nn); /* allocate space for IMPROV */ improv = NULL; if(Improv) improv = new_vector(nn); /* check if the wZmin index is in p */ if(zp) { bool inp = false; for(unsigned int i=0; iPredict(n, zp, zpm, zpvm, zps2, nn, zz, zzm, zzvm, zzs2, ds2xy, improv, Zmin, err, state); /* copy data-pred stats to the right place in their respective full matrices */ if(zp) { copy_p_vector(Zp, p, zp, n); if(Zpm) copy_p_vector(Zpm, p, zpm, n); if(Zpvm) copy_p_vector(Zpvm, p, zpvm, n); if(Zps2) copy_p_vector(Zps2, p, zps2, n); free(zp); free(zpm); free(zpvm); free(zps2); } /* similarly, copy new predictive location stats */ if(zz) { copy_p_vector(ZZ, pp, zz, nn); if(ZZm) copy_p_vector(ZZm, pp, zzm, nn); if(ZZvm) copy_p_vector(ZZvm, pp, zzvm, nn); if(ZZs2) copy_p_vector(ZZs2, pp, zzs2, nn); free(zz); free(zzm); free(zzvm); free(zzs2); } /* similarly, copy ds2x predictive stats */ if(ds2xy) { for(unsigned int i=0; iClearPred(); } /* * getDepth: * * return the node's depth */ unsigned int Tree::getDepth(void) const { return depth; } /* * isLeaf: * * TRUE if the node is a leaf, * FALSE otherwise */ bool Tree::isLeaf(void) const { assert(!(leftChild != NULL && rightChild == NULL)); assert(!(leftChild == NULL && rightChild != NULL)); if(leftChild == NULL && rightChild == NULL) return true; else return false; } /* * isRoot: * * TRUE if the node is the root (parent == NULL), * FALSE otherwise */ bool Tree::isRoot(void) const { if(parent == NULL) return true; else return false; } /* * internals: * * get a list of internal (non-leaf) nodes, where the first in * list is pointed to by the first pointer, and the last by the * last pointer. The length of the list is returned. */ unsigned int Tree::internals(Tree **first, Tree **last) { if(isLeaf()) { *first = *last = NULL; return 0; } Tree *leftFirst, *leftLast, *rightFirst, *rightLast; leftFirst = leftLast = rightFirst = rightLast = NULL; int left_len = leftChild->internals(&leftFirst, &leftLast); int right_len = rightChild->internals(&rightFirst, &rightLast); if(left_len == 0) { this->next = rightFirst; *first = this; if(right_len > 0) { *last = rightLast; (*last)->next = NULL; } else { *last = this; (*last)->next = NULL; } return right_len + 1; } else { leftLast->next = rightFirst; this->next = leftFirst; *first = this; if(right_len == 0) *last = leftLast; else *last = rightLast; (*last)->next = NULL; return left_len + right_len + 1; } } /* * leaves: * * get a list of leaf nodes, where the first in list is pointed to by the * first pointer, and the last by the last pointer. The length of the list * is returned. */ unsigned int Tree::leaves(Tree **first, Tree **last) { if(isLeaf()) { *first = this; *last = this; (*last)->next = NULL; return 1; } Tree *leftFirst, *leftLast, *rightFirst, *rightLast; leftFirst = leftLast = rightFirst = rightLast = NULL; int left_len = leftChild->leaves(&leftFirst, &leftLast); int right_len = rightChild->leaves(&rightFirst, &rightLast); leftLast->next = rightFirst; *first = leftFirst; *last = rightLast; return left_len + right_len; } /* * swapable: * * get a list of swapable children , where the first in list is pointed to * by the first pointer, and the last by the last pointer. The length of * the list is returned. */ unsigned int Tree::swapable(Tree **first, Tree **last) { if(isLeaf()) return 0; int len; Tree *leftFirst, *leftLast, *rightFirst, *rightLast; leftFirst = leftLast = rightFirst = rightLast = NULL; int left_len = leftChild->swapable(&leftFirst, &leftLast); int right_len = rightChild->swapable(&rightFirst, &rightLast); if(left_len == 0) { if(right_len != 0) { *first = rightFirst; *last = rightLast; } } else if(right_len == 0) { *first = leftFirst; *last = leftLast; } else { assert(leftLast); leftLast->next = rightFirst; *first = leftFirst; *last = rightLast; } len = left_len + right_len; if(*last) (*last)->next = NULL; if(parent != NULL) { this->next = *first; *first = this; if(!(*last)) *last = this; len++; } return len; } /* * isPrunable: * * returns true if this node is prunable: * i.e., both children are leaves */ bool Tree::isPrunable(void) const { if(isLeaf()) return false; if(leftChild->isLeaf() && rightChild->isLeaf()) return true; else return false; } /* * prunable: * * get a list of prunable nodes, where the first in list is pointed to by the * first pointer, and the last by the last pointer. The length of the list is returned. */ unsigned int Tree::prunable(Tree **first, Tree **last) { if(isLeaf()) return 0; /* if this node is prunable, then add it to the list, and return */ if(isPrunable()) { *first = this; *last = this; (*last)->next = NULL; return 1; } Tree *leftFirst, *leftLast, *rightFirst, *rightLast; leftFirst = leftLast = rightFirst = rightLast = NULL; /* gather lists of prunables from leftchild and rightchild */ int left_len = leftChild->prunable(&leftFirst, &leftLast); int right_len = rightChild->prunable(&rightFirst, &rightLast); /* combine the two lists */ if(left_len == 0) { if(right_len == 0) return 0; *first = rightFirst; *last = rightLast; return right_len; } else if(right_len == 0) { *first = leftFirst; *last = leftLast; return left_len; } /* set the pointers to beginning and end of new combined list */ leftLast->next = rightFirst; *first = leftFirst; *last = rightLast; return left_len + right_len; } /* * swapData: * * swap all data between partition */ void Tree::swapData(Tree* t) { /* grab the data from the old parent */ assert(t); delete_matrix(X); X = t->X; free(p); p = t->p; delete_XX(); /*if(XX) delete_matrix(XX);*/ XX = t->XX; /*free(pp);*/ pp = t->pp; free(Z); Z = t->Z; delete_rect(rect); rect = t->rect; n = t->n; nn = t->nn; /* create the new child data */ unsigned int plen; double **Xc; Rect *newRect; double *Zc; int *pnew; FIND_OP op; if(t == rightChild) op = GT; else { assert(t == leftChild); op = LEQ; } /* create the partition */ bool success = part_child(op, &Xc, &pnew, &plen, &Zc, &newRect); assert(success); if(success == false) MYprintf(MYstdout, "bad part_child in swapData\n"); /* copy */ t->X = Xc; t->p = pnew; t->Z = Zc; t->rect = newRect; t->n = plen; /* sanity checks */ assert(n == leftChild->n + rightChild->n); assert(nn == leftChild->nn + rightChild->nn); assert(t->n == t->leftChild->n + t->rightChild->n); assert(t->nn == t->leftChild->nn + t->rightChild->nn); } /* * rotate_right: * * rotate this child to the right */ void Tree::rotate_right(void) { Tree *pt = this->parent; /* set the parent of the parent, and the root of the model */ if(pt->parent != NULL) { if(pt->parent->leftChild == pt) pt->parent->leftChild = this; else pt->parent->rightChild = this; } else { assert(model->get_TreeRoot() == pt); model->set_TreeRoot(this); } this->parent = pt->parent; /* set the children */ pt->leftChild = this->rightChild; pt->leftChild->parent = pt; this->rightChild = pt; pt->parent = this; /* take care of DEPTHS */ (pt->depth)++; (this->depth)--; (this->leftChild)->adjustDepth(-1); (pt->rightChild)->adjustDepth(1); assert(pt->depth == this->depth + 1 && pt->depth >= 0); if(this->parent) assert(this->depth == this->parent->depth + 1 && this->depth >= 0); else assert(this->depth == 0); /* take care of the DATA */ this->swapData(pt); this->Clear(); pt->Clear(); } /* * rotate_left: * * rotate this child to the left */ void Tree::rotate_left(void) { Tree *pt = this->parent; /* set the parent of the parent, and the root of the model */ if(pt->parent != NULL) { if(pt->parent->rightChild == pt) pt->parent->rightChild = this; else pt->parent->leftChild = this; } else { /* this node is the root */ assert(model->get_TreeRoot() == pt); model->set_TreeRoot(this); } this->parent = pt->parent; /* set the children */ pt->rightChild = this->leftChild; pt->rightChild->parent = pt; this->leftChild = pt; pt->parent = this; /* take care of DEPTHS */ (pt->depth)++; (this->depth)--; (this->rightChild)->adjustDepth(-1); (pt->leftChild)->adjustDepth(1); assert(pt->depth == this->depth + 1 && pt->depth >= 0); if(this->parent) assert(this->depth == this->parent->depth + 1 && this->depth >= 0); else assert(this->depth == 0); /* take care of the DATA */ this->swapData(pt); this->Clear(); pt->Clear(); } /* * rotate: * * attempt to rotate the split point of this INTERNAL node and its parent. */ bool Tree::rotate(void *state) { tree_op = ROTATE; assert(!isLeaf()); assert(parent); /* do the rotation (child becomes root, etc) */ if(parent->rightChild == this) { /* this node is a rightChild */ double alpha = pT_rotate(rightChild, parent->leftChild); if(runi(state) < alpha) rotate_left(); else return(false); } else { /* this node is a leftChild */ assert(parent->leftChild == this); double alpha = pT_rotate(leftChild, parent->rightChild); if(runi(state) < alpha) rotate_right(); else return(false); } return(true); } /* * pT_rotate: * * calculate the prior probablilty ratio for a rotate * when low and high are swapped */ double Tree::pT_rotate(Tree* low, Tree* high) { unsigned int low_ni, low_nl, high_ni, high_nl; Tree** low_i = low->internalsList(&low_ni); Tree** low_l = low->leavesList(&low_nl); Tree** high_i = high->internalsList(&high_ni); Tree** high_l = high->leavesList(&high_nl); unsigned int t_minpart, splitmin, basemax; double t_alpha, t_beta; model->get_params()->get_T_params(&t_alpha, &t_beta, &t_minpart, &splitmin, &basemax); unsigned int i; double pT_log = 0; for(i=0; idepth); for(i=0; idepth,0.0-t_beta)); for(i=0; idepth); for(i=0; idepth,0.0-t_beta)); double pTstar_log = 0; for(i=0; idepth); for(i=0; idepth,0.0-t_beta)); for(i=0; idepth); for(i=0; idepth,0.0-t_beta)); free(low_i); free(low_l); free(high_i); free(high_l); double a = exp(pTstar_log - pT_log); if(a >= 1.0) return 1.0; else return a; } /* * swap: * * attempt to swap the split point of this INTERNAL node and its parent, * while keeping parameters in the lower partitions the same. */ bool Tree::swap(void *state) { tree_op = SWAP; assert(!isLeaf()); assert(parent); if(parent->var == var) { bool success = rotate(state); if(success && verb >= 3) MYprintf(OUTFILE, "**ROTATE** @depth %d, var=%d, val=%g\n", depth, var+1, val); return success; } /* save old stuff */ double parent_val = parent->val; int parent_var = parent->var; double old_val = val; int old_var = var; Tree* oldPLC = parent->leftChild; Tree* oldPRC = parent->rightChild; /* swapped tree */ parent->val = old_val; val = parent_val; parent->var = old_var; var = parent_var; /* re-build the current child */ parent->leftChild = parent->rightChild = NULL; bool success = parent->grow_children(); assert(success); /* continue with new left and right children */ success = parent->leftChild->match(oldPLC, state); if(parent->try_revert(success, oldPLC, oldPRC, parent_var, parent_val)) { val = old_val; var = old_var; return false; } success = parent->rightChild->match(oldPRC, state); if(parent->try_revert(success, oldPLC, oldPRC, parent_var, parent_val)) { val = old_val; var = old_var; return false; } /* posterior probabilities and acceptance ratio */ assert(oldPRC->leavesN() + oldPLC->leavesN() == parent->leavesN()); double pklast = oldPRC->leavesPosterior() + oldPLC->leavesPosterior(); assert(R_FINITE(pklast)); double pk = parent->leavesPosterior(); /* alpha = min(1,exp(A)) */ double alpha = exp(pk-pklast); /* accept or reject? */ if(runi(state) < alpha) { if(verb >= 3) MYprintf(OUTFILE, "**SWAP** @depth %d: [%d,%g] <-> [%d,%g]\n", depth, var+1, val, (parent->var)+1, parent->val); if(oldPRC) delete oldPRC; if(oldPRC) delete oldPLC; return true; } else { parent->try_revert(false, oldPLC, oldPRC, parent_var, parent_val); val = old_val; var = old_var; return false; } } /* * change: * * attempt to move the split point of an INTERNAL node. * keeping parameters in the lower partitions the same. */ bool Tree::change(void *state) { tree_op = CHANGE; assert(!isLeaf()); /* Bobby: maybe add code here to prevent 0->1 proposals when there the marginal X is only binary */ /* save old tree */ double old_val = val; val = propose_val(state); Tree* oldLC = leftChild; Tree* oldRC = rightChild; leftChild = rightChild = NULL; /* new left child */ unsigned int success = grow_child(&leftChild, LEQ); if(try_revert((bool)success && leftChild->wellSized(), oldLC, oldRC, var, old_val)) return false; /* new right child */ success = grow_child(&rightChild, GT); if(try_revert((bool)success && rightChild->wellSized(), oldLC, oldRC, var, old_val)) return false; /* continue with new left and right children */ success = leftChild->match(oldLC, state); if(try_revert(success, oldLC, oldRC, var, old_val)) return false; success = rightChild->match(oldRC, state); if(try_revert(success, oldLC, oldRC, var, old_val)) return false; /* posterior probabilities and acceptance ratio */ assert(oldLC->leavesN() + oldRC->leavesN() == this->leavesN()); double pklast = oldLC->leavesPosterior() + oldRC->leavesPosterior(); #ifdef DEBUG assert(R_FINITE(pklast)); #endif double pk = leavesPosterior(); /* alpha = min(1,exp(A)) */ double alpha = exp(pk-pklast); /* accept or reject? */ if(runi(state) < alpha) { /* accept */ if(oldLC) delete oldLC; if(oldRC) delete oldRC; if(tree_op == CHANGE && verb >= 4) MYprintf(OUTFILE, "**CHANGE** @depth %d: var=%d, val=%g->%g, n=(%d,%d)\n", depth, var+1, old_val, val, leftChild->n, rightChild->n); else if(tree_op == CPRUNE && verb >= 1) MYprintf(OUTFILE, "**CPRUNE** @depth %d: var=%d, val=%g->%g, n=(%d,%d)\n", depth, var+1, old_val, val, leftChild->n, rightChild->n); return true; } else { /* reject */ try_revert(false, oldLC, oldRC, var, old_val); return false; } } /* * match: * * match the parameters of oldT with new partition * induced by THIS tree */ bool Tree::match(Tree* oldT, void *state) { assert(oldT); if(oldT->isLeaf()) { base->Match(oldT->base); return true; } else { var = oldT->var; val = oldT->val; Clear(); bool success = grow_children(); if(success) { success = leftChild->match(oldT->leftChild, state); if(!success) return false; success = rightChild->match(oldT->rightChild, state); if(!success) return false; } else { if(tree_op != CHANGE) return false; #ifdef CPRUNEOP /* growing failed because of <= MINPART, try CPRUNE */ tree_op = CPRUNE; if(!oldT->rightChild->isLeaf()) return match(oldT->rightChild, state); else if(!oldT->leftChild->isLeaf()) return match(oldT->leftChild, state); else { bool success = false; if(runi(state) > 0.5) success = match(oldT->leftChild, state); else success = match(oldT->rightChild, state); assert(success); return success; } #endif } } return true; } /* * try_revert: * * revert children and changepoint back to the way they were */ bool Tree::try_revert(bool success, Tree* oldLC, Tree* oldRC, int old_var, double old_val) { if(!success) { val = old_val; var = old_var; if(leftChild) delete leftChild; if(rightChild) delete rightChild; leftChild = oldLC; rightChild = oldRC; assert(leftChild && rightChild); return true; } else { return false; } } /* * propose_val: * * given the old var/val pair, propose a new one */ double Tree::propose_val(void *state) { double min, max; unsigned int N; double **locs = model->get_Xsplit(&N); min = R_PosInf; max = R_NegInf; for(unsigned int i=0; i val && Xivar < min) min = Xivar; else if(Xivar < val && Xivar > max) max = Xivar; } assert(val != min && val != max); if(runi(state) < 0.5) return min; else return max; } /* * leavesPosterior: * * get the posterior probability of all * leaf children of this node */ double Tree::leavesPosterior(void) { Tree *first, *last; int numLeaves = leaves(&first, &last); assert(numLeaves > 0); double p = 0; while(first) { p += first->Posterior(); if(!R_FINITE(p)) break; first = first->next; numLeaves--; } assert(numLeaves == 0); return p; } /* * MartinalLikelihood: * * check to make sure the model (e.g., GP) is up to date * -- has correct data size --, if not then Update it, * and then copute the posterior pdf */ double Tree::Posterior(void) { unsigned int basen = base->N(); if(basen == 0) { Update(); Compute(); } else assert(basen == n); return base->Posterior(); } /* * leavesN: * * get the partition sizes (n) at all * leaf children of this node */ unsigned int Tree::leavesN(void) { Tree *first, *last; int numLeaves = leaves(&first, &last); assert(numLeaves > 0); unsigned int N = 0; while(first) { N += first->n; first = first->next; numLeaves--; } assert(numLeaves == 0); return N; } /* * prune: * * attempt to remove both children of this PRUNABLE node by * randomly choosing one of its children, and then randomly * choosing the D and NUGGET parameters a single child. */ bool Tree::prune(double ratio, void *state) { tree_op = PRUNE; double logq_bak, pk, pklast, logp_split, alpha; /* sane prune ? */ assert(leftChild && leftChild->isLeaf()); assert(rightChild && rightChild->isLeaf()); /* get the marginalized posterior of the current * leaves of this PRUNABLE node*/ pklast = leavesPosterior(); #ifdef DEBUG assert(R_FINITE(pklast)); #endif /* compute the backwards split proposal probability */ logq_bak = split_prob(); /* calculate the prior probability of this split (just 1/n) */ unsigned int nsplit; model->get_Xsplit(&nsplit); logp_split = 0.0 - log((double) nsplit); /* compute corr and p(Delta_corr) for corr1 and corr2 */ base->Combine(leftChild->base, rightChild->base, state); /* update data, create covariance matrix, and compute marginal parameters */ Update(); Compute(); assert(n == leftChild->n + rightChild->n); assert(nn == leftChild->nn + rightChild->nn); /* compute posterior of new tree */ pk = this->Posterior(); /* prior ratio and acceptance ratio */ alpha = ratio*exp(logq_bak+pk-pklast-logp_split); /* accept or reject? */ if(runi(state) < alpha) { if(verb >= 1) MYprintf(OUTFILE, "**PRUNE** @depth %d: [%d,%g]\n", depth, var+1, val); delete leftChild; delete rightChild; leftChild = rightChild = NULL; base->ClearPred(); return true; } else { Clear(); return false; } } /* * grow: * * attempt to add two children to this LEAF node by randomly choosing * splitting criterion, along new d and nugget parameters */ bool Tree::grow(double ratio, void *state) { tree_op = GROW; bool success; double q_fwd, pk, pklast, logp_split, alpha; /* sane grow ? */ assert(isLeaf()); /* propose the next tree, by choosing the split point */ /* We only partition on variables > splitmin */ unsigned int mn = model->get_params()->T_smin(); var = sample_seq(mn, d-1, state); /* can't grow if this dimension does not have varying x-values */ if(rect->boundary[0][var] == rect->boundary[1][var]) return false; /* propose the split location */ val = propose_split(&q_fwd, state); /* Compute the prior for this split location (just 1/n) */ unsigned int nsplit; model->get_Xsplit(&nsplit); logp_split = 0.0 - log((double) nsplit); /* grow the children; stop if partition too small */ success = grow_children(); if(!success) return false; /* propose new correlation paramers for the new leaves */ base->Split(leftChild->base, rightChild->base, state); /* marginalized posteriors and acceptance ratio */ pk = leftChild->Posterior() + rightChild->Posterior(); pklast = this->Posterior(); alpha = ratio*exp(pk-pklast+logp_split)/q_fwd; /* MYprintf(MYstderr, "%d:%g : alpha=%g, ratio=%g, pk=%g, pklast=%g, logp_s=%g, q_fwd=%g\n", var, val, alpha, ratio, pk, pklast, logp_split, q_fwd); MYflush(MYstderr); */ /* accept or reject? */ bool ret_val = true; if(runi(state) > alpha) { delete leftChild; delete rightChild; leftChild = rightChild = NULL; ret_val = false; } else { Clear(); if(verb >= 1) MYprintf(OUTFILE, "**GROW** @depth %d: [%d,%g], n=(%d,%d)\n", depth, var+1, val, leftChild->n, rightChild->n); } return ret_val; } /* * grow_children: * * grow both left and right children based on splitpoint */ bool Tree::grow_children(void) { unsigned int suc1 = grow_child(&leftChild, LEQ); if(!suc1 || !(leftChild->wellSized())) { if(leftChild) delete leftChild; leftChild = NULL; assert(rightChild == NULL); return false; } unsigned int suc2 = grow_child(&rightChild, GT); if(!suc2 || !(rightChild->wellSized())) { delete leftChild; if(rightChild) delete rightChild; leftChild = rightChild = NULL; return false; } assert(suc1 + suc2 == n); assert(leftChild->nn + rightChild->nn == nn); return true; } /* * part_child: * * creates the data according to the current partition * the current var and val parameters, and the operation "op" */ int Tree::part_child(FIND_OP op, double ***Xc, int **pnew, unsigned int *plen, double **Zc, Rect **newRect) { unsigned int i,j; int *pchild = find_col(X, NULL, n, var, op, val, plen); if(*plen == 0) return 0; /* partition the data and predictive locations */ *Xc = new_matrix(*plen,d); *Zc = new_vector(*plen); *pnew = new_ivector(*plen); for(i=0; iboundary[0][i] = rect->boundary[0][i]; (*newRect)->boundary[1][i] = rect->boundary[1][i]; (*newRect)->opl[i] = rect->opl[i]; (*newRect)->opr[i] = rect->opr[i]; } if(op == LEQ) { (*newRect)->opr[var] = op; (*newRect)->boundary[1][var] = val; } else { (*newRect)->opl[var] = op; assert(op == GT); (*newRect)->boundary[0][var] = val; } return (*plen); } /* * grow_child: * * based on current val and var variables, create the corresponding * leftChild partition returns the number of points in the grown region */ unsigned int Tree::grow_child(Tree** child, FIND_OP op) { assert(!(*child)); /* find partition indices */ unsigned int plen; double **Xc = NULL; Rect *newRect = NULL; double *Zc = NULL; int *pnew = NULL; unsigned int success = part_child(op, &Xc, &pnew, &plen, &Zc, &newRect); if(success == 0) return success; /* grow the Child */ (*child) = new Tree(Xc, pnew, plen, d, Zc, newRect, this, model); return plen; } #ifdef DONTDOTHIS /* * val_order_probs: * * compute the discrete probability distribution over valid * changepoint locations (UNIFORM) */ void Tree::val_order_probs(double **Xo, double **probs, unsigned int var, double **rX, unsigned int rn) { unsigned int i; *Xo = new_vector(rn); *probs = new_vector(rn); for(i=0; iboundary[1][var] + rect->boundary[0][var]) / 2; /* calculate the squared distance of each rX[][var] point from the midpoint */ double *XmMid = new_vector(rn); for(unsigned int i=0; iboundary[0][var] || (*Xo)[i] >= rect->boundary[1][var]) (*probs)[i] = 0.0; else (*probs)[i] = 1.0/one2n[i]; /* calculate the cumulative probability to the left and right of midpoint */ if((*Xo)[i] < mid) sum_left += (*probs)[i]; else sum_right += (*probs)[i]; } /* normalise the probability distribution with sim_left and sum_right */ double mult; if(sum_left > 0 && sum_right > 0) mult = 0.5; else mult = 1.0; for(unsigned int i=0; iget_Xsplit(&N); val_order_probs(&Xo, &probs, var, locs, N); dsample(&val, &indx, 1, N, Xo, probs, state); *p = probs[indx]; free(Xo); free(probs); return val; } /* * split_prob: * * compute the probability of the current split point * returns the log probability */ double Tree::split_prob() { double *Xo, *probs; double p; unsigned int find_len, N; double **locs = model->get_Xsplit(&N); val_order_probs(&Xo, &probs, var, locs, N); int *indx = find(Xo, N, EQ, val, &find_len); assert(find_len >= 1 && indx[0] >= 0); p = log(probs[indx[0]]); free(Xo); free(probs); free(indx); return p; } /* * getN: * * return the number of input locations, N */ unsigned int Tree::getN(void) const { return n; } /* * getNN: * * return the number of predictive locations locations, NN */ unsigned int Tree::getNN(void) const { return nn; } /* * adjustDepth: * * auto increment or decrement the depth of * a node (and its children) by int "a" */ void Tree::adjustDepth(int a) { if(leftChild) leftChild->adjustDepth(a); if(rightChild) rightChild->adjustDepth(a); depth += a; assert(depth >= 0); } /* * swapableList: * * get an array containing the internal nodes of the tree t */ Tree** Tree::swapableList(unsigned int* len) { Tree *first, *last; first = last = NULL; *len = swapable(&first, &last); if(*len == 0) return NULL; return first->buildTreeList(*len); } /* * internalsList: * * get an array containing the internal nodes of the tree t */ Tree** Tree::internalsList(unsigned int* len) { Tree *first, *last; first = last = NULL; *len = internals(&first, &last); if(*len == 0) return NULL; return first->buildTreeList(*len); } /* * leavesList: * * get an array containing the leaves of the tree t */ Tree** Tree::leavesList(unsigned int* len) { Tree *first, *last; first = last = NULL; *len = leaves(&first, &last); if(*len == 0) return NULL; return first->buildTreeList(*len); } /* * prunableList: * * get an array containing the prunable nodes of the tree t */ Tree** Tree::prunableList(unsigned int* len) { Tree *first, *last; first = last = NULL; *len = prunable(&first, &last); if(*len == 0) return NULL; return first->buildTreeList(*len); } /* * numLeaves: * * get a count of the number of leaves in the tree t */ unsigned int Tree::numLeaves(void) { Tree *first, *last; first = last = NULL; int len = leaves(&first, &last); return len; } /* * numPrunable: * * get a count of the number of prunable nodes of the tree t */ unsigned int Tree::numPrunable(void) { Tree *first, *last; first = last = NULL; int len = prunable(&first, &last); return len; } /* * buildTreeList: * * takes a pointer to the first element of a Tree list and a * length parameter and builds an array style list */ Tree** Tree::buildTreeList(unsigned int len) { unsigned int i; Tree* first = this; Tree** list = (Tree**) malloc(sizeof(Tree*) * (len)); for(i=0; inext; } return list; } /* * PrintTree: * * print the tree out to the file in depth first order * -- the R CART tree structure format * rect and scale are for unnnormalization of split point */ void Tree::PrintTree(FILE* outfile, double** rect, double scale, int root) const { /* print the node number, followinf by or the splitting dimension */ if(isLeaf()) MYprintf(outfile, "%d \t", root); else MYprintf(outfile, "%d %d ", root, var); /* print the defiance (which is just zero since this is unused) and the variance (s2) in the partition */ MYprintf(outfile, "%d 0 %.4f ", n, base->Var()); /* don't print split information if this is a leaf, but do print the params */ if(isLeaf()) { /* skipping the split locations */ MYprintf(outfile, "\"\" \"\" 0 "); } else { /* unnormalize the val */ double vn = val / scale; vn = (rect[1][var] - rect[0][var])*vn + rect[0][var]; /* print the split locations */ MYprintf(outfile, "\"<%-5g\" \">%-5g\" ", vn, vn); /* print val again, this time in higher precision */ MYprintf(outfile, "%15f ", vn); } /* not skipping the printing of leaf (GP) paramerters */ unsigned int len; double *trace = base->Trace(&len, true); printVector(trace, len, outfile, MACHINE); if(trace) free(trace); /* process children */ if(!isLeaf()) { leftChild->PrintTree(outfile, rect, scale, 2*root); rightChild->PrintTree(outfile, rect, scale, 2*root+1); } } /* * dopt_from_XX: * * return the indices of N d-optimal draws from XX (of size nn); */ unsigned int* Tree::dopt_from_XX(unsigned int N, unsigned int iter, void *state) { assert(N <= nn); assert(XX); int *fi = new_ivector(N); double ** Xboth = new_matrix(N+n, d); // dopt(Xboth, fi, X, XX, d, n, nn, N, d, nug, iter, 0, state); dopt(Xboth, fi, X, XX, d, n, nn, N, DOPT_D(d), DOPT_NUG(), iter, 0, state); unsigned int *fi_ret = new_uivector(N); for(unsigned int i=0; i t_minp points in the partition) */ bool Tree::wellSized(void) const { /* partition must have enough data in it */ if(n <= model->get_params()->T_minp()) return false; /* don't care about the rest of the checks if the base model is constant */ if(base->Constant()) return true; /* checks to do with well defined linear and GP models */ return ((Area() > 0) /* non-zero Area or Volume */ && (!Singular())); /* non-singular design matrix */ } /* * Singular: * * return true return true iff X has a column with all * the same value or if Z has all of the same value */ bool Tree::Singular(void) const { /* first check each column of X for >=1 unique value */ assert(X); unsigned int bm = model->get_params()->T_bmax(); for(unsigned int i=0; i= d+1 unique vectors */ unsigned int UN = d+2; double **U = new_matrix(UN, bm); dupv(U[0], X[0], bm); unsigned int un = 1; /* for each row */ for(unsigned int i=1; i= UN) { if(2*UN > n) UN = n; else UN = 2*UN; U = new_bigger_matrix(U, un, bm, UN, bm); } dupv(U[un], X[i], bm); un++; } /* have we found enough unique X's */ if(un >= d+1) break; } delete_matrix(U); if(un <= d) return true; /* then check Z for >=1 unique value */ assert(Z); double f = Z[0]; unsigned int j = 0; for(j=1; jget_params()->T_bmax(); return rect_area_maxd(rect, bm); /* return rect_area(rect); */ } /* * GetRect: * * return a pointer to the rectangle associated with this partition */ Rect* Tree::GetRect(void) const { return rect; } /* * get_pp: * * return indices into the XX array */ int* Tree::get_pp(void) const { return pp; } /* * get_XX: * * return the predictive data locations: XX */ double** Tree::get_XX(void) const { return XX; } /* * get_X: * * return the data locations: X */ double** Tree::get_X(void) const { return X; } /* * get_Z: * * return the data responses: Z */ double* Tree::get_Z(void) const { return Z; } /* * cut_branch: * * cut the children (recursively) from the tree */ void Tree::cut_branch(void) { if(!isLeaf()) { assert(leftChild != NULL && rightChild != NULL); delete leftChild; delete rightChild; leftChild = rightChild = NULL; } // base->ClearPred(); base->Init(NULL); /* calls ClearPred() already */ Update(); Compute(); } /* * Outfile: * * set outfile handle */ void Tree::Outfile(FILE *file, int verb) { OUTFILE = file; this->verb = verb; if(leftChild) leftChild->Outfile(file, verb); if(rightChild) rightChild->Outfile(file, verb); } /* * Height: * * compute the height of the the tree */ unsigned int Tree::Height(void) const { if(isLeaf()) return 1; unsigned int lh = leftChild->Height(); unsigned int rh = rightChild->Height(); if(lh > rh) return 1 + lh; else return 1 + rh; } /* * Prior: * * Calculate the tree process prior, possibly * tempered. * * returns a log probability */ double Tree::Prior(double itemp) { double prior; /* get the tree process prior parameters */ double alpha, beta; unsigned int minpart, splitmin, basemax; model->get_params()->get_T_params(&alpha, &beta, &minpart, &splitmin, &basemax); if(isLeaf()) { /* probability of not growing this branch */ prior = log(1.0 - alpha*pow(1.0+depth,0.0-beta)); /* temper, in log space uselog=1 */ prior = temper(prior, itemp, 1); } else { /* probability of growing here */ prior = log(alpha) - beta*log(1.0 + depth); /* temper, in log space uselog=1 */ prior = temper(prior, itemp, 1); /* probability of the children */ prior += leftChild->Prior(itemp); prior += rightChild->Prior(itemp); } return prior; } /* * FullPosterior: * * Calculate the full posterior of (the leaves of) * the tree using the base models and the probability * of growing (or not) at internal (leaf) nodes with * process prior determined by alpha and beta * * returns a log posterior probability */ double Tree::FullPosterior(double itemp, bool tprior) { double post; /* get the tree process prior parameters */ double alpha, beta; unsigned int minpart, splitmin, basemax; model->get_params()->get_T_params(&alpha, &beta, &minpart, &splitmin, &basemax); if(isLeaf()) { /* probability of not growing this branch */ post = log(1.0 - alpha*pow(1.0+depth,0.0-beta)); /* temper, in log space uselog=1 */ if(tprior) post = temper(post, itemp, 1); /* base posterior */ post += base->FullPosterior(itemp); } else { /* probability of growing here */ post = log(alpha) - beta*log(1.0 + depth); /* temper, in log space uselog=1 */ if(tprior) post = temper(post, itemp, 1); /* probability of the children */ post += leftChild->FullPosterior(itemp, tprior); post += rightChild->FullPosterior(itemp, tprior); } return post; } /* * MarginalPosterior: * * Calculate the full (marginal) posterior of (the leaves of) * the tree using the base models and the probability * of growing (or not) at internal (leaf) nodes with * process prior determined by alpha and beta * * returns a log posterior probability * * SHOULD ADD tprior ARGUMENT! */ double Tree::MarginalPosterior(double itemp) { double post; /* get the tree process prior parameters */ double alpha, beta; unsigned int minpart, splitmin, basemax; model->get_params()->get_T_params(&alpha, &beta, &minpart, &splitmin, &basemax); if(isLeaf()) { /* probability of not growing this branch */ post = log(1.0 - alpha*pow(1.0+depth,0.0-beta)); /* probability of the base model at this leaf */ post += base->MarginalPosterior(itemp); } else { /* probability of growing here */ post = log(alpha) - beta*log(1.0 + depth); /* probability of the children */ post += leftChild->MarginalPosterior(itemp); post += rightChild->MarginalPosterior(itemp); } return post; } /* * Likelihood: * * Calculate the likelihood of (all of the leaves of) * the tree using the base models; returns the log likelihood */ double Tree::Likelihood(double itemp) { double llik; if(isLeaf()) { /* likelihood of the base model at this leaf */ //double olditemp = base->NewInvTemp(itemp, true); llik = base->Likelihood(itemp); //base->NewInvTemp(olditemp, true); } else { /* add in likelihoods of the children */ llik = leftChild->Likelihood(itemp); llik += rightChild->Likelihood(itemp); } return llik; } /* * Update: * * calls the GP function of the same name with * the data for this tree in this partition */ void Tree::Update(void) { base->Update(X, n, d, Z); } /* * Compute: * * do necessary computations the (GP) model at this * node in the tree */ void Tree::Compute(void) { assert(base); base->Compute(); } /* * State: * * return string state information from the (GP) model * at this node in the tree */ char* Tree::State(unsigned int which) { assert(base); return base->State(which); } /* * Draw: * * draw from all of the conditional posteriors of the model(s) * (e.g. GP) attached to this leaf node */ bool Tree::Draw(void *state) { assert(base); assert(isLeaf()); return base->Draw(state); } /* * Clear: * * call the model (e.g. GP) clear function */ void Tree::Clear(void) { base->Clear(); } /* * ForceLinear: * * make adjustments to toggle to the (limiting) linear * model (right now, this only makes sense for the * GP LLM) */ void Tree::ForceLinear(void) { base->ForceLinear(); } /* * ForceNonlinear: * * make adjustments to toggle to the (limiting) linear * model (right now, this only makes sense for the * GP LLM) */ void Tree::ForceNonlinear(void) { base->ForceNonlinear(); } /* * Linarea: * * get statistics from the model (e.g. GP) for calculating * the area of the domain under the LLM */ bool Tree::Linarea(unsigned int *sum_b, double *area) const { *sum_b = base->sum_b(); *area = Area(); return base->Linear(); } /* * GetBase: * * return the base model (e.g. gp) */ Base* Tree::GetBase(void) const { return base; } /* * BasePrior: * * return the prior to base model (e.g. gp) */ Base_Prior* Tree::GetBasePrior(void) const { return base->Prior(); } /* * TraceNames: * * prints the names of the traces recorded in Tree::Trace() * without "index" (i.e., basically return base->TraceNames()) */ char** Tree::TraceNames(unsigned int *len, bool full) { return base->TraceNames(len, full); } /* * Trace: * * gathers trace statistics from the Base model * and writes them out to the specified file */ void Tree::Trace(unsigned int index, FILE* XXTRACEFILE) { double *trace; unsigned int len; /* sanity checks */ assert(XXTRACEFILE); if(!pp) return; /* get the trace */ trace = base->Trace(&len, false); /* write to the XX trace file */ for(unsigned int i=0; iNewInvTemp(itemp, true); else { base->NewInvTemp(itemp, false); rightChild->NewInvTemp(itemp); leftChild->NewInvTemp(itemp); } } /* * Distance: * * returns, via d1 and d2, two distance measures between pairs * of XX locations: d1 gives the number of nodes in the tree * along the shortest path; d2 sums the distances to the partition * boundary along that path, with any nodes in the same region * having distance zero */ void Tree::Distance(double **XX, int *p, const unsigned int plen, double **d1, double *h, double **d2, double *ad) { if(isLeaf()) { for(unsigned int i=0; iDistance(XX, pl, pllen, d1, h, d2, ad); rightChild->Distance(XX, pr, prlen, d1, h, d2, ad); /* accumulate distance to boundary as we recurse back up */ for(unsigned int i=0; i #include #include /* #define DEBUG */ /* * get_data_rect: * * compute and return the rectangle implied by the X data */ double **get_data_rect(double **X, unsigned int N, unsigned int d) { unsigned int i,j; double ** rect = new_matrix(2, d); for(i=0; i rect[1][i]) rect[1][i] = X[j][i]; } } return(rect); } /* * replace matrix with zeros */ void zero(double **M, unsigned int n1, unsigned int n2) { unsigned int i, j; for(i=0; i= n1); assert(n2_new >= n2); if(n1_new <= 0 || n2_new <= 0) { assert(M == NULL); return NULL; } if(M == NULL) { assert(n1 == 0 || n2 == 0); return new_zero_matrix(n1_new, n2_new); } if(n2 == n2_new) { m = (double**) malloc(sizeof(double*) * n1_new); assert(m); m[0] = realloc(M[0], sizeof(double) * n1_new * n2_new); free(M); assert(m[0]); for(i=1; i= n1); assert(n2_new >= n2); if(n1_new <= 0 || n2_new <= 0) { assert(M == NULL); return NULL; } if(M == NULL) { assert(n1 == 0 || n2 == 0); return new_zero_imatrix(n1_new, n2_new); } if(n2 == n2_new) { m = (int**) malloc(sizeof(int*) * n1_new); assert(m); m[0] = realloc(M[0], sizeof(int) * n1_new * n2_new); free(M); assert(m[0]); for(i=1; i 0 && col > 0) assert(M); for(i=0; i 0 && col > 0) assert(M); for(i=0; i 0 && col > 0) assert(M); for(i=0; i 0 && n2 > 0); assert(M1 && M2); for(i=0; i 0 && n2 > 0); for(i=0; i 0) s[i] = f(M[0][i]); else s[i] = 0; for(j=1; jx < bb->x) return -1; else return 1; } /* * calculate the quantiles of v[1:n] specified in q[1:m], and store them * in qs[1:m]; If non-null weights, then use the sorting method; assume * that the weights are NORMALIZED, it is also assumed that the q[1:m] * is specified in increasing order */ void quantiles(double *qs, double *q, unsigned int m, double *v, double *w, unsigned int n) { unsigned int i, k, j; double wsum; Wsamp **wsamp; /* create and fill pointers to weighted sample structures */ if(w != NULL) { wsamp = (Wsamp**) malloc(sizeof(struct wsamp*) * n); for(i=0; iw = w[i]; wsamp[i]->x = v[i]; } /* sort by v; and implicity report the associated weights w */ qsort((void*)wsamp, n, sizeof(Wsamp*), compareWsamp); } else wsamp = NULL; /* for each quantile in q */ wsum = 0.0; for(i=0, j=0; j 0 && q[j] <1); /* find the (non-weighted) quantile using select */ if(w == NULL) { /* calculate the index-position of the quantile */ k = (unsigned int) n*q[j]; qs[j] = quick_select(v, n, k); } else { /* else using sorting method */ /* check to make sure the qs are ordered */ assert(wsamp); if(j > 0) assert(q[j] > q[j-1]); /* find the next quantile in the q-array */ for(; i 0 && wsum >= q[j]) { qs[j] = wsamp[i-1]->x; break; } /* increment with the next weight */ wsum += wsamp[i]->w; /* see if we've found the next quantile */ if(wsum >= q[j]) { qs[j] = wsamp[i]->x; break; } } /* check to make sure we actually had founda quantile */ if(i == n) warning("unable to find quanile q[%d]=%g", j, q[j]); } } /* clean up */ if(w) { assert(wsamp); for(i=0; i to); n = (unsigned int) (from - to) + 1; by = -1; } if(n == 0) return NULL; s = new_ivector(n); s[0] = from; for(i=1; i) EQ(==) LEQ(<=) GEQ(>=) NE(!=) */ int* find(double *V, unsigned int n, FIND_OP op, double val, unsigned int* len) { unsigned int i,j; int *tf; int *found; tf = new_ivector(n); (*len) = 0; switch (op) { case GT: for(i=0; i val) tf[i] = 1; else tf[i] = 0; if(tf[i] == 1) (*len)++; } break; case GEQ: for(i=0; i= val) tf[i] = 1; else tf[i] = 0; if(tf[i] == 1) (*len)++; } break; case EQ: for(i=0; i) * EQ(==) LEQ(<=) GEQ(>=) NE(!=) */ int* find_col(double **V, int *pv, unsigned int n, unsigned int var, FIND_OP op, double val, unsigned int* len) { unsigned int i,j; int *tf, *p; int *found; tf = new_ivector(n); if(pv) p = pv; else p = iseq(0,n-1); (*len) = 0; switch (op) { case GT: for(i=0; i val) tf[i] = 1; else tf[i] = 0; if(tf[i] == 1) (*len)++; } break; case GEQ: for(i=0; i= val) tf[i] = 1; else tf[i] = 0; if(tf[i] == 1) (*len)++; } break; case EQ: for(i=0; i= low && k <= high); for (;;) { if (high <= low) /* One element only */ return arr[k] ; if (high == low + 1) { /* Two elements only */ if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ; return arr[k] ; } /* Find kth of low, middle and high items; swap into position low */ middle = (low + high) / 2; if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ; if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ; if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ; /* Swap low item (now in position middle) into position (low+1) */ ELEM_SWAP(arr[middle], arr[low+1]) ; /* Nibble from each end towards middle, swapping items when stuck */ ll = low + 1; hh = high; for (;;) { do ll++; while (arr[low] > arr[ll]) ; do hh--; while (arr[hh] > arr[low]) ; if (hh < ll) break; ELEM_SWAP(arr[ll], arr[hh]) ; } /* Swap middle item (in position low) back into correct position */ ELEM_SWAP(arr[low], arr[hh]) ; /* Re-set active partition */ if (hh <= k) low = ll; if (hh >= k) high = hh - 1; } } /* * same as the quick_select algorithm above, but less * efficient. Not currently used in tgp */ double kth_smallest(double a[], int n, int k) { int i,j,l,m ; double x ; l=0 ; m=n-1 ; while (l= lenp * and ncol(v) >= max(p) */ void sub_p_matrix(double **V, int *p, double **v, unsigned int nrows, unsigned int lenp, unsigned int col_offset) { int i,j; assert(V); assert(p); assert(v); assert(nrows > 0 && lenp > 0); for(i=0; i= ncols * and ncol(v) >= max(p) */ double **new_p_submatrix(int *p, double **v, unsigned int nrows, unsigned int ncols, unsigned int col_offset) { double **V; if(nrows == 0 || ncols+col_offset == 0) return NULL; V = new_matrix(nrows, ncols + col_offset); if(ncols > 0) sub_p_matrix(V, p, v, nrows, ncols, col_offset); return(V); } /* * sub_p_matrix_rows: * * copy the rows v[1:n1][p[n2]] to V. * must have ncol(v) == ncol(V) and nrow(V) >= lenp * and nrow(v) >= max(p) */ void sub_p_matrix_rows(double **V, int *p, double **v, unsigned int ncols, unsigned int lenp, unsigned int row_offset) { int i; assert(V); assert(p); assert(v); assert(ncols > 0 && lenp > 0); for(i=0; i= nrows * and nrow(v) >= max(p) */ double **new_p_submatrix_rows(int *p, double **v, unsigned int nrows, unsigned int ncols, unsigned int row_offset) { double **V; if(nrows+row_offset == 0 || ncols == 0) return NULL; V = new_matrix(nrows + row_offset, ncols); if(nrows > 0) sub_p_matrix_rows(V, p, v, ncols, nrows, row_offset); return(V); } /* * copy_p_matrix: * * copy v[n1][n2] to V into the positions specified by p1[n1] and p2[n2] */ void copy_p_matrix(double **V, int *p1, int *p2, double **v, unsigned int n1, unsigned int n2) { int i,j; assert(V); assert(p1); assert(p2); assert(n1 > 0 && n2 > 0); for(i=0; i q2[i] || mean[i] < q1[i]) { MYprintf(MYstdout, "replacing %g with (%g,%g,%g)\n", mean[i], q1[i], median[i], q2[i]); mean[i] = median[i]; replace++; } } /* let us know what happened */ if(replace > 0) MYprintf(MYstdout, "NOTICE: %d predictive means replaced with medians\n", replace); } /* * pass back the indices (through p) into the matrix X which lie * within the boundaries described by rect; return the number of true * indices. X is treated as n1 x n2, and p is an n1 (preallocated) * array */ unsigned int matrix_constrained(int *p, double **X, unsigned int n1, unsigned int n2, Rect *rect) { unsigned int i,j, count; count = 0; /* printRect(MYstderr, rect->d, rect->boundary); */ for(i=0; iopl[j] == GT) { assert(rect->opr[j] == LEQ); p[i] = (int) (X[i][j] > rect->boundary[0][j] && X[i][j] <= rect->boundary[1][j]); } else if(rect->opl[j] == GEQ) { if(rect->opr[j] == LEQ) p[i] = (int) (X[i][j] >= rect->boundary[0][j] && X[i][j] <= rect->boundary[1][j]); else if(rect->opr[j] == LT) p[i] = (int) (X[i][j] >= rect->boundary[0][j] && X[i][j] < rect->boundary[1][j]); else assert(0); } else assert(0); if(p[i] == 0) break; } if(p[i] == 1) count++; } return count; } /* * create a new rectangle structure without any of the fields filled * in */ Rect* new_rect(unsigned int d) { Rect* rect = (Rect*) malloc(sizeof(struct rect)); rect->d = d; rect->boundary = new_matrix(2, d); rect->opl = (FIND_OP *) malloc(sizeof(FIND_OP) * d); rect->opr = (FIND_OP *) malloc(sizeof(FIND_OP) * d); return rect; } /* * create a new rectangle structure with the boundary populated * by the contents of a double array */ Rect* new_drect(double **drect, int d) { unsigned int i; Rect *rect = new_rect(d); for(i=0; iboundary[0][i] = drect[0][i]; rect->boundary[1][i] = drect[1][i]; rect->opl[i] = GEQ; rect->opr[i] = LEQ; } return rect; } /* * return a pointer to a duplicated rectangle structure */ Rect* new_dup_rect(Rect* oldR) { unsigned int i; Rect* rect = (Rect*) malloc(sizeof(struct rect)); rect->d = oldR->d; rect->boundary = new_dup_matrix(oldR->boundary, 2, oldR->d); rect->opl = (FIND_OP *) malloc(sizeof(FIND_OP) * rect->d); rect->opr = (FIND_OP *) malloc(sizeof(FIND_OP) * rect->d); for(i=0; id; i++) { rect->opl[i] = oldR->opl[i]; rect->opr[i] = oldR->opr[i]; } return rect; } /* * calculate and return the area depicted by * the rectangle boundaries */ double rect_area(Rect* rect) { unsigned int i; double area; area = 1.0; for(i=0; id; i++) area *= rect->boundary[1][i] - rect->boundary[0][i]; return area; } /* * calculate and return the area depicted by * the rectangle boundaries, using only dimensions 0,...,maxd-1 */ double rect_area_maxd(Rect* rect, unsigned int maxd) { unsigned int i; double area; assert(maxd <= rect->d); area = 1.0; for(i=0; iboundary[1][i] - rect->boundary[0][i]; return area; } /* * print a rectangle structure out to * the file denoted by "outfile" */ void print_rect(Rect *r, FILE* outfile) { unsigned int i; MYprintf(outfile, "# %d dim rect (area=%g) with boundary:\n", r->d, rect_area(r)); printMatrix(r->boundary, 2, r->d, outfile); MYprintf(outfile, "# opl and opr\n"); for(i=0; id; i++) MYprintf(outfile, "%d ", r->opl[i]); MYprintf(outfile, "\n"); for(i=0; id; i++) MYprintf(outfile, "%d ", r->opr[i]); MYprintf(outfile, "\n"); } /* * free the memory associated with a * rectangle structure */ void delete_rect(Rect *rect) { delete_matrix(rect->boundary); free(rect->opl); free(rect->opr); free(rect); } /* * make it so that the data lives in * [0,1]^d. */ void normalize(double **X, double **rect, int N, int d, double normscale) { int i, j; double norm; if(N == 0) return; assert(d != 0); for(i=0; i=0 && X[j][i] <= normscale)) MYprintf(MYstdout, "X[%d][%d] = %g, normscale = %g\n", j, i, X[j][i], normscale); assert(X[j][i] >=0 && X[j][i] <= normscale); */ } } } /* * put Rect r on the scale of double rect * r should be form 0 to NORMSCALE */ void rect_unnorm(Rect* r, double **rect, double normscale) { int i; double norm; for(i=0; id; i++) { assert(r->boundary[0][i] >= 0 && r->boundary[1][i] <= normscale); norm = fabs(rect[1][i] - rect[0][i]); if(norm == 0) norm = fabs(rect[0][i]); r->boundary[1][i] = normscale * r->boundary[1][i]; r->boundary[0][i] = rect[0][i] + norm * r->boundary[0][i]; r->boundary[1][i] = rect[1][i] - norm * (1.0 - r->boundary[1][i]); } } /* * allocates a new double array of size n1 */ double* new_vector(unsigned int n) { double *v; if(n == 0) return NULL; v = (double*) malloc(sizeof(double) * n); return v; } /* * allocates a new double array of size n1 * and fills it with zeros */ double* new_zero_vector(unsigned int n) { double *v; v = new_vector(n); zerov(v, n); return v; } /* * allocates a new double array of size n1 * and fills it with the contents of vold */ double* new_dup_vector(double* vold, unsigned int n) { double *v; v = new_vector(n); dupv(v, vold, n); return v; } /* * copies vold to v * (assumes v has already been allcocated) */ void dupv(double *v, double* vold, unsigned int n) { unsigned int i; for(i=0; i 0); for(i=0; i 0); for(i=0; i 0); assert(v1 && v2); add_matrix(a, &v1, b, &v2, 1, n); } /* * add two integer vectors of the same size * v1 = v1 + v2 */ void add_ivector(int *v1, int *v2, unsigned int n) { unsigned int i; if(n == 0) return; assert(n > 0); assert(v1 && v2); for(i=0; i max) { max = v[i]; *which = i; } } return max; } /* * new vector of integers of length n */ int *new_ivector(unsigned int n) { int *iv; if(n == 0) return NULL; iv = (int*) malloc(sizeof(int) * n); assert(iv); return iv; } /* * duplicate the integer contents of iv of length n into the already * allocated vector iv_new, also of length n */ void dupiv(int *iv_new, int *iv, unsigned int n) { unsigned int i; if(n > 0) assert(iv && iv_new); for(i=0; i 0) assert(iv); for(i=0; i 0); for(i=0; i 0); for(i=0; i= b) return a; else return b; } /* * MYfmin: * * seems like some systems are missing the prototype * for the fmin function which should be in math.h -- * so I wrote my own */ double MYfmin(double a, double b) { if(a <= b) return a; else return b; } /* * vmult: * * returns the product of its arguments */ double vmult(double *v1, double *v2, int n) { double v = 0.0; int i; for(i=0; i class Twovar_Prior; /* * CLASS for the implementation of the exponential * power family of correlation functions */ class Twovar : public Corr { private: double d; /* kernel correlation width parameter */ double **xDISTx; /* n x n, matrix of euclidean distances to the x spatial locations */ unsigned int nd; /* for keeping track of the current size of xDISTx (nd x nd) */ unsigned int dreject; /* d rejection counter */ public: Twovar(unsigned int dim, Base_Prior *base_prior); virtual Corr& operator=(const Corr &c); virtual ~Twovar(void); virtual void Update(unsigned int n1, unsigned int n2, double **K, double **X, double **XX); virtual void Update(unsigned int n1, double **X); virtual void Update(unsigned int n1, double **K, double **X); virtual int Draw(unsigned int n, double **F, double **X, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); virtual void Combine(Corr *c1, Corr *c2, void *state); virtual void Split(Corr *c1, Corr *c2, void *state); virtual char* State(unsigned int which); virtual double log_Prior(void); virtual unsigned int sum_b(void); virtual void ToggleLinear(void); virtual bool DrawNugs(unsigned int n, double **X, double **F, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); virtual double* Trace(unsigned int* len); virtual char** TraceNames(unsigned int* len); virtual void Init(double *dexp); virtual double* Jitter(unsigned int n1, double **X); virtual double* CorrDiag(unsigned int n1, double **X); virtual void Invert(unsigned int n); void get_delta_d(Twovar* c1, Twovar* c2, void *state); void propose_new_d(Twovar* c1, Twovar* c2, void *state); double D(void); }; /* * CLASS for the prior parameterization of exponential * power family of correlation functions */ class Twovar_Prior : public Corr_Prior { private: double d; double d_alpha[2]; /* d gamma-mixture prior alphas */ double d_beta[2]; /* d gamma-mixture prior beta */ bool fix_d; /* estimate d-mixture parameters or not */ double d_alpha_lambda[2]; /* d prior alpha lambda parameter */ double d_beta_lambda[2]; /* d prior beta lambda parameter */ public: Twovar_Prior(unsigned int dim); Twovar_Prior(Corr_Prior *c); virtual ~Twovar_Prior(void); virtual void read_double(double *dprior); virtual void read_ctrlfile(std::ifstream* ctrlfile); virtual void Draw(Corr **corr, unsigned int howmany, void *state); virtual Corr_Prior* Dup(void); virtual Corr* newCorr(void); virtual void Print(FILE *outfile); virtual Base_Prior* BasePrior(void); virtual void SetBasePrior(Base_Prior *base_prior); virtual double log_HierPrior(void); virtual double* Trace(unsigned int* len); virtual char** TraceNames(unsigned int* len); virtual void Init(double *dhier); double D(void); double* DAlpha(void); double* DBeta(void); void default_d_priors(void); void default_d_lambdas(void); double log_Prior(double d, bool linear); double log_NugPrior(double nug); bool LinearRand(double d, void *state); }; #endif tgp/src/rhelp.c0000644000176200001440000000633213531032535013115 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #include "rhelp.h" #ifdef RPRINT #include #include FILE *MYstdout = (FILE*) 0; FILE *MYstderr = (FILE*) 1; #endif #include #include #include /* * MYprintf: * * a function many different types of printing-- in particular, using * the Rprintf if the code happens to be compiled with RPRINT, * othersie fprintf (takes the same arguments as fprintf) */ void MYprintf(FILE *outfile, const char *str, ...) { va_list argp; va_start(argp, str); #ifdef RPRINT if(outfile == MYstdout) Rvprintf(str, argp); else if(outfile == MYstderr) REvprintf(str, argp); else vfprintf(outfile, str, argp); #else vfprintf(outfile, str, argp); #endif va_end(argp); } #ifndef RPRINT /* * error: * * printf style function that reports errors to stderr */ void error(const char *str, ...) { va_list argp; va_start(argp, str); MYprintf(stderr, "ERROR: "); vfprintf(stderr, str, argp); va_end(argp); MYflush(stderr); /* add a final newline */ MYprintf(stderr, "\n"); /* kill the code */ assert(0); } /* * warning: * * printf style function that reports warnings to stderr */ void warning(const char *str, ...) { va_list argp; va_start(argp, str); MYprintf(stderr, "WARNING: "); vfprintf(stderr, str, argp); va_end(argp); MYflush(stderr); /* add a final newline */ MYprintf(stderr, "\n"); } #endif /* * MYflush: * * a function for many different types of flushing-- in particular, * using * the R_FlushConsole the code happens to be compiled with * RPRINT, otherwise fflush */ void MYflush(FILE *outfile) { #ifdef RPRINT R_FlushConsole(); #else fflush(outfile); #endif } /* * MY_r_process_events: * * at least every 1 second(s) pass control back to * R so that it can check for interrupts and/or * process other R-gui events */ time_t MY_r_process_events(time_t itime) { #ifdef RPRINT time_t ntime = time(NULL); if(ntime - itime > 1) { R_FlushConsole(); R_CheckUserInterrupt(); #if (defined(HAVE_AQUA) || defined(Win32) || defined(Win64)) R_ProcessEvents(); #endif itime = ntime; } #endif return itime; } tgp/src/all_draws.h0000644000176200001440000002001213531032535013747 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __ALL_DRAWS_H__ #define __ALL_DRAWS_H__ #define ALPHAMIN 0.1 #define NUGMIN 1e-10 unsigned int beta_draw_margin(double *b, unsigned int col, double **Vb, double *bmu, double s2, void *state); double sigma2_draw_no_b_margin(unsigned int n, unsigned int col, double lambda, double alpha0, double beta0, void *state); double compute_lambda_noK(double** Vb, double*b, unsigned int n, unsigned int col, double **F, double *Z, double **Ti, double tau2, double *b0, double* Kdiag, double itemp); double compute_lambda(double** Vb, double*b, unsigned int n, unsigned int col, double **F, double *Z, double **Ki, double **Ti, double tau2, double *b0, double itemp); void compute_b_and_Vb(double **Vb, double *b, double *by, double *TiB0, unsigned int n, unsigned int col, double **F, double *Z, double **Ki, double **Ti, double tau2, double *b0, double itemp); void compute_b_and_Vb_noK(double **Vb, double *b, double *by, double *TiB0, unsigned int n, unsigned int col, double **F, double *Z, double **Ti, double tau2, double *b0, double *Kdiag, double itemp); void Ti_draw(double **Ti, unsigned int col, unsigned int ch, double **b, double **bmle, double *b0, unsigned int rho, double **V, double *s2, double *tau2, void *state); void b0_draw(double *b0, unsigned int col, unsigned int ch, double **b, double *s2, double **Ti, double *tau2, double *mu, double **Ci, void *state); double gamma_mixture_pdf(double d, double *alpha, double *beta); double log_d_prior_pdf(double d, double *alpha, double *beta); double d_prior_rand(double *alpha, double *beta, void *state); double log_nug_prior_pdf(double nug, double *alpha, double *beta); double nug_prior_rand(double *alpha, double *beta, void *state); double gamma_mixture_rand(double *alpha, double *beta, void *state); void mixture_priors_draw(double *alpha, double *beta, double *d, unsigned int n, double *alpha_lambda, double *beta_lambda, void *state); void d_proposal(unsigned int n, int *p, double *d, double *dold, double *q_fwd, double *q_bak, void *state); double unif_propose_pos(double last, double *q_fwd, double *q_bak, void *state); double nug_draw(double last, double *q_fwd, double *q_bak, void *state); double mixture_priors_ratio(double *alpha_new, double* alpha, double *beta_new, double *beta, double *d, unsigned int n, double *alpha_lambda, double *beta_lambda); int d_draw_margin(unsigned int n, unsigned int col, double d, double dlast, double **F, double *Z, double **DIST, double log_det_K, double lambda, double **Vb, double **K_new, double **Ki_new, double **Kchol_new, double *log_det_K_new, double *lambda_new, double **VB_new, double *bmu_new, double *b0, double **Ti, double **T, double tau2, double nug, double pRatio, double *d_alpha, double *d_beta, double a0, double g0, int lin, double itemp, void *state); int d_sep_draw_margin(double *d, unsigned int n, unsigned int dim, unsigned int col, double **F, double **X, double *Z, double log_det_K, double lambda, double **Vb, double **K_new, double **Ki_new, double **Kchol_new, double *log_det_K_new, double *lambda_new, double **VB_new, double *bmu_new, double *b0, double **Ti, double **T, double tau2, double nug, double qRatio, double pRatio_log, double a0, double g0, int lin, double itemp, void *state); int d_sim_draw_margin(double *d, unsigned int n, unsigned int dim, unsigned int col, double **F, double **X, double *Z, double log_det_K, double lambda, double **Vb, double **K_new, double **Ki_new, double **Kchol_new, double *log_det_K_new, double *lambda_new, double **VB_new, double *bmu_new, double *b0, double **Ti, double **T, double tau2, double nug, double qRatio, double pRatio_log, double a0, double g0, double itemp, void *state); int matern_d_draw_margin(unsigned int n, unsigned int col, double d, double dlast, double **F, double *Z, double **DIST, double log_det_K, double lambda, double **Vb, double **K_new, double **Ki_new, double **Kchol_new, double *log_det_K_new, double *lambda_new, double **VB_new, double *bmu_new, double *b0, double **Ti, double **T, double tau2, double nug, double nu, double *bk, double pRatio, double *d_alpha, double *d_beta, double a0, double g0, int lin, double itemp, void *state); double nug_draw_margin(unsigned int n, unsigned int col, double nuglast, double **F, double *Z, double **K, double log_det_K, double lambda, double **Vb, double **K_new, double **Ki_new, double **Kchol_new, double *log_det_K_new, double *lambda_new, double **VB_new, double *bmu_new, double *b0, double **Ti, double **T, double tau2, double *nug_alpha, double *nug_beta, double a0, double g0, int linear, double itemp, void *state); double nug_draw_twovar(unsigned int n, unsigned int col, double nuglast, double **F, double *Z, double **K, double log_det_K, double lambda, double **Vb, double **K_new, double **Ki_new, double **Kchol_new, double *log_det_K_new, double *lambda_new, double **VB_new, double *bmu_new, double *b0, double **Ti, double **T, double tau2, double *nug_alpha, double *nug_beta, double a0, double g0, int linear, double itemp, void *state); double* mr_nug_draw_margin(unsigned int n, unsigned int col, double nug, double nugfine, double **X, double **F, double *Z, double **K, double log_det_K, double lambda, double **Vb, double **K_new, double **Ki_new, double **Kchol_new, double *log_det_K_new, double *lambda_new, double **VB_new, double *bmu_new, double *b0, double **Ti, double **T, double tau2, double *nug_alpha, double *nug_beta, double *nugf_alpha, double *nugf_beta, double delta, double a0, double g0, int linear, double itemp, void *state); void sigma2_prior_draw(double *a0, double *g0, double *s2, unsigned int nl, double a0_lambda, double g0_lambda, unsigned int *n, void *state); double tau2_draw(unsigned int col, double **Ti, double s2, double *b, double *b0, double alpha0, double beta0, void *state); double linear_pdf(double *d, unsigned int n, double *gamlin); double linear_pdf_sep(double *pb, double *d, unsigned int n, double *gamlin); int linear_rand(double *d, unsigned int n, double *gamlin, void *state); int linear_rand_sep(int *b, double *pb, double *d, unsigned int n, double *gamlin, void *state); void mle_beta(double *mle, unsigned int n, unsigned int col, double **F, double *Z); double mixture_hier_prior_log(double *alpha, double *beta, double *beta_lambda, double *alpha_lambda); double hier_prior_log(double alpha, double beta, double beta_lambda, double alpha_lambda); double tau2_prior_rand(double alpha, double beta, void *state); double log_tau2_prior_pdf(double tau2, double alpha, double beta); #endif tgp/src/exp_sep.h0000644000176200001440000001076413531032535013457 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __EXP_SEP_H__ #define __EXP_SEP_H__ #include "corr.h" class ExpSep_Prior; /* * CLASS for the implementation of the separable exponentia * power family of correlation functions */ class ExpSep : public Corr { private: double *d; /* kernel correlation width parameter */ int *b; /* dimension-wize linearization */ double *d_eff; /* dimension-wize linearization */ double *pb; /* prob of dimension-wize linearization */ unsigned int dreject; /* d rejection counter */ public: ExpSep(unsigned int dim, Base_Prior *base_prior); virtual Corr& operator=(const Corr &c); virtual ~ExpSep(void); virtual void Update(unsigned int n1, unsigned int n2, double **K, double **X, double **XX); virtual void Update(unsigned int n1, double **X); virtual void Update(unsigned int n1, double **K, double **X); virtual int Draw(unsigned int n, double **F, double **X, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); virtual void Combine(Corr *c1, Corr *c2, void *state); virtual void Split(Corr *c1, Corr *c2, void *state); virtual char* State(unsigned int which); virtual unsigned int sum_b(void); virtual void ToggleLinear(void); virtual bool DrawNugs(unsigned int n, double **X, double **F, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state); virtual double* Trace(unsigned int* len); virtual char** TraceNames(unsigned int* len); virtual void Init(double *dexpsep); virtual double* Jitter(unsigned int n1, double **X); virtual double* CorrDiag(unsigned int n1, double **X); virtual void Invert(unsigned int n); void get_delta_d(ExpSep* c1, ExpSep* c2, void *state); void propose_new_d(ExpSep* c1, ExpSep* c2, void *state); bool propose_new_d(double* d_new, int * b_new, double *pb_new, double *q_fwd, double *q_bak, void *state); virtual double log_Prior(void); void draw_d_from_prior(double *d_new, void *state); double *D(void); }; /* * CLASS for the prior parameterization of the separable * exponential power family of correlation functions */ class ExpSep_Prior : public Corr_Prior { private: double *d; double **d_alpha; /* d gamma-mixture prior alphas */ double **d_beta; /* d gamma-mixture prior beta */ bool fix_d; /* estimate d-mixture parameters or not */ double d_alpha_lambda[2]; /* d prior alpha lambda parameter */ double d_beta_lambda[2]; /* d prior beta lambda parameter */ public: ExpSep_Prior(unsigned int dim); ExpSep_Prior(Corr_Prior *c); virtual ~ExpSep_Prior(void); virtual void read_double(double *dprior); virtual void read_ctrlfile(std::ifstream* ctrlfile); virtual Corr_Prior* Dup(void); virtual void Draw(Corr **corr, unsigned int howmany, void *state); virtual Corr* newCorr(void); virtual void Print(FILE *outfile); virtual Base_Prior* BasePrior(void); virtual void SetBasePrior(Base_Prior *base_prior); virtual double log_HierPrior(void); virtual double* Trace(unsigned int* len); virtual char** TraceNames(unsigned int* len); virtual void Init(double *dhier); void draw_d_from_prior(double *d_new, void *state); double* D(void); double** DAlpha(void); double** DBeta(void); void default_d_priors(void); void default_d_lambdas(void); double log_Prior(double *d, int *b, double *pb, bool linear); double log_DPrior_pdf(double *d); void DPrior_rand(double *d_new, void *state); }; #endif tgp/src/gen_covar.c0000644000176200001440000003102413531032535013742 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #include #include #include #include #include #include "matrix.h" #include "linalg.h" #include "gen_covar.h" #include "rhelp.h" /* #define THRESH 0.5 */ /* * dist_symm: * * compute distance matrix all matices must be alloc'd * pwr is 1 (abs) or 2, anything else defaults to 1 (abs) * SYMMETRIC * * X[n][m], DIST[n][n] */ void dist_symm(DIST, m, X, n, pwr) unsigned int m,n; double **X, **DIST; double pwr; { int i,j,k; double diff; /* sanity check and initialize */ assert(DIST); i = k = j = 0; for(i=0; i 0) id(K, n); else zero(K, n, m); } else { /* complete the K calcluation as a function of DIST */ for(i=0; i 0 && m == n) for(i=0; i= 0); /* d=0 always results in Id matrix; nugget gets added in below */ if(d == 0.0) id(K, n); for(i=0; i 0) id(K, n); else zero(K, n, m); } else { for(i=0; i 0 && m == n) for(i=0; i= 0); /* d=0 should result in Id + nug on diagonal; nug is added in below */ if(d == 0.0) id(K, n); for(i=0; i #include extern "C" { #include "lh.h" #include "matrix.h" #include "all_draws.h" #include "rand_draws.h" #include "rand_pdf.h" #include "gen_covar.h" #include "rhelp.h" } #include "model.h" #include #include #include #include #include #define DNORM true #define MEDBUFF 256 #define DBETAA 2.0 #define DBETAB 1.0 /* * Model: * * the usual constructor function */ Model::Model(Params* params, unsigned int d, double** rect, int Id, bool trace, void *state) { this->params = new Params(params); base_prior = this->params->BasePrior(); this->d=d; this->Id = Id; this->iface_rect = new_dup_matrix(rect, 2, d); /* parallel prediction implementation ? */ #ifdef PARALLEL parallel = true; if(RNG == CRAN && NUMTHREADS > 1) warning("using thread unsafe unif_rand() with pthreads"); #else parallel = false; #endif PP = NULL; this->state_to_init_consumer = newRNGstate_rand(state); if(parallel) { init_parallel_preds(); consumer_start(); } /* stuff to do with printing */ OUTFILE = MYstdout; verb = 2; this->trace = trace; /* for keeping track of the average number of partitions */ partitions = 0; /* null initializations for trace files and data structures*/ PARTSFILE = XXTRACEFILE = HIERTRACEFILE = POSTTRACEFILE = NULL; lin_area = NULL; /* asynchronous writing to files by multiple threads is problematic */ if(trace && parallel) warning("traces in parallel version of tgp not recommended\n"); /* initialize tree operation statistics */ swap = prune = change = grow = swap_try = change_try = grow_try = prune_try = 0; /* init best tree posteriors */ posteriors = new_posteriors(); /* initialize Zmin to zero -- nothing better */ Zmin = 0; /* make null tree, and then call Model::Init() to make a new * one so that when we pass "this" model to tree, it won't be * only partially allocated */ t = NULL; Xsplit = NULL; nsplit = 0; /* default inv-temperature is 1.0 */ its = NULL; Tprior = true; } /* * Init: * * this function exists because we need to create the new tree * "t" by passing it a pointer to "this" model. But we can't pass * it the "this" pointer until its done constructing, i.e., after * Model::Model() finishes. So this function has all of the stuff * that used to be at the end of Model::Model. It should always be * called immediately after Model::Model() * * the last three arguments (dtree, ncol, dhier) describe a place to * initialize the model at; i.e., what tree (and base model params) and * what base (hierarchal) prior. */ void Model::Init(double **X, unsigned int n, unsigned int d, double *Z, Temper *its, double *dtree, unsigned int ncol, double *dhier) { assert(d == this->d); /* copy input and predictive data; and NORMALIZE */ double **Xc = new_normd_matrix(X,n,d,iface_rect,NORMSCALE); /* read hierarchical parameters from a double-vector */ if(dhier) base_prior->Init(dhier); /* make sure the first col still indicates the coarse or fine process */ if(base_prior->BaseModel() == GP){ if( ((Gp_Prior*) base_prior)->CorrPrior()->CorrModel() == MREXPSEP ){ for(unsigned int i=0; iboundary[0][i] = 0.0; newRect->boundary[1][i] = NORMSCALE; newRect->opl[i] = GEQ; newRect->opr[i] = LEQ; } /* set the starting inv-temperature */ /* it is important that this happens before new Tree() */ this->its = new Temper(its); /* initialization of the (main) tree part of the model */ int *p = iseq(0,n-1); t = new Tree(Xc, p, n, d, Zc, newRect, NULL, this); /* initialize the tree mode: i.e., Update() & Compute() */ t->Init(dtree, ncol, iface_rect); /* initialize the posteriors with the current tree only if that tree was read-in from R; don't record a trace */ if(ncol > 0) Posterior(false); } /* * ~Model: * * the usual class deletion function */ Model::~Model(void) { /* close down parallel prediction */ if(parallel) { consumer_finish(); close_parallel_preds(); } /* delete the tree model & params */ if(iface_rect) delete_matrix(iface_rect); if(t) delete t; if(Xsplit) delete_matrix(Xsplit); if(params) delete params; /* delete the inv-temperature structure */ if(its) delete its; /* delete linarea and posterior */ if(posteriors) delete_posteriors(posteriors); if(trace && lin_area) { delete_linarea(lin_area); lin_area = NULL; } /* clean up partsfile */ if(PARTSFILE) fclose(PARTSFILE); PARTSFILE = NULL; /* clean up post trace file */ if(POSTTRACEFILE) fclose(POSTTRACEFILE); POSTTRACEFILE = NULL; /* clean up XX trace file */ if(XXTRACEFILE) fclose(XXTRACEFILE); XXTRACEFILE = NULL; /* clean up trace file for hierarchical params */ if(HIERTRACEFILE) fclose(HIERTRACEFILE); HIERTRACEFILE = NULL; deleteRNGstate(state_to_init_consumer); } /* * rounds: * * MCMC rounds master function * ZZ and ZZp are the predictions for rounds B:T * must be pre-allocated. */ void Model::rounds(Preds *preds, unsigned int B, unsigned int T, void *state) { /* check for well-allocated preds module */ if(T>B) { assert(preds); assert(T-B >= preds->mult); assert(((int)ceil(((double)(T-B))/preds->R)) == (int)preds->mult); } /* TESTING TREE DISTANCE */ /* double **td1, **td2; int *tdp; double *th, *tad; if(preds) { td1 = new_zero_matrix(preds->nn, preds->nn); td2 = new_zero_matrix(preds->nn, preds->nn); th = new_zero_vector(preds->nn); tad = new_zero_vector(preds->nn); tdp = iseq(0, preds->nn); } */ /* for the leavesList function in the for loop below */ unsigned int numLeaves = 1; /* for helping with periodic interrupts */ time_t itime = time(NULL); /* every round, do ... */ for(int r=0; r<(int)T; r++) { /* draw a new temperature */ if((r+1)%4 == 0) DrawInvTemp(state, r < (int)B); /* propose tree changes */ /* bool treemod = false; */ if((r+1)%4 == 0) /* treemod = */ modify_tree(state); /* get leaves of the tree */ Tree **leaves = t->leavesList(&numLeaves); /* for each leaf: draw params first compute marginal params as necessary */ int index = (int)r-B; bool success = false; for(unsigned int i=0; iCompute(); /* draws for the parameters at the leaves of the tree */ if(!(success = leaves[i]->Draw(state))) break; /* note that Compute still needs to be called on each leaf, below */ } /* check to see if draws from leaves was successful */ if(!success) { if(parallel) { if(PP) produce(); wrap_up_predictions(); } cut_root(); partitions = 0; r = -1; free(leaves); continue; } /* produce leaves for parallel prediction */ /* MAYBE this should be moved after/into the preds if-statement below */ if(parallel && PP && PP->Len() > PPMAX) produce(); /* draw hierarchical parameters */ base_prior->Draw(leaves, numLeaves, state); /* make sure to Compute on leaves now that hier-priors have changed */ for(unsigned int i=0; iCompute(); /* print progress meter */ if((r+1) % 1000 == 0 && r>0 && verb >= 1) PrintState(r+1, numLeaves, leaves); /* process full posterior, and calculate linear area */ if(T>B && (index % preds->mult == 0)) { /* keep track of MAP, and calculate importance sampling weight */ double w = Posterior(true); /* must call Posterior for mapt */ if(its->IT_ST_or_IS()) { preds->w[index/preds->mult] = w; preds->itemp[index/preds->mult] = its->Itemp(); } /* For random XX (eg sensitivity analysis), draw the predictive locations */ if(preds->nm > 0){ sens_sample(preds->XX, preds->nn, preds->d, preds->bnds, preds->shape, preds->mode, state); dupv(preds->M[index/preds->mult], preds->XX[0], preds->d * preds->nm); normalize(preds->XX, preds->rect, preds->nn, preds->d, 1.0); } /* TESTING TREE DISTANCE */ // t->Distance(preds->XX, tdp, preds->nn, td1, th, td2, tad); /* predict for each leaf */ /* make sure to do this after calculation of preds->w[r], above */ for(unsigned int i=0; imult; partitions = (m*partitions + numLeaves)/(m+1); /* these do nothing when traces=FALSE */ ProcessLinarea(leaves, numLeaves); /* calc area under the LLM */ PrintPartitions(); /* print leaves of the tree */ PrintHiertrace(); /* print hierarchical params */ } /* clean up the garbage */ free(leaves); /* periodically check R for interrupts and flush console every second */ itime = MY_r_process_events(itime); } /* send a full set of leaves out for prediction */ if(parallel && PP) produce(); /* wait for final predictions to finish */ if(parallel) wrap_up_predictions(); /* normalize Ds2x, i.e., divide by the total (not within-partition) XX locs */ if(preds && preds->Ds2x) scalev(preds->Ds2x[0], preds->R * preds->nn, 1.0/preds->nn); /* TESTING TREE DISTANCE */ /* if(preds) { scalev(*td1, preds->nn * preds->nn, 1.0/preds->R); matrix_to_file("node_dist.txt", td1, preds->nn, preds->nn); scalev(*td2, preds->nn * preds->nn, 1.0/preds->R); matrix_to_file("nodeabs_dist.txt", td2, preds->nn, preds->nn); delete_matrix(td1); delete_matrix(td2); free(tdp); free(th); free(tad); } */ } /* * predict_master: * * chooses parallel prediction; * first determines whether or not to do a prediction * based on the prediction index (>0) and the preds module * indication of how many predictions it wants. */ void Model::predict_master(Tree *leaf, Preds *preds, int index, void* state) { /* only predict every E = preds->mult */ if(index < 0) return; if(index % preds->mult != 0) return; /* calculate r index into preds matrices */ unsigned int r = index/preds->mult; assert(r < preds->R); /* if-statement should never be true: if(r >= preds->R) return; */ /* choose parallel or serial prediction */ if(parallel) predict_producer(leaf, preds, r, DNORM); else predict_xx(leaf, preds, r, DNORM, state); } /* * predict: * * predict at one of the leaves of the tree. * this was made into a function in order to help simplify * the rounds() function. Also, now fascilitates parameter * traces for the GPs which govern the XX locations. */ void Model::Predict(Tree* leaf, Preds* preds, unsigned int index, bool dnorm, void *state) { /* these declarations just make for shorter function arguments below */ double *Zp, *Zpm, *Zpvm, *Zps2, *ZZ, *ZZm, *ZZvm, *ZZs2, *improv, *Ds2x; if(preds->Zp) Zp = preds->Zp[index]; else Zp = NULL; if(preds->Zpm) Zpm = preds->Zpm[index]; else Zpm = NULL; if(preds->Zpvm) Zpvm = preds->Zpvm[index]; else Zpvm = NULL; if(preds->Zps2) Zps2 = preds->Zps2[index]; else Zps2 = NULL; if(preds->ZZ) ZZ = preds->ZZ[index]; else ZZ = NULL; if(preds->ZZm) ZZm = preds->ZZm[index]; else ZZm = NULL; if(preds->ZZvm) ZZvm = preds->ZZvm[index]; else ZZvm = NULL; if(preds->ZZs2) ZZs2 = preds->ZZs2[index]; else ZZs2 = NULL; if(preds->Ds2x) Ds2x = preds->Ds2x[index]; else Ds2x = NULL; if(preds->improv) improv = preds->improv[index]; else improv = NULL; /* this is probably the best place for gathering traces about XX */ if(preds->ZZ) Trace(leaf, index); /* checks if trace=TRUE inside Trace */ /* here is where the actual prediction happens */ leaf->Predict(Zp, Zpm, Zpvm, Zps2, ZZ, ZZm, ZZvm, ZZs2, Ds2x, improv, Zmin, wZmin, dnorm, state); } /* * modify_tree: * * Propose structural changes to the tree via * GROW, PRUNE, CHANGE, and SWAP operations * chosen randomly */ bool Model::modify_tree(void *state) { /* since we may modify the tree we need to * update the marginal parameters now! */ unsigned int numLeaves; Tree **leaves = t->leavesList(&numLeaves); assert(numLeaves >= 1); for(unsigned int i=0; iCompute(); free(leaves); /* end marginal parameter computations */ /* probability distribution for each tree operation ("action") */ double probs[4] = {1.0/5, 1.0/5, 2.0/5, 1.0/5}; int actions[4] = {1,2,3,4}; /* sample an action */ int action; unsigned int indx; isample(&action, &indx, 1, 4, actions, probs, state); /* do the chosen action */ switch(action) { case 1: /* grow */ return grow_tree(state); case 2: /* prune */ return prune_tree(state); case 3: /* change */ return change_tree(state); case 4: /* swap */ return swap_tree(state); default: error("action %d not supported", action); } /* should not reach here */ return 0; } /* * swap_tree: * * Choose which INTERNAL node should have its split-point * moved. */ bool Model::swap_tree(void *state) { unsigned int len; Tree** nodes = t->swapableList(&len); if(len == 0) return false; unsigned int k = (unsigned int) sample_seq(0,len-1, state); bool success = nodes[k]->swap(state); free(nodes); swap_try++; if(success) swap++; return success; } /* * change_tree: * * Choose which INTERNAL node should have its split-point * moved. */ bool Model::change_tree(void *state) { unsigned int len; Tree** nodes = t->internalsList(&len); if(len == 0) return false; unsigned int k = (unsigned int) sample_seq(0,len-1, state); bool success = nodes[k]->change(state); free(nodes); change_try++; if(success) change++; return success; } /* * prune_tree: * * Choose which part of the tree to attempt to prune */ bool Model::prune_tree(void *state) { /* get the list of possible prunable nodes */ unsigned int len; Tree** nodes = t->prunableList(&len); if(len == 0) return false; /* update the forward and backward proposal probabilities */ double q_fwd = 1.0/len; double q_bak = 1.0/(t->numLeaves()-1); /* get the prior tree parameters */ unsigned int t_minpart, t_splitmin, t_basemax; double t_alpha, t_beta; params->get_T_params(&t_alpha, &t_beta, &t_minpart, &t_splitmin, &t_basemax); /* calculate the tree prior */ unsigned int k = (unsigned int) sample_seq(0,len-1, state); unsigned int depth = nodes[k]->getDepth() + 1; double pEtaT = t_alpha * pow(1+depth,0.0-(t_beta)); double pEtaPT = t_alpha * pow(1+depth-1,0.0-(t_beta)); double diff = 1-pEtaT; double pTreeRatio = (1-pEtaPT) / ((diff*diff) * pEtaPT); /* temper the tree probabilities in non-log space ==> uselog=0 */ if(Tprior) pTreeRatio = temper(pTreeRatio, its->Itemp(), 0); /* attempt a prune */ bool success = nodes[k]->prune((q_bak/q_fwd)*pTreeRatio, state); free(nodes); /* update the prune success rates */ prune_try++; if(success) prune++; return success; } /* * grow_tree: * * Choose which part of the tree to attempt to grow on */ bool Model::grow_tree(void *state) { /* get the tree prior params */ unsigned int len, t_minpart, t_splitmin, t_basemax; double t_alpha, t_beta; params->get_T_params(&t_alpha, &t_beta, &t_minpart, &t_splitmin, &t_basemax); if(t_alpha == 0 || t_beta == 0) return false; /* get the list of growable nodes */ Tree** nodes = t->leavesList(&len); /* forward (grow) probability */ double q_fwd = 1.0/len; /* choose which leaf to grow on */ unsigned int k = (unsigned int) sample_seq(0,len-1, state); /* calculate the reverse (prune) probability */ double q_bak; double num_prune = t->numPrunable(); /* if the parent is prunable, then we don't change the number of prunable nodes with a grow; otherwise we add one */ Tree* parent_k = nodes[k]->Parent(); if(parent_k == NULL) { assert(nodes[k]->getDepth() == 0); q_bak = 1.0/(num_prune+1); } else if(parent_k->isPrunable()) { q_bak = 1.0/(num_prune+1); } else { q_bak = 1.0/num_prune; } unsigned int depth = nodes[k]->getDepth(); double pEtaT = t_alpha * pow(1+depth,0.0-(t_beta)); double pEtaCT = t_alpha * pow(1+depth+1,0.0-(t_beta)); double diff = 1-pEtaCT; double pTreeRatio = pEtaT * (diff*diff) / (1-pEtaT); /* temper the tree probabilities in non-log space ==> uselog=0 */ if(Tprior) pTreeRatio = temper(pTreeRatio, its->Itemp(), 0); /* attempt a grow */ bool success = nodes[k]->grow((q_bak/q_fwd)*pTreeRatio, state); free(nodes); grow_try++; if(success) grow++; return success; } /* * cut_branch: * * randomly cut a branch (swath) of the tree off * an internal node is selected, and its children * are cut (removed) from the tree */ void Model::cut_branch(void *state) { unsigned int len; Tree** nodes = t->internalsList(&len); if(len == 0) return; unsigned int k = (unsigned int) sample_seq(0,len,state); if(k == len) { if(verb >= 1) MYprintf(OUTFILE, "tree unchanged (no branches removed)\n"); } else { if(verb >= 1) MYprintf(OUTFILE, "removed %d leaves from the tree\n", nodes[k]->numLeaves()); nodes[k]->cut_branch(); } free(nodes); } /* * cut_root: * * cut_branch, but from the root of the tree * */ void Model::cut_root(void) { if(t->isLeaf()) { if(verb >= 1) MYprintf(OUTFILE, "removed 0 leaves from the tree\n"); } else { if(verb >= 1) MYprintf(OUTFILE, "removed %d leaves from the tree\n", t->numLeaves()); } t->cut_branch(); } /* * update_tprobs: * * re-create the prior distribution of the temperature * ladder by dividing by the normalization constant -- returns * a pointer to the new probabilities */ double *Model::update_tprobs(void) { /* for debugging */ // its->AppendLadder("ladder.txt"); return its->UpdatePrior(); } /* * new_data: * * adding new data to the model * (and thus also to the tree) */ void Model::new_data(double **X, unsigned int n, unsigned int d, double* Z, double **rect) { /* copy input and predictive data; and NORMALIZE */ double **Xc = new_normd_matrix(X,n,d,rect,NORMSCALE); /* make sure the first col still indicates the coarse or fine process */ if(base_prior->BaseModel() == GP){ if( ((Gp_Prior*) base_prior)->CorrPrior()->CorrModel() == MREXPSEP ){ for(unsigned int i=0; inew_data(Xc, n, d, Zc, p); /* reset the MAP per height bookeeping */ delete_posteriors(posteriors); posteriors = new_posteriors(); } /* * PrintTreeStats: * * printing out tree operation stats */ void Model::PrintTreeStats(FILE* outfile) { if(grow_try > 0) MYprintf(outfile, "Grow: %.4g%c, ", 100* (double)grow/grow_try, '%'); if(prune_try > 0) MYprintf(outfile, "Prune: %.4g%c, ", 100* (double)prune/prune_try, '%'); if(change_try > 0) MYprintf(outfile, "Change: %.4g%c, ", 100* (double)change/change_try, '%'); if(swap_try > 0) MYprintf(outfile, "Swap: %.4g%c", 100* (double)swap/swap_try, '%'); if(grow_try > 0) MYprintf(outfile, "\n"); } /* * TreeStats: * * write the tree operation stats to the double arg */ void Model::TreeStats(double *gpcs) { gpcs[0] = (double)grow/grow_try; gpcs[1] = (double)prune/prune_try; gpcs[2] = (double)change/change_try; gpcs[3] = (double)swap/swap_try; } /* * get_TreeRoot: * * return the root of the tree in this model */ Tree* Model::get_TreeRoot(void) { return t; } /* * get_Xsplit: * * return the locations at which the tree can make splits; * either Xsplit, or t->X if Xsplit is NULL -- pass back the * number of locations (nsplit) */ double** Model::get_Xsplit(unsigned int *nsplit) { /* calling this function only makes sense if treed partitioning is allowed */ assert(params->isTree()); if(Xsplit) { *nsplit = this->nsplit; return Xsplit; } else { assert(t); *nsplit = t->getN(); return t->get_X(); } } /* * set_Xsplit: * * set the locations at which the tree can make splits; * NULL indicates that the locations should be t->X */ void Model::set_Xsplit(double **X, unsigned int n, unsigned int d) { /* calling this function only makes sense if treed partitioning is allowed */ assert(params->isTree()); /* make sure X dims match up */ assert(d == this->d); if(Xsplit) delete_matrix(Xsplit); if(! X) { assert(nsplit == 0); Xsplit = NULL; nsplit = 0; } else { Xsplit = new_normd_matrix(X,n,d,iface_rect,NORMSCALE); nsplit = n; } } /* * set_TreeRoot: * * return the root of the tree in this model */ void Model::set_TreeRoot(Tree *t) { this->t = t; } /* * PrintState: * * Print the state for the current round */ void Model::PrintState(unsigned int r, unsigned int numLeaves, Tree** leaves) { /* print round information */ #ifdef PARALLEL if(num_produced - num_consumed > 0) MYprintf(OUTFILE, "(r,l)=(%d,%d) ", r, num_produced - num_consumed); else MYprintf(OUTFILE, "r=%d ", r); #else MYprintf(OUTFILE, "r=%d ", r); #endif /* this is here so that the progress meter in SampleMap doesn't need to print the same tree information each time */ if(numLeaves > 0) { // MYprintf(OUTFILE, " d="); /* print the (correllation) state (d-values and maybe nugget values) */ for(unsigned int i=0; iState(i); MYprintf(OUTFILE, "%s", state); if(i != numLeaves-1) MYprintf(OUTFILE, " "); free(state); } /* a delimeter */ MYprintf(OUTFILE, "; "); /* print maximum posterior prob tree height */ Tree *maxt = maxPosteriors(); if(maxt) MYprintf(OUTFILE, "mh=%d ", maxt->Height()); /* print partition sizes */ if(numLeaves > 1) MYprintf(OUTFILE, "n=("); else MYprintf(OUTFILE, "n="); for(unsigned int i=0; igetN()); if(numLeaves > 1) MYprintf(OUTFILE, "%d)", leaves[numLeaves-1]->getN()); else MYprintf(OUTFILE, "%d", leaves[numLeaves-1]->getN()); } /* cap off the printing */ if(its->Numit() > 1) MYprintf(OUTFILE, " k=%g", its->Itemp()); MYprintf(OUTFILE, "\n"); MYflush(OUTFILE); } /* * get_params: * * return a pointer to the fixed input parameters */ Params* Model::get_params() { return params; } /* * close_parallel_preds: * * close down and destroy producer & consumer * data, queues and pthreads */ void Model::close_parallel_preds(void) { #ifdef PARALLEL /* close and free the consumers */ for(unsigned int i=0; iDeQueue())) { delete l->leaf; free(l); } delete tlist; tlist = NULL; /* empty then free the PP list */ while((l = (LArgs*) PP->DeQueue())) { delete l->leaf; free(l); } delete PP; PP = NULL; #else error("close_parallel_preds: not compiled for pthreads"); #endif } /* * init_parallel_preds: * * initialize producer & consumer parallel prediction * data, queues and pthreads */ void Model::init_parallel_preds(void) { #ifdef PARALLEL /* initialize everything for parallel prediction */ l_mut = (pthread_mutex_t*) malloc(sizeof(pthread_mutex_t)); l_cond_nonempty = (pthread_cond_t*) malloc(sizeof(pthread_cond_t)); l_cond_notfull = (pthread_cond_t*) malloc(sizeof(pthread_cond_t)); pthread_mutex_init(l_mut, NULL); pthread_cond_init(l_cond_nonempty, NULL); pthread_cond_init(l_cond_notfull, NULL); tlist = new List(); assert(tlist); PP = new List(); assert(PP); /* initialize lock for synchronizing printing of XX traces */ l_trace_mut = (pthread_mutex_t*) malloc(sizeof(pthread_mutex_t)); pthread_mutex_init(l_trace_mut, NULL); /* allocate consumers */ consumer = (pthread_t**) malloc(sizeof(pthread_t*) * NUMTHREADS); for(unsigned int i=0; iadd_XX(preds->XX, preds->nn, d); LArgs *largs = (LArgs*) malloc(sizeof(struct largs)); fill_larg(largs, newleaf, preds, index, dnorm); num_produced++; PP->EnQueue((void*) largs); #else error("predict_producer: not compiled for pthreads"); #endif } /* * produce: * * collect tree leaves for prediction in a list before * putting the into another list (tlist) for consumption */ void Model::produce(void) { #ifdef PARALLEL assert(PP); if(PP->isEmpty()) return; pthread_mutex_lock(l_mut); while (tlist->Len() >= QUEUEMAX) pthread_cond_wait(l_cond_notfull, l_mut); assert(tlist->Len() < QUEUEMAX); unsigned int pp_len = PP->Len(); for(unsigned int i=0; iEnQueue(PP->DeQueue()); assert(PP->isEmpty()); pthread_mutex_unlock(l_mut); pthread_cond_signal(l_cond_nonempty); #else error("produce: not compiled for pthreads"); #endif } /* * predict_consumer: * * is awakened when there is a leaf node (and ooutput pointers) * in the list (queue) and calls the predict routine on it; * list produced by predict_producer in main thread. */ void Model::predict_consumer(void) { #ifdef PARALLEL unsigned int nc = 0; /* each consumer needs its on random state variable */ void *state = newRNGstate_rand(state_to_init_consumer); while(1) { pthread_mutex_lock (l_mut); /* increment num_consumed from the previous iteration */ num_consumed += nc; assert(num_consumed <= num_produced); nc = 0; /* wait for the tlist to get populated with leaves */ while (tlist->isEmpty()) pthread_cond_wait (l_cond_nonempty, l_mut); /* dequeue half of the waiting leaves into LL */ unsigned int len = tlist->Len(); List* LL = new List(); void *entry = NULL; unsigned int i; /* dequeue a calculated portion of the remaing leaves */ for(i=0; iisEmpty()); entry = tlist->DeQueue(); if(entry == NULL) break; assert(entry); LL->EnQueue(entry); } /* release lock and signal */ pthread_mutex_unlock(l_mut); if(len - i < QUEUEMAX) pthread_cond_signal(l_cond_notfull); if(len - i > 0) pthread_cond_signal(l_cond_nonempty); /* take care of each leaf */ while(!(LL->isEmpty())) { LArgs* l = (LArgs*) LL->DeQueue(); Predict(l->leaf, l->preds, l->index, l->dnorm, state); nc++; delete l->leaf; free(l); } /* this list should be empty */ delete LL; /* if the final list entry was NULL, then this thread is done */ if(entry == NULL) { /* make sure to update the num consumed */ pthread_mutex_lock(l_mut); num_consumed += nc; pthread_mutex_unlock(l_mut); /* delete random number generator state for this thread */ deleteRNGstate(state); return; } } #else error("predict_consumer: not compiled for pthreads"); #endif } /* * predict_consumer_c: * * a dumMY c-style function that calls the * consumer function from the Model class */ void* predict_consumer_c(void* m) { Model* model = (Model*) m; model->predict_consumer(); return NULL; } /* * consumer_finish: * * wait for the consumer to finish predicting */ void Model::consumer_finish(void) { #ifdef PARALLEL /* send a null terminating entry into the queue */ pthread_mutex_lock(l_mut); for(unsigned int i=0; iEnQueue(NULL); pthread_mutex_unlock(l_mut); pthread_cond_signal(l_cond_nonempty); for(unsigned int i=0; iLen() != tlen || diff != (int)num_produced-(int)num_consumed) { tlen = tlist->Len(); diff = num_produced - num_consumed; if(verb >= 1) { MYprintf(OUTFILE, "waiting for (%d, %d) predictions\n", tlen, diff); MYflush(OUTFILE); } } pthread_mutex_unlock(l_mut); usleep(500000); } pthread_mutex_unlock(l_mut); num_consumed = num_produced = 0; #else error("wrap_up_predictions: not compiled for pthreads"); #endif } /* * CopyPartitions: * * return COPIES of the leaves of the tree * (i.e. the partitions) */ Tree** Model::CopyPartitions(unsigned int *numLeaves) { Tree* maxt = maxPosteriors(); Tree** leaves = maxt->leavesList(numLeaves); Tree** copies = (Tree**) malloc(sizeof(Tree*) * *numLeaves); for(unsigned int i=0; i<*numLeaves; i++) { copies[i] = new Tree(leaves[i], true); copies[i]->Clear(); } free(leaves); return copies; } /* * MAPreplace: * * set the current model tree to be the MAP one that * is stored */ void Model::MAPreplace(void) { Tree* maxt = maxPosteriors(); if(maxt) { if(t) delete t; t = new Tree(maxt, true); } else maxt = t; /* get leaves ready for use */ unsigned int len; Tree** leaves = t->leavesList(&len); for(unsigned int i=0; iUpdate(); leaves[i]->Compute(); } free(leaves); } /* * PrintBestPartitions: * * print rectangles covered by leaves of the tree * with the highest posterior probability * (i.e. the partitions) */ void Model::PrintBestPartitions() { FILE *BESTPARTS; Tree *maxt = maxPosteriors(); if(!maxt) { warning("not enough MCMC rounds for MAP tree, using current"); maxt = t; } assert(maxt); BESTPARTS = OpenFile("best", "parts"); print_parts(BESTPARTS, maxt, iface_rect); fclose(BESTPARTS); } /* * print_parts * * print the partitions of the leaves of the tree * specified PARTSFILE */ void print_parts(FILE *PARTSFILE, Tree *t, double** iface_rect) { assert(PARTSFILE); assert(t); unsigned int numLeaves; Tree** leaves = t->leavesList(&numLeaves); for(unsigned int i=0; iGetRect()); rect_unnorm(rect, iface_rect, NORMSCALE); print_rect(rect, PARTSFILE); delete_rect(rect); } free(leaves); } /* * PrintPartitions: * * print rectangles covered by leaves of the tree * (i.e. the partitions) -- do nothing if traces are not * enabled */ void Model::PrintPartitions(void) { if(!trace) return; if(!PARTSFILE) { /* stuff for printing partitions and other to files */ if(params->isTree()) PARTSFILE = OpenFile("trace", "parts"); else return; } print_parts(PARTSFILE, t, iface_rect); } /* * predict_xx: * * usual non-parallel predict function that copies the leaf * before adding XX to it, and then predicts */ void Model::predict_xx(Tree* leaf, Preds* preds, int index, bool dnorm, void *state) { leaf->add_XX(preds->XX, preds->nn, d); if(index >= 0) Predict(leaf, preds, index, dnorm, state); leaf->delete_XX(); } /* * Outfile: * * return file handle to model outfile */ FILE* Model::Outfile(int *verb) { *verb = this->verb; return OUTFILE; } /* * Outfile: * * set outfile handle */ void Model::Outfile(FILE *file, int verb) { OUTFILE = file; this->verb = verb; t->Outfile(file, verb); } /* * Partitions: * * return the current number of partitions */ double Model::Partitions(void) { return partitions; } /* * OpenFile: * * open a the file named prefix_trace_Id+1.out */ FILE* Model::OpenFile(const char *prefix, const char *type) { char outfile_str[BUFFMAX]; sprintf(outfile_str, "%s_%s_%d.out", prefix, type, Id+1); FILE* OFILE = fopen(outfile_str, "w"); assert(OFILE); return OFILE; } /* * PrintTree: * * print the tree in the R CART tree structure format */ void Model::PrintTree(FILE* outfile) { assert(outfile); MYprintf(outfile, "rows var n dev yval splits.cutleft splits.cutright "); /* the following are for printing a higher precision val, and base model parameters for reconstructing trees later */ MYprintf(outfile, "val "); TraceNames(outfile, true); this->t->PrintTree(outfile, iface_rect, NORMSCALE, 1); } /* * DrawInvTemp: * * propose and accept/reject a new annealed importance sampling * inv-temperature, the burnin argument indicates if we are doing * burn-in rounds in the Markov chain */ void Model::DrawInvTemp(void* state, bool burnin) { /* don't do anything if there is only one temperature */ if(its->Numit() == 1) return; /* propose a new inv-temperature */ double q_fwd, q_bak; double itemp_new = its->Propose(&q_fwd, &q_bak, state); /* calculate the posterior probability under both temperatures */ //double p = t->FullPosterior(itemp, Tprior); //double pnew = t->FullPosterior(itemp_new, Tprior); /* calculate the log likelihood under both temperatures */ double ll = t->Likelihood(its->Itemp()); double llnew = t->Likelihood(itemp_new); /* add in a tempered version of the tree prior, or not */ if(Tprior) { ll += t->Prior(its->Itemp()); llnew += t->Prior(itemp_new); } /* sanity check that the priors don't matter */ //double diff_post = pnew - p; double diff_lik = llnew - ll; //MYprintf(MYstderr, "diff=%g\n", diff_post-diff_lik); //assert(diff_post == diff_lik); /* add in the priors for the itemp (weights) */ double diff_p_itemp = log(its->ProposedProb()) - log(its->Prob()); /* Calcculate the MH acceptance ratio */ //double alpha = exp(diff_post + diff_p_itemp)*q_bak/q_fwd; double alpha = exp(diff_lik + diff_p_itemp)*q_bak/q_fwd; double ru = runi(state); if(ru < alpha) { its->Keep(itemp_new, burnin); t->NewInvTemp(itemp_new); } else { its->Reject(itemp_new, burnin); } /* stochastic approximation update of psuedo-prior, only actually does something if its->resetSA() has been called first, see the Model::StochApprox() function */ its->StochApprox(); } /* * Posterior: * * Compute full posterior of the model, tempered and untempered. * Record best posterior as a function of tree height. * * The importance sampling weight is returned, the argument indicates * whether or not a trace should be recorded for the current posterior * probability */ double Model::Posterior(bool record) { /* tempered and untemepered posteriors, from tree on down */ double full_post_temp = t->FullPosterior(its->Itemp(), Tprior); double full_post = t->FullPosterior(1.0, Tprior); /* include priors hierarchical (linear) params W, B0, etc. and the hierarchical corr prior priors in the Base module */ double hier_full_post = base_prior->log_HierPrior(); full_post_temp += hier_full_post; full_post += hier_full_post; /* importance sampling weight */ double w = exp(full_post - full_post_temp); /* if(get_curr_itemp(itemps) == 1.0) assert(w==1.0); */ /* see if this is (untempered) the MAP model; if so then record */ register_posterior(posteriors, t, full_post); // register_posterior(posteriors, t, t->MarginalPosterior(1.0)); /* record the (log) posterior as a function of height */ if(trace && record) { /* allocate the trace files for printing posteriors*/ if(!POSTTRACEFILE) { POSTTRACEFILE = OpenFile("trace", "post"); MYprintf(POSTTRACEFILE, "height leaves lpost itemp tlpost w\n"); } /* write a line to the file recording the trace of the posteriors */ MYprintf(POSTTRACEFILE, "%d %d %15f %15f %15f %15f\n", t->Height(), t->numLeaves(), full_post, its->Itemp(), full_post_temp, w); MYflush(POSTTRACEFILE); } return w; } /* * PrintPosteriors: * * print the highest posterior trees for each height * in the R CART tree structure format * doesn't do anything if no posteriors were recorded */ void Model::PrintPosteriors(void) { char filestr[MEDBUFF]; /* open a file to write the posterior information to */ sprintf(filestr, "tree_m%d_posts.out", Id); FILE *postsfile = fopen(filestr, "w"); MYprintf(postsfile, "height lpost "); PriorTraceNames(postsfile, true); /* unsigned int t_minpart, t_splitmin; double t_alpha, t_beta; params->get_T_params(&t_alpha, &t_beta, &t_minpart, &t_splitmin); */ for(unsigned int i=0; imaxd; i++) { if(posteriors->trees[i] == NULL) continue; /* open a file to write the tree to */ sprintf(filestr, "tree_m%d_%d.out", Id, i+1); FILE *treefile = fopen(filestr, "w"); /* add maptree-relevant headers */ MYprintf(treefile, "rows var n dev yval splits.cutleft splits.cutright "); /* the following are for printing a higher precision val, and base model parameters for reconstructing trees later */ MYprintf(treefile, "val "); /* add parameter trace relevant headers */ TraceNames(treefile, true); /* write the tree and trace parameters */ posteriors->trees[i]->PrintTree(treefile, iface_rect, NORMSCALE, 1); fclose(treefile); /* add information about height and posteriors to file */ assert(i+1 == posteriors->trees[i]->Height()); MYprintf(postsfile, "%d %g ", posteriors->trees[i]->Height(), posteriors->posts[i]); /* add prior parameter trace information to the posts file */ unsigned int tlen; double *trace = (posteriors->trees[i]->GetBasePrior())->Trace(&tlen, true); printVector(trace, tlen, postsfile, MACHINE); free(trace); } fclose(postsfile); } /* * maxPosteriors: * * return a pointer to the maximum posterior tree */ Tree* Model::maxPosteriors(void) { Tree *maxt = NULL; double maxp = R_NegInf; for(unsigned int i=0; imaxd; i++) { if(posteriors->trees[i] == NULL) continue; if(posteriors->posts[i] > maxp) { maxt = posteriors->trees[i]; maxp = posteriors->posts[i]; } } return maxt; } /* * Linear: * * change prior to prefer all linear models force leaves (partitions) * to use the linear model; if gamlin[0] == 0, then do nothing and * return 0, because the linear is model not allowed */ double Model::Linear(void) { //if(! base_prior->LLM()) return 0; double gam = base_prior->ForceLinear(); /* toggle linear in each of the leaves */ unsigned int numLeaves = 1; Tree **leaves = t->leavesList(&numLeaves); for(unsigned int i=0; iForceLinear(); free(leaves); return gam; } /* * ResetLinear: (unlinearize) * * does not change all leaves to full GP models; * instead simply changes the prior gamma (from gamlin) * to allow for non-linear models */ void Model::ResetLinear(double gam) { base_prior->ResetLinear(gam); /* if LLM not allowed, then toggle GP in each of the leaves */ if(gam == 0) { unsigned int numLeaves = 1; Tree **leaves = t->leavesList(&numLeaves); for(unsigned int i=0; iForceNonlinear(); } } /* * Linburn: * * forced initialization of the Markov Chain using * the Bayesian Linear CART model. Must undo linear * settings before returning. Does nothing if Linear() * determines that the original gamlin[0] was 0 */ void Model::Linburn(unsigned int B, void *state) { double gam = Linear(); //if(gam) { if(verb > 0) MYprintf(OUTFILE, "\nlinear model init:\n"); rounds(NULL, B, B, state); ResetLinear(gam); //} } /* * Burnin: * * B rounds of burn in (with NULL preds) */ void Model::Burnin(unsigned int B, void *state) { if(verb >= 1 && B>0) MYprintf(OUTFILE, "\nburn in:\n"); rounds(NULL, B, B, state); } /* * StochApprox: * * B rounds of "burn-in" (with NULL preds), and stochastic * approximation turned on for jump-starting the pseudo-prior * for Simulated Tempering */ void Model::StochApprox(unsigned int B, void *state) { if(!its->DoStochApprox()) return; if(verb >= 1 && B>0) MYprintf(OUTFILE, "\nburn in: [with stoch approx (c0,n0)=(%g,%g)]\n", its->C0(), its->N0()); /* do the rounds of stochastic approximation */ its->ResetSA(); rounds(NULL, B, B, state); /* stop stochastic approximation and normalize the weights */ its->StopSA(); its->Normalize(); } /* * Sample: * * Gather R samples from the Markov Chain, for predictive data * provided by the preds variable. */ void Model::Sample(Preds *preds, unsigned int R, void *state) { if(R == 0) return; if(verb >= 1 && R>0) { MYprintf(OUTFILE, "\nSampling @ nn=%d pred locs:", preds->nn); if(trace) MYprintf(OUTFILE, " [with traces]"); MYprintf(OUTFILE, "\n"); } rounds(preds, 0, R, state); } /* * Predict: * * simply predict in rounds conditional on the (MAP) parameters theta; * i.e., don't draw base (GP) parameters or modify tree */ void Model::Predict(Preds *preds, unsigned int R, void *state) { if(R == 0) return; assert(preds); if(verb >=1) MYprintf(OUTFILE, "\nKriging @ nn=%d predictive locs:\n", preds->nn); /* get leaves of the tree */ unsigned int numLeaves; Tree **leaves = t->leavesList(&numLeaves); assert(numLeaves > 0); /* for helping with periodic interrupts */ time_t itime = time(NULL); for(unsigned int r=0; r0 && verb >= 1) PrintState(r+1, 0, NULL); /* produce leaves for parallel prediction */ if(parallel && PP && PP->Len() > PPMAX) produce(); /* process full posterior, and calculate linear area */ if(r % preds->mult == 0) { /* For random XX (eg sensitivity analysis), draw the predictive locations */ if(preds->nm > 0){ sens_sample(preds->XX, preds->nn, preds->d, preds->bnds, preds->shape, preds->mode, state); dupv(preds->M[r/preds->mult], preds->XX[0], preds->d * preds->nm); //printf("xx: \n"); printMatrix(preds->XX, preds->nn, preds->d, MYstdout); normalize(preds->XX, preds->rect, preds->nn, preds->d, 1.0); } /* keep track of MAP, and calculate importance sampling weight */ if(its->IT_ST_or_IS()) { preds->w[r/preds->mult] = 1.0; //Posterior(false); preds->itemp[r/preds->mult] = its->Itemp(); } /* predict for each leaf */ /* make sure to do this after calculation of preds->w[r], above */ for(unsigned int i=0; iDs2x) scalev(preds->Ds2x[0], preds->R * preds->nn, 1.0/preds->nn); } /* * Print: * * Prints to OUTFILE, the current (prior) parameter settings for the * model. */ void Model::Print(void) { params->Print(OUTFILE); base_prior->Print(OUTFILE); } /* * TraceNames * * write the names of the tree (or base) model traces * to the specified outfile. This function does not check * that trace = TRUE since it is also used by PrintTree() */ void Model::TraceNames(FILE * outfile, bool full) { assert(outfile); unsigned int len; char **trace_names = t->TraceNames(&len, full); for(unsigned int i=0; iTraceNames(&len, full); for(unsigned int i=0; iTrace(index, XXTRACEFILE); MYflush(XXTRACEFILE); /* unlock */ #ifdef PARALLEL pthread_mutex_unlock(l_trace_mut); #endif } /* * Temp: * * Return the importance annealing temperature * known by the model */ double Model::iTemp(void) { return its->Itemp(); } /* * DupItemps: * * duplicate the importance temperature * structure known by the model to one provided * in the argument */ void Model::DupItemps(Temper *new_its) { *new_its = *its; } /* * PrintLinarea: * * if traces were recorded, output the trace of the linareas * to an optfile opened just for the occasion */ void Model::PrintLinarea(void) { if(!trace || !lin_area) return; FILE *outfile = OpenFile("trace", "linarea"); print_linarea(lin_area, outfile); } /* * PrintHiertrace: * * collect the traces of the hiererchical base paameters * and append them to the trace file -- if unopened, then * open the file first -- do nothing if trace=FALSE */ void Model::PrintHiertrace(void) { if(!trace) return; /* append to traces of hierarchical parameters */ /* trace of GP parameters for each XX input location */ if(!HIERTRACEFILE) { HIERTRACEFILE = OpenFile("trace", "hier"); PriorTraceNames(HIERTRACEFILE, false); } unsigned int tlen; double *trace = base_prior->Trace(&tlen, false); printVector(trace, tlen, HIERTRACEFILE, MACHINE); free(trace); } /* * ProcessLinarea: * * collect the linarea statistics over time -- if * not allocated already, allocate lin_area; should only * be doing this if trace=TRUE and we are not forcing the * LLM */ void Model::ProcessLinarea(Tree **leaves, unsigned int numLeaves) { if(!trace) return; /* traces of aread under the LLM */ if(lin_area == NULL && base_prior->GamLin(0) > 0) { lin_area = new_linarea(); } if(lin_area) process_linarea(lin_area, numLeaves, leaves); else return; } tgp/src/predict_linear.h0000644000176200001440000000713513531032535014776 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __PREDICT_LINEAR_H__ #define __PREDICT_LINEAR_H__ int predict_full_linear(unsigned int n, double *zp, double *zpm, double *zpvm, double *zps2, double *Kdiag, unsigned int nn, double *zz, double *zzm, double *zzvm, double *zzs2, double *KKdiag, double **Ds2xy, double *improv, double *Z, unsigned int col, double **F, double **FF, double *bmu, double s2, double **Vb, double Zmin, int err, void *state); int predict_full_noK(unsigned int n1, double *zp, double *zpm, double *zps2, double *Kdiag, unsigned int n2, double * zz, double *zzm, double *zzs2, double *KKdiag, double **Ds2xy, unsigned int col, double **F, double **T, double tau2, double **FF, double *b, double ss2, int err, void *state); void predict_noK(unsigned int n1, unsigned int col, double *zzm, double *zzs2, double **F, double *b, double s2, double **Vb); void delta_sigma2_noK(double *Ds2xy, unsigned int n1, unsigned int n2, unsigned int col, double ss2, double denom, double **FT, double tau2, double *fT, double *IDpFTFiQx, double **FFrow, unsigned int which_i, double corr_diag); double predictive_mean_noK(unsigned int n1, unsigned int col, double *FFrow, int i, double * b); void predict_data_noK(double *zpm, double *zps2, unsigned int n1, unsigned int col, double **FFrow, double *b, double ss2, double *Kdiag); double predictive_var_noK(unsigned int n1, unsigned int col, double *Q, double *rhs, double *Wf, double *s2cor, double ss2, double *f, double **FW, double **W, double tau2, double **IDpFWFi, double corr_diag); void predict_delta_noK(double *zmean, double *zs, double **Ds2xy, unsigned int n1, unsigned int n2, unsigned int col, double **FFrow, double **FW, double **W, double tau2, double **IDpFWFi, double *b, double ss2, double* KKdiag); void predict_no_delta_noK(double *zmean, double *zs, unsigned int n1, unsigned int n2, unsigned int col, double **FFrow, double **FW, double **W, double tau2, double **IDpFWFi, double *b, double ss2, double *KKdiag); void predict_help_noK(unsigned int n1,unsigned int col,double *b, double **F, double **W, double tau2, double **FW, double **IDpFWFi, double *Kdiag); void delta_sigma2_linear(double *ds2xy, unsigned int n, unsigned int col, double s2, double *Vbf, double fVbf, double **F, double corr_diag); void predict_linear(unsigned int n, unsigned int col, double *zm, double *zs2, double **F, double *b, double s2, double **Vb, double **Ds2xy, double *Kdiag); #endif tgp/src/lik_post.c0000644000176200001440000001430013531032535013621 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #include #include #include "rand_pdf.h" #include "linalg.h" #include "gen_covar.h" #include "lik_post.h" #include "matrix.h" #include "rhelp.h" #include #include #include /* #define DEBUG */ /* * post_margin_rj: * * uses marginalized parameters (lambda) to calculate the posterior * probability of the GP (d and nug params). * Uses full (unnormalized) * distribution as needed for RJMCMC. return value is logarithm * * T[col][col], Vb[col][col] */ double post_margin_rj(n, col, lambda, Vb, log_detK, T, tau2, a0, g0, itemp) unsigned int n,col; double **T, **Vb; double a0, g0, tau2, lambda, log_detK, itemp; { double log_detVB, log_detT, one, two, p; unsigned int m = 0; /* sanity check for temperature */ assert(itemp >= 0); if(itemp == 0) return 0.0; /* itemp = pow(itemp, 1.0/n); */ /* log det Vb */ log_detVB = log_determinant_dup(Vb, col); /* determine if design matrix is collinear */ if(log_detVB == R_NegInf || lambda < 0 || log_detK == R_NegInf) { /* warning("degenerate design matrix in post_margin_rj"); */ /* assert(0); */ return R_NegInf; } /* determinant of T depends on Beta Prior Model */ if(T[0][0] == 0.0) { assert(tau2 == 1.0); log_detT = 0.0 /*- col*LOG_2_PI*/; m = col; } else log_detT = log_determinant_dup(T, col); /* one = log(det(VB)) - n*log(2*pi) - log(det(K)) - log(det(T)) - col*log(tau2) */ one = log_detVB - (itemp*n)*2*M_LN_SQRT_2PI - itemp*log_detK - log_detT - col*log(tau2); /* two = (a0/2)*log(g0/2) - ((a0+n)/2)*log((g0+lambda)/2) * + log(gamma((a0+n)/2)) - log(gamma(a0/2)); */ two = 0.5*a0*log(0.5*g0) - 0.5*(a0 + itemp*(n-m))*log(0.5*(g0+lambda)); two += lgammafn(0.5*(a0 + itemp*(n-m))) - lgammafn(0.5*a0); /* posterior probability */ p = 0.5*one + two; /* MYprintf(MYstderr, "n=%d, one=%g, two=%g, ldVB=%g, Vb00=%g, ldK=%g, ldT=%g, T00=%g, col_ltau2=%g\n", n, one, two, log_detVB, Vb[0][0], log_detK, log_detT, T[0][0], col*log(tau2)); MYflush(MYstderr); */ /* make sure we got a good p */ if(ISNAN(p)) { p = R_NegInf; /* warning("post_margin_rj, p is NAN"); */ #ifdef DEBUG assert(!ISNAN(p)); #endif } return p; } /* * post_margin: * * uses marginalized parameters (lambda) to calculate the posterior * probability of the GP (d and nug params). Cancels common factors * in ratio of posteriors for MH-MCMC. return value is logarithm * * Vb[col][col] */ double post_margin(n, col, lambda, Vb, log_detK, a0, g0, itemp) unsigned int n, col; double **Vb; double a0, g0, lambda, log_detK, itemp; { double log_detVB, one, two, p; /* sanity check for temperature */ assert(itemp >= 0); if(itemp == 0) return 0.0; /* itemp = pow(itemp, 1.0/n); */ /* log determinant of Vb */ log_detVB = log_determinant_dup(Vb, col); /* determine if design matrix is collinear */ if(log_detVB == R_NegInf || lambda < 0 || log_detK == R_NegInf) { /* warning("degenerate design matrix in post_margin"); */ return R_NegInf; } /* one = log(det(VB)) - log(det(K)) */ one = log_detVB - itemp*log_detK; /* two = - ((a0+n)/2)*log((g0+lambda)/2) */ two = 0.0 - 0.5*(a0 + itemp*n)*log(0.5*(g0+lambda)); /* posterior probability */ p = 0.5*one + two; /* make sure we got a good p */ if(ISNAN(p)) { p = R_NegInf; /* warning("post_margin, p is NAN"); */ #ifdef DEBUG assert(!ISNAN(p)); #endif } return p; } /* * gp_lhood: * * compute the GP likelihood MVN; some of these calculations are * the same as in predict_help(). Should consider moving them to * a more accessible place so predict_help and gp_lhood can share. * * BOBBY: Now when we have Ki == NULL, the Kdiag vec is used. * Thus we now allocate KiFbmZ regardless. * * uses annealing inv-temperature; returns the log pdf */ double gp_lhood(double *Z, unsigned int n, unsigned int col, double **F, double *b, double s2, double **Ki, double log_det_K, double *Kdiag, double itemp) { double *ZmFb, *KiZmFb; double ZmFbKiZmFb, eponent, front, llik; unsigned int i; /* sanity check for temperature */ assert(itemp >= 0); if(itemp == 0.0) return 0.0; /* itemp = pow(itemp, 1.0/n); */ /* ZmFb = Zdat - F * b; first, copy Z (copied code from predict_help()) */ ZmFb = new_dup_vector(Z, n); linalg_dgemv(CblasNoTrans,n,col,-1.0,F,n,b,1,1.0,ZmFb,1); /* KiZmFb = Ki * (Z - F * b); first, zero-out KiZmFb */ KiZmFb = new_zero_vector(n); if(Ki) { linalg_dsymv(n,1.0,Ki,n,ZmFb,1,0.0,KiZmFb,1); } else { for(i=0; i #include #include #include #include using namespace std; /* * Corr: * * the usual constructor function */ Corr::Corr(unsigned int dim, Base_Prior *base_prior) { this->dim = dim; col = base_prior->Col(); n = 0; linear = true; Vb_new = new_matrix(col, col); bmu_new = new_vector(col); K = Ki = Kchol = K_new = Kchol_new = Ki_new = NULL; log_det_K = log_det_K_new = 0.0; /* set priors */ assert(base_prior); this->base_prior = base_prior; } /* * ~Corr: * * the usual destructor function */ Corr::~Corr(void) { deallocate_new(); delete_matrix(Vb_new); free(bmu_new); } /* * NugInit: * * reset nug and linear (as passed via one of the inheretid corr * corr functions) eventually coming via a vector of doubles from * passt by R */ void Corr::NugInit(double nug, bool linear) { this->nug = nug; this->linear = linear; } /* Cov: * * copy just the covariance part from the * passed cc Corr module instace */ void Corr::Cov(Corr *cc) { /* there is no covarance matrix to copy */ if(cc->n == 0 || linear) return; allocate_new(cc->n); dup_matrix(K, cc->K, n, n); dup_matrix(Ki, cc->Ki, n, n); } /* * swap_new: * * swapping the real and utility quantities */ void Corr::swap_new(double **Vb, double **bmu, double *lambda) { if(! linear) { swap_matrix(K, K_new, n, n); swap_matrix(Ki, Ki_new, n, n); } swap_matrix(Vb, Vb_new, col, col); assert(*bmu != bmu_new); swap_vector(bmu, &bmu_new); assert(*bmu != bmu_new); *lambda = lambda_new; log_det_K = log_det_K_new; } /* * allocate_new: * * create new memory for auxillary covariance matrices */ void Corr::allocate_new(unsigned int n) { if(this->n == n) return; else { deallocate_new(); this->n = n; /* auxilliary matrices */ assert(!K_new); K_new = new_matrix(n, n); assert(!Ki_new); Ki_new = new_matrix(n, n); assert(!Kchol_new); Kchol_new = new_matrix(n, n); /* real matrices */ assert(!K); K = new_matrix(n, n); assert(!Ki); Ki = new_matrix(n, n); assert(!Kchol); Kchol = new_matrix(n, n); } } /* * invert: * * invert the covariance matrix K, * put the inverse in Ki, and use Kchol * as the work matrix */ // void Corr::Invert(unsigned int n) // { // if(! linear) { // assert(n == this->n); // inverse_chol(K, Ki, Kchol, n); // log_det_K = log_determinant_chol(Kchol, n); // } // else { // assert(n > 0); // log_det_K = n * log(1.0 + nug); // } // } /* * deallocate_new: * * free the memory used for auxilliaty covariance matrices */ void Corr::deallocate_new(void) { if(this->n == 0) return; if(K_new) { delete_matrix(K_new); K_new = NULL; assert(Ki_new); delete_matrix(Ki_new); Ki_new = NULL; assert(Kchol_new); delete_matrix(Kchol_new); Kchol_new = NULL; } assert(K_new == NULL && Ki_new == NULL && Kchol_new == NULL); if(K) { delete_matrix(K); K = NULL; assert(Ki); delete_matrix(Ki); Ki = NULL; assert(Kchol); delete_matrix(Kchol); Kchol = NULL; } assert(K == NULL && Ki == NULL && Kchol == NULL); n = 0; } /* * Nug: * * return the current value of the nugget parameter */ double Corr::Nug(void) { return nug; } /* * get_delta_nug: * * compute nug for two nugs (used in prune) */ double Corr::get_delta_nug(Corr* c1, Corr* c2, void *state) { double nugch[2]; int ii[2]; nugch[0] = c1->nug; nugch[1] = c2->nug; propose_indices(ii,0.5, state); return nugch[ii[0]]; } /* * propose_new_nug: * * propose new NUGGET parameters for possible * new children partitions */ void Corr::propose_new_nug(Corr* c1, Corr* c2, void *state) { if(prior->FixNug()) c1->nug = c2->nug = nug; else { int i[2]; double nugnew[2]; propose_indices(i, 0.5, state); nugnew[i[0]] = nug; nugnew[i[1]] = prior->NugDraw(state); c1->nug = nugnew[0]; c2->nug = nugnew[1]; } } /* * CombineNug: * * used in tree-prune steps, chooses one of two * sets of parameters to correlation functions, * and choose one for "this" correlation function */ void Corr::CombineNug(Corr *c1, Corr *c2, void *state) { nug = get_delta_nug(c1, c2, state); } /* * SplitNug: * * used in tree-grow steps, splits the parameters * of "this" correlation function into a parameterization * for two (new) correlation functions */ void Corr::SplitNug(Corr *c1, Corr *c2, void *state) { propose_new_nug(c1, c2, state); } /* * get_K: * * return the covariance matrix (K) */ double** Corr::get_K(void) { assert(K != NULL); return K; } /* * get_Ki: * * return the inverse covariance matrix (Ki) */ double** Corr::get_Ki(void) { assert(Ki != NULL); return Ki; } /* * getlog_det_K: * * return the log determinant of the covariance * matrix (K) */ double Corr::get_log_det_K(void) { return log_det_K; } /* * Linear: * * return the linear boolean indicator */ bool Corr::Linear(void) { return linear; } /* * log_NugPrior: * * compute the (log) prior for the nugget */ double Corr::log_NugPrior(void) { return prior->log_NugPrior(nug); } /* * printCorr * * prints only covariance matrix K */ void Corr::printCorr(unsigned int n) { if(K && !linear) { assert(this->n == n); matrix_to_file("K_debug.out", K, n, n); assert(Ki); matrix_to_file("Ki_debug.out", Ki, n, n); } else { assert(linear); double **Klin = new_id_matrix(n); for(unsigned int i=0; idim = dim; base_prior = NULL; gamlin[0] = 10; /* gamma for the linear pdf */ gamlin[1] = 0.2; /* min prob for the linear pdf */ gamlin[2] = 0.75; /* max-min prob for the linear pdf */ nug = 0.1; /* starting correlation nugget parameter */ default_nug_priors(); /* set nug_alpha and nug_beta */ default_nug_lambdas(); /* set nug_alpha_lambda and nug_beta_lambda */ } /* * Corr_Prior: (new duplicate) * * duplicate constructor function for the correllation function * module parameterized with a nugget */ Corr_Prior::Corr_Prior(Corr_Prior *c) { dim = c->dim; nug = c->nug; fix_nug = c->fix_nug; dupv(nug_alpha, c->nug_alpha, 2); dupv(nug_beta, c->nug_beta, 2); dupv(nug_alpha_lambda, c->nug_alpha_lambda, 2); dupv(nug_beta_lambda, c->nug_beta_lambda, 2); base_prior = NULL; } /* * ~Corr_Prior: * * destructor function for the correllation function module * parameterized with a nugget */ Corr_Prior::~Corr_Prior(void) { } /* * NugInit: * * read hiererchial prior parameters from a double-vector * */ void Corr_Prior::NugInit(double *dhier) { nug_alpha[0] = dhier[0]; nug_beta[0] = dhier[1]; nug_alpha[1] = dhier[2]; nug_beta[1] = dhier[3]; } /* * default_nug_priors: * * set nug prior parameters * to default values */ void Corr_Prior::default_nug_priors(void) { nug_alpha[0] = 1.0; nug_beta[0] = 1.0; nug_alpha[1] = 1.0; nug_beta[1] = 1.0; } /* * default_nug_lambdas: * * set nug (lambda) hierarchical prior parameters * to default values */ void Corr_Prior::default_nug_lambdas(void) { nug_alpha_lambda[0] = 0.5; nug_beta_lambda[0] = 10.0; nug_alpha_lambda[1] = 0.5; nug_beta_lambda[1] = 10.0; fix_nug = false; //fix_nug = true; } /* * fix_nug_prior: * * fix the nug priors (alpha, beta) so that * they are not estimated */ void Corr_Prior::fix_nug_prior(void) { fix_nug = true; } /* * read_double_nug: * * read the a prior parameter vector of doubles for * items pertaining to the nugget, coming from R */ void Corr_Prior::read_double_nug(double *dparams) { /* read the starting nugget value */ nug = dparams[0]; // MYprintf(MYstdout, "starting nug=%g\n", nug); /* the d parameter is at dparams[1], should change this later */ /* read nug gamma mixture prior parrameters */ get_mix_prior_params_double(nug_alpha, nug_beta, &(dparams[2]), "nug"); /* nug hierarchical lambda prior parameters */ if((int) dparams[6] == -1) { fix_nug = true; /* MYprintf(MYstdout, "fixing nug prior\n"); */} else { fix_nug = false; get_mix_prior_params_double(nug_alpha_lambda, nug_beta_lambda, &(dparams[6]), "nug lambda"); } /* reset dparams */ dparams += 10; /* read gamma linear pdf prior parameter */ dupv(gamlin, dparams, 3); /* print and sanity check the gamma linear pdf parameters */ // MYprintf(MYstdout, "gamlin=[%g,%g,%g]\n", gamlin[0], gamlin[1], gamlin[2]); assert(gamlin[0] == -1 || gamlin[0] >= 0); assert(gamlin[1] >= 0.0 && gamlin[1] <= 1); assert(gamlin[2] >= 0.0 && gamlin[2] <= 1); assert(gamlin[2] + gamlin[1] <= 1); } /* * read_ctrlfile_nug: * * read the a prior parameter the control file * items pertaining to the nugget */ void Corr_Prior::read_ctrlfile_nug(ifstream* ctrlfile) { char line[BUFFMAX], line_copy[BUFFMAX]; /* Read the starting nugget value */ ctrlfile->getline(line, BUFFMAX); nug = atof(strtok(line, " \t\n#")); MYprintf(MYstdout, "starting nug=%g\n", nug); /* read the nug gamma mixture prior parameters */ ctrlfile->getline(line, BUFFMAX); get_mix_prior_params(nug_alpha, nug_beta, line, "nug"); /* nug hierarchical lambda prior parameters */ ctrlfile->getline(line, BUFFMAX); strcpy(line_copy, line); if(!strcmp("fixed", strtok(line_copy, " \t\n#"))) { fix_nug = true; MYprintf(MYstdout, "fixing nug prior\n"); } else { fix_nug = false; get_mix_prior_params(nug_alpha_lambda, nug_beta_lambda, line, "nug lambda"); } /* read gamma linear pdf parameter */ ctrlfile->getline(line, BUFFMAX); gamlin[0] = atof(strtok(line, " \t\n#")); gamlin[1] = atof(strtok(NULL, " \t\n#")); gamlin[2] = atof(strtok(NULL, " \t\n#")); /* print and sanity check the gamma linear pdf parameters */ MYprintf(MYstdout, "lin[gam,min,max]=[%g,%g,%g]\n", gamlin[0], gamlin[1], gamlin[2]); assert(gamlin[0] == -1 || gamlin[0] >= 0); assert(gamlin[1] >= 0.0 && gamlin[1] <= 1); assert(gamlin[2] >= 0.0 && gamlin[2] <= 1); assert(gamlin[2] + gamlin[1] <= 1); } /* * Nug: * * return the starting nugget value */ double Corr_Prior::Nug(void) { return(nug); } /* * NugAlpha: * * return the starting nugget alpha parameter * vector for the mixture gamma prior */ double *Corr_Prior::NugAlpha(void) { return nug_alpha; } /* * NugBeta: * * return the starting nugget beta parameter * vector for the mixture gamma prior */ double *Corr_Prior::NugBeta(void) { return nug_beta; } /* * NugDraw * * sample a nugget value from the prior */ double Corr_Prior::NugDraw(void *state) { return nug_prior_rand(nug_alpha, nug_beta, state); } /* * DrawNugHeir: * * draws for the hierarchical priors for the nugget * contained in the params module */ void Corr_Prior::DrawNugHier(Corr **corr, unsigned int howmany, void *state) { if(!fix_nug) { double *nug = new_vector(howmany); for(unsigned int i=0; iNug(); mixture_priors_draw(nug_alpha, nug_beta, nug, howmany, nug_alpha_lambda, nug_beta_lambda, state); free(nug); } } /* * log_NugPrior: * * compute the (log) prior for the nugget */ double Corr_Prior::log_NugPrior(double nug) { return log_nug_prior_pdf(nug, nug_alpha, nug_beta); } /* * CorrModel: * * return an indicator of what type of correlation * model this is a generaic module for: e.g., exp, expsep */ CORR_MODEL Corr_Prior::CorrModel(void) { return corr_model; } /* * Linear: * * returns true if the prior is "forcing" a linear model */ bool Corr_Prior::Linear(void) { if(gamlin[0] == -1) return true; else return false; } /* * LLM: * * returns true if the prior is allwoing the LLM */ bool Corr_Prior::LLM(void) { if(gamlin[0] > 0) return true; else return false; } /* * ForceLinear: * * make the prior force the linear model by setting the * gamma (gamlin[0]) parameter to -1; return the new * gamma parameter */ double Corr_Prior::ForceLinear(void) { double gam = gamlin[0]; gamlin[0] = -1; return gam; } /* * ResetLinear: * * (re)-set the gamma linear parameter (gamlin[0]) * to the passed in gam value */ void Corr_Prior::ResetLinear(double gam) { gamlin[0] = gam; } /* * GamLin * * return the (three) vector of "gamma" prior parameters * governing the LLM booleans b */ double* Corr_Prior::GamLin(void) { return gamlin; } /* * Print: * * pretty print the correllation function (nugget) parameters out * to a file */ void Corr_Prior::PrintNug(FILE *outfile) { /* range parameter */ //MYprintf(outfile, "starting nug=%g\n", nug); /* range gamma prior */ MYprintf(outfile, "nug[a,b][0,1]=[%g,%g],[%g,%g]\n", nug_alpha[0], nug_beta[0], nug_alpha[1], nug_beta[1]); /* range gamma hyperprior */ if(fix_nug) MYprintf(outfile, "nug prior fixed\n"); else { MYprintf(MYstdout, "nug lambda[a,b][0,1]=[%g,%g],[%g,%g]\n", nug_alpha_lambda[0], nug_beta_lambda[0], nug_alpha_lambda[1], nug_beta_lambda[1]); } /* gamma linear parameters */ MYprintf(outfile, "gamlin=[%g,%g,%g]\n", gamlin[0], gamlin[1], gamlin[2]); } /* * log_NugHierPrior: * * return the log prior of the hierarchial parameters * to the correllation parameters (i.e., nugget) */ double Corr_Prior::log_NugHierPrior(void) { double lpdf; lpdf = 0.0; if(!fix_nug) { lpdf += mixture_hier_prior_log(nug_alpha, nug_beta, nug_alpha_lambda, nug_beta_lambda); } return lpdf; } /* * NugTrace: * * return the current values of the hierarchical * parameters to nugget of this correlation function: */ double* Corr_Prior::NugTrace(unsigned int* len) { *len = 4; double* trace = new_vector(*len); trace[0] = nug_alpha[0]; trace[1] = nug_beta[0]; trace[2] = nug_alpha[1]; trace[3] = nug_beta[1]; return trace; } /* * NugTraceNames: * * return the names of the traces recorded by Corr_Prior::NugTrace() */ char** Corr_Prior::NugTraceNames(unsigned int* len) { *len = 4; char** trace = (char**) malloc(sizeof(char*) * (*len)); trace[0] = strdup("nug.a0"); trace[1] = strdup("nug.g0"); trace[2] = strdup("nug.a1"); trace[3] = strdup("nug.g1"); return trace; } /* * FixNug: * * returns the fix_nug variable (not the prior) */ bool Corr_Prior::FixNug(void) { return nug_alpha[0] == 0; } tgp/src/tgp.cc0000644000176200001440000005671213531032535012747 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ extern "C" { #include "matrix.h" #include "rand_draws.h" #include "rhelp.h" #include "predict.h" } #include "tgp.h" #include "model.h" #include "params.h" #include "mstructs.h" #include #include #include #include #include #include extern "C" { Tgp* tgpm = NULL; void *tgp_state = NULL; void tgp(int* state_in, /* inputs from R */ double *X_in, int *n_in, int *d_in, double *Z_in, double *XX_in, int *nn_in, double *Xsplit_in, int *nsplit_in, int *trace_in, int *BTE_in, int* R_in, int* linburn_in, int *zcov_in, int *g_in, double *params_in, double *ditemps_in, int *verb_in, double *dtree_in, double* hier_in, int *MAP_in, int *sens_ngrid, double *sens_span, double *sens_Xgrid_in, /* output dimensions for checking NULL */ int* predn_in, int* nnprime_in, int *krige_in, int* Ds2x_in, int *improv_in, /* outputs to R */ double *Zp_mean_out, double *ZZ_mean_out, double *Zp_km_out, double *ZZ_km_out, double *Zp_kvm_out, double *ZZ_kvm_out, double *Zp_q_out, double *ZZ_q_out, double *Zp_s2_out, double *ZZ_s2_out, double *ZpZZ_s2_out, double *Zp_ks2_out, double *ZZ_ks2_out, double *Zp_q1_out, double *Zp_median_out, double *Zp_q2_out, double *ZZ_q1_out, double *ZZ_median_out, double *ZZ_q2_out, double *Ds2x_out, double *improv_out, int *irank_out, double *ess_out, double *gpcs_rates_out, double *sens_ZZ_mean_out, double *sens_ZZ_q1_out, double *sens_ZZ_q2_out, double *sens_S_out, double *sens_T_out) { /* create the RNG state */ unsigned int lstate = three2lstate(state_in); tgp_state = newRNGstate(lstate); /* possibly create NULL pointers that couldn't be passed by .C -- not sure if all are needed */ if(dtree_in[0] < 0) dtree_in = NULL; if(hier_in[0] < 0) hier_in = NULL; if((*predn_in * *n_in) == 0) Zp_q1_out = Zp_q_out = Zp_q2_out = Zp_median_out = Zp_mean_out = NULL; if(*nnprime_in == 0) ZZ_q1_out = ZZ_q_out = ZZ_q2_out = ZZ_median_out = ZZ_mean_out = NULL; if((*krige_in * *predn_in * *n_in) == 0) Zp_km_out = Zp_kvm_out = Zp_ks2_out = NULL; if((*krige_in * *nnprime_in) == 0) ZZ_km_out = ZZ_kvm_out = ZZ_ks2_out = NULL; if((*Ds2x_in * *nnprime_in) == 0) Ds2x_out = NULL; if((*improv_in * *nnprime_in) == 0) { improv_out = NULL; irank_out = NULL; } /* copy the input parameters to the tgp class object where all the MCMC work gets done */ tgpm = new Tgp(tgp_state, *n_in, *d_in, *nn_in, BTE_in[0], BTE_in[1], BTE_in[2], *R_in, *linburn_in, (bool) (Zp_mean_out!=NULL), (bool) ((Zp_ks2_out!=NULL) || (ZZ_ks2_out!=NULL)), (bool) (Ds2x_out!=NULL), g_in[0], (bool) (*sens_ngrid > 0), X_in, Z_in, XX_in, Xsplit_in, *nsplit_in, params_in, ditemps_in, (bool) *trace_in, *verb_in, dtree_in, hier_in); /* post constructor initialization */ tgpm->Init(); /* tgp MCMC rounds are done here */ if(*MAP_in) tgpm->Predict(); else tgpm->Rounds(); /* gather the posterior predictive statistics from the MCMC rounds */ tgpm->GetStats(!((bool)*MAP_in), Zp_mean_out, ZZ_mean_out, Zp_km_out, ZZ_km_out, Zp_kvm_out, ZZ_kvm_out, Zp_q_out, ZZ_q_out, (bool) (*zcov_in), Zp_s2_out, ZZ_s2_out, ZpZZ_s2_out, Zp_ks2_out, ZZ_ks2_out, Zp_q1_out, Zp_median_out, Zp_q2_out, ZZ_q1_out, ZZ_median_out, ZZ_q2_out, Ds2x_out, improv_out, g_in[1], irank_out, ess_out); /* sensitivity analysis? */ if((bool) (*sens_ngrid > 0)) tgpm->Sens(sens_ngrid, sens_span, sens_Xgrid_in, sens_ZZ_mean_out, sens_ZZ_q1_out, sens_ZZ_q2_out, sens_S_out, sens_T_out); /* get (possibly unchanged) pseudo--prior used by Importance Tempering (only) */ tgpm->GetPseudoPrior(ditemps_in); /* get the (tree) acceptance rates */ tgpm->GetTreeStats(gpcs_rates_out); /* delete the tgp model */ delete tgpm; tgpm = NULL; /* destroy the RNG */ deleteRNGstate(tgp_state); tgp_state = NULL; } /* * Tgp: (constructor) * * copies the input passed to the tgp function from R via * .C("tgp", ..., PACKAGE="tgp"). Then, it calls the init * function in order to get everything ready for MCMC rounds. */ Tgp::Tgp(void *state, int n, int d, int nn, int B, int T, int E, int R, int linburn, bool pred_n, bool krige, bool delta_s2, int improv, bool sens, double *X, double *Z, double *XX, double *Xsplit, int nsplit, double *dparams, double *ditemps, bool trace, int verb, double *dtree, double *hier) { itime = time(NULL); /* a bunch of NULL entries to be filled in later */ this->state = NULL; this->X = this->XX = NULL; this->rect = NULL; this->Z = NULL; params = NULL; model = NULL; cump = preds = NULL; /* RNG state */ this->state = state; /* integral dimension parameters */ this->n = (unsigned int) n; this->d = (unsigned int) d; this->nn = (unsigned int) nn; /* MCMC round information */ this->B = B; this->T = T; this->E = E; this->R = R; this->linburn = linburn; /* types of predictive data to gather */ this->pred_n = pred_n; this->krige = krige; this->delta_s2 = delta_s2; this->improv = improv; /* is this a sensitivity analysis? */ this->sens = sens; /* importance tempring */ this->its = new Temper(ditemps); /* saving output and printing progress */ this->trace = trace; this->verb = verb; /* PROBABLY DON'T NEED TO ACTUALLY DUPLICATE THESE MATRICES -- COULD USE new_matrix_bones INSTEAD */ /* copy X from input */ assert(X); this->X = new_matrix(n, d); dupv(this->X[0], X, n*d); /* copy Z from input */ this->Z = new_dup_vector(Z, n); /* copy XX from input */ this->XX = new_matrix(nn, d); if(this->XX) dupv(this->XX[0], XX, nn*d); /* copy Xsplit from input -- this determines the bounding rectangle AND the tree split locations */ assert(nsplit > 0); this->Xsplit = new_matrix(nsplit, d); dupv(this->Xsplit[0], Xsplit, nsplit*d); this->nsplit = nsplit; /* to be filled in by Init() */ params = NULL; rect = NULL; model = NULL; cump = NULL; /* former parameters to Init() */ this->dparams = dparams; if(dtree) { treecol = (unsigned int) dtree[0]; tree = dtree+1; } else { treecol = 0; tree = NULL; } this->hier = hier; } /* * ~Tgp: (destructor) * * typical destructor function. Checks to see if the class objects * are NULL first because this might be called from within * tgp_cleanup if tgp was interrupted during computation */ Tgp::~Tgp(void) { /* clean up */ if(model) { delete model; model = NULL; } if(params) { delete params; params = NULL; } if(XX) { delete_matrix(XX); XX = NULL; } if(Xsplit) { delete_matrix(Xsplit); Xsplit = NULL; } if(Z) { free(Z); Z = NULL; } if(rect) { delete_matrix(rect); rect = NULL; } if(X) { delete_matrix(X); X = NULL; } if(cump) { delete_preds(cump); } if(preds) { delete_preds(preds); } if(its) { delete its; } } /* * Init: * * get everything ready for MCMC rounds -- should only be called just * after the Tgp constructor function, in order to separate the copying * of the input parameters from the initialization of the model * and predictive data, but in case there are any errors in Initialization * the tgp_cleanup function still has a properly built Tgp module to * destroy. */ void Tgp::Init(void) { /* use default parameters */ params = new Params(d); if((int) dparams[0] != -1) params->read_double(dparams); else MYprintf(MYstdout, "Using default params.\n"); /* get the rectangle */ /* rect = getXdataRect(X, n, d, XX, nn); */ /* now Xsplit governs the rectangle */ rect = get_data_rect(Xsplit, nsplit, d); /* construct the new model */ model = new Model(params, d, rect, 0, trace, state); model->Init(X, n, d, Z, its, tree, treecol, hier); model->Outfile(MYstdout, verb); /* if treed partitioning is allowed, then set the splitting locations (Xsplit) */ if(params->isTree()) model->set_Xsplit(Xsplit, nsplit, d); /* structure for accumulating predictive information */ cump = new_preds(XX, nn, pred_n*n, d, rect, R*(T-B), pred_n, krige, its->IT_ST_or_IS(), delta_s2, improv, sens, E); /* make sure the first col still indicates the coarse or fine process */ if(params->BasePrior()->BaseModel() == GP){ if( ((Gp_Prior*) params->BasePrior())->CorrPrior()->CorrModel() == MREXPSEP ){ for(unsigned int i=0; iXX[i][0] == XX[i][0]); } } /* print the parameters of this module */ if(verb >= 2) Print(MYstdout); } /* * Rounds: * * Actually do the MCMC for sampling from the posterior of the tgp model * based on the parameterization given to the Tgp constructor. */ void Tgp::Rounds(void) { for(unsigned int i=0; iLinburn(B, state); /* Stochastic Approximation burn-in rounds to jump-start the psuedo-prior for ST */ if(i == 0 && its->DoStochApprox()) { model->StochApprox(T, state); } else { /* do model rounds 1 thru B (burn in) */ model->Burnin(B, state); } /* do the MCMC rounds B,...,T */ preds = new_preds(XX, nn, pred_n*n, d, rect, T-B, pred_n, krige, its->IT_ST_or_IS(), delta_s2, improv, sens, E); model->Sample(preds, T-B, state); /* print tree statistics */ if(verb >= 1) model->PrintTreeStats(MYstdout); /* accumulate predictive information */ import_preds(cump, preds->R * i, preds); delete_preds(preds); preds = NULL; /* done with this repetition */ /* prune the tree all the way back unless importance tempering */ if(R > 1) { if(verb >= 1) MYprintf(MYstdout, "finished repetition %d of %d\n", i+1, R); if(its->Numit() == 1) model->cut_root(); } /* if importance tempering, then update the pseudo-prior based on the observation counts */ if(its->Numit() > 1) its->UpdatePrior(model->update_tprobs(), its->Numit()); } /* cap off the printing */ if(verb >= 1) MYflush(MYstdout); /* print the rectangle of the MAP partition */ model->PrintBestPartitions(); /* print the splits of the best tree for each height */ model->PrintPosteriors(); /* this should only happen if trace==TRUE */ model->PrintLinarea(); /*******/ model->MAPreplace(); /* write the preds out to files */ if(trace && T-B>0) { if(nn > 0) { /* at predictive locations */ matrix_to_file("trace_ZZ_1.out", cump->ZZ, cump->R, nn); if(cump->ZZm) matrix_to_file("trace_ZZkm_1.out", cump->ZZm, cump->R, nn); if(cump->ZZs2) matrix_to_file("trace_ZZks2_1.out", cump->ZZs2, cump->R, nn); } if(pred_n) { /* at the data locations */ matrix_to_file("trace_Zp_1.out", cump->Zp, cump->R, n); if(cump->Zpm) matrix_to_file("trace_Zpkm_1.out", cump->Zpm, cump->R, n); if(cump->Zps2) matrix_to_file("trace_Zpks2_1.out", cump->Zps2, cump->R, n); } /* write improv */ if(improv) matrix_to_file("trace_improv_1.out", cump->improv, cump->R, nn); /* Ds2x is un-normalized, it needs to be divited by nn everywhere */ if(delta_s2) matrix_to_file("trace_Ds2x_1.out", cump->Ds2x, cump->R, nn); } /* copy back the itemps */ model->DupItemps(its); } /* * SampleMAP: * * Only do sampling from the posterior predictive distribution; * that is, don't update GP or Tree */ void Tgp::Predict(void) { /* don't need multiple rounds R when just kriging */ if(R > 1) warning("R=%d (>0) not necessary for Kriging", R); for(unsigned int i=0; iIT_ST_or_IS(), delta_s2, improv, sens, E); model->Predict(preds, T-B, state); /* accumulate predictive information */ import_preds(cump, preds->R * i, preds); delete_preds(preds); preds = NULL; /* done with this repetition; prune the tree all the way back */ if(R > 1) { MYprintf(MYstdout, "finished repetition %d of %d\n", i+1, R); // model->cut_root(); } } /* cap of the printing */ if(verb >= 1) MYflush(MYstdout); /* these is here to maintain compatibility with tgp::Rounds() */ /* print the rectangle of the MAP partition */ model->PrintBestPartitions(); /* print the splits of the best tree for each height */ model->PrintPosteriors(); /* this should only happen if trace==TRUE */ model->PrintLinarea(); /* write the preds out to files */ if(trace && T-B>0) { if(nn > 0) { matrix_to_file("trace_ZZ_1.out", cump->ZZ, cump->R, nn); if(cump->ZZm) matrix_to_file("trace_ZZkm_1.out", cump->ZZm, cump->R, nn); if(cump->ZZs2) matrix_to_file("trace_ZZks2_1.out", cump->ZZs2, cump->R, nn); } if(pred_n) { matrix_to_file("trace_Zp_1.out", cump->Zp, cump->R, n); if(cump->Zpm) matrix_to_file("trace_Zpkm_1.out", cump->Zpm, cump->R, n); if(cump->Zps2) matrix_to_file("trace_Zpks2_1.out", cump->Zps2, cump->R, n); } if(improv) matrix_to_file("trace_improv_1.out", cump->improv, cump->R, nn); } } /* * Sens: * * function for post-procesing a sensitivity analysis * performed on a tgp model -- this is the sensitivity version of the * GetStats function */ void Tgp::Sens(int *ngrid_in, double *span_in, double *sens_XX, double *sens_ZZ_mean, double *sens_ZZ_q1,double *sens_ZZ_q2, double *sens_S, double *sens_T) { /* Calculate the main effects sample: based on M1 only for now. */ // unsigned int bmax = model->get_params()->T_bmax(); int colj; int ngrid = *ngrid_in; double span = *span_in; double **ZZsample = new_zero_matrix(cump->R, ngrid*cump->d); unsigned int nm = cump->nm; double *XXdraw = new_vector(nm); for(unsigned int i=0; iR; i++) { /* real-valued predictors */ for(unsigned int j=0; jshape[j] == 0) continue; /* categorical; do later */ for(unsigned int k=0; kM[i][k*cump->d + j]; colj = j*ngrid; move_avg(ngrid, &sens_XX[j*ngrid], &ZZsample[i][colj], nm, XXdraw, cump->ZZ[i], span); } /* categorical predictors */ for(unsigned int j=0; jshape[j] != 0) continue; /* continuous; did earlier */ unsigned int n0 = 0; for(unsigned int k=0; kM[i][k*cump->d + j] == 0){ n0++; colj = j*ngrid; ZZsample[i][colj] += cump->ZZ[i][k]; } else{ colj = (j+1)*(ngrid)-1; ZZsample[i][colj] += cump->ZZ[i][k]; } } /* assign for each of {0,1} */ ZZsample[i][j*ngrid] = ZZsample[i][j*ngrid]/((double) n0); ZZsample[i][(j+1)*(ngrid)-1] = ZZsample[i][(j+1)*(ngrid)-1]/((double) (nm-n0) ); } } /* calculate the average of the columns of ZZsample */ wmean_of_columns(sens_ZZ_mean, ZZsample, cump->R, ngrid*cump->d, NULL); /* allocate pointers for holding q1 and q2 */ double q[2] = {0.05, 0.95}; double **Q = (double**) malloc(sizeof(double*) * 2); Q[0] = sens_ZZ_q1; Q[1] = sens_ZZ_q2; quantiles_of_columns(Q, q, 2, ZZsample, cump->R, ngrid*cump->d, NULL); free(XXdraw); delete_matrix(ZZsample); free(Q); /* variability indices S and total variability indices T are calculated here */ for(unsigned int i=0; iR; i++) sobol_indices(cump->ZZ[i], cump->nm, cump->d, &(sens_S[i*(cump->d)]), &(sens_T[i*(cump->d)])); } /* * GetStats: * * Coalate the statistics from the samples of the posterior predictive * distribution gathered during the MCMC Tgp::Rounds() function * * argument indicates whether to report traces (e.g., for wlambda); i.e., * if Kriging (rather than Rounds) then parameters are fixed, so there * is no need for traces of weights because they should be constant */ void Tgp::GetStats(bool report, double *Zp_mean, double *ZZ_mean, double *Zp_km, double *ZZ_km, double *Zp_kvm, double *ZZ_kvm, double *Zp_q, double *ZZ_q, bool zcov, double *Zp_s2, double *ZZ_s2, double *ZpZZ_s2, double *Zp_ks2, double *ZZ_ks2, double *Zp_q1, double *Zp_median, double *Zp_q2, double *ZZ_q1, double *ZZ_median, double *ZZ_q2, double *Ds2x, double *improvec, int numirank, int* irank, double *ess) { itime = MY_r_process_events(itime); /* possibly adjust weights by the chosen lambda method, and possibly write the trace out to a file*/ double *w = NULL; if(its->IT_ST_or_IS()) { ess[0] = its->LambdaIT(cump->w, cump->itemp, cump->R, ess+1, verb); if(trace && report) vector_to_file("trace_wlambda_1.out", cump->w, cump->R); w = cump->w; } else { ess[0] = ess[1] = ess[2] = cump->R; } /* allocate pointers for holding q1 median and q3 */ /* TADDY's IQR settings double q[3] = {0.25, 0.5, 0.75};*/ double q[3] = {0.05, 0.5, 0.95}; double **Q = (double**) malloc(sizeof(double*) * 3); /* calculate means and quantiles */ if(T-B>0 && pred_n) { assert(n == cump->n); /* mean */ wmean_of_columns(Zp_mean, cump->Zp, cump->R, n, w); /* kriging mean */ if(Zp_km) wmean_of_columns(Zp_km, cump->Zpm, cump->R, n, w); if(Zp_km) wvar_of_columns(Zp_kvm, cump->Zpvm, cump->R, n, w); /* variance (computed from samples Zp) */ if(zcov) { double **Zp_s2_M = (double**) malloc(sizeof(double*) * n); Zp_s2_M[0] = Zp_s2; for(unsigned int i=1; iZp, Zp_mean, cump->R, n, w); free(Zp_s2_M); } else { wmean_of_columns_f(Zp_s2, cump->Zp, cump->R, n, w, sq); for(unsigned int i=0; iZps2, cump->R, n, w); /* quantiles and medians */ Q[0] = Zp_q1; Q[1] = Zp_median; Q[2] = Zp_q2; quantiles_of_columns(Q, q, 3, cump->Zp, cump->R, n, w); for(unsigned int i=0; i0 && nn>0 && !sens) { /* mean */ wmean_of_columns(ZZ_mean, cump->ZZ, cump->R, nn, w); /* kriging mean */ if(ZZ_km) wmean_of_columns(ZZ_km, cump->ZZm, cump->R, nn, w); if(ZZ_km) wvar_of_columns(ZZ_kvm, cump->ZZvm, cump->R, nn, w); /* variance (computed from samples ZZ) */ if(zcov) { /* calculate the covarince between all predictive locations */ double **ZZ_s2_M = (double **) malloc(sizeof(double*) * nn); ZZ_s2_M[0] = ZZ_s2; for(unsigned int i=1; iZZ, ZZ_mean, cump->R, nn, w); free(ZZ_s2_M); } else { /* just the variance */ wmean_of_columns_f(ZZ_s2, cump->ZZ, cump->R, nn, w, sq); for(unsigned int i=0; iZp, cump->ZZ, Zp_mean, ZZ_mean, cump->R, n, nn, w); free(ZpZZ_s2_M); } /* kriging variance */ if(ZZ_ks2) wmean_of_columns(ZZ_ks2, cump->ZZs2, cump->R, nn, w); /* quantiles and medians */ Q[0] = ZZ_q1; Q[1] = ZZ_median; Q[2] = ZZ_q2; quantiles_of_columns(Q, q, 3, cump->ZZ, cump->R, cump->nn, w); for(unsigned int i=0; iDs2x) { assert(delta_s2); wmean_of_columns(Ds2x, cump->Ds2x, cump->R, cump->nn, w); } /* improv (minima) */ if(improv) { assert(cump->improv); wmean_of_columns(improvec, cump->improv, cump->R, cump->nn, w); int *ir = (int*) GetImprovRank(cump->R, cump->nn, cump->improv, improv, numirank, w); dupiv(irank, ir, nn); free(ir); } } /* clean up */ free(Q); } /* * tgp_cleanup * * function for freeing memory when tgp is interrupted * by R, so that there won't be a (big) memory leak. It frees * the major chunks of memory, but does not guarentee to * free up everything */ void tgp_cleanup(void) { /* free the RNG state */ if(tgp_state) { deleteRNGstate(tgp_state); tgp_state = NULL; if(tgpm->Verb() >= 1) MYprintf(MYstderr, "INTERRUPT: tgp RNG leaked, is now destroyed\n"); } /* free tgp model */ if(tgpm) { if(tgpm->Verb() >= 1) MYprintf(MYstderr, "INTERRUPT: tgp model leaked, is now destroyed\n"); delete tgpm; tgpm = NULL; } } } /* extern "C" */ /* * getXdataRect: * * given the data Xall (Nxd), infer the rectancle * from IFace class */ double ** getXdataRect(double **X, unsigned int n, unsigned int d, double **XX, unsigned int nn) { unsigned int N = nn+n; double **Xall = new_matrix(N, d); dupv(Xall[0], X[0], n*d); if(nn > 0) dupv(Xall[n], XX[0], nn*d); double **rect = get_data_rect(Xall, N, d); delete_matrix(Xall); return rect; } /* * Print: * * print the settings of the parameters used by this module: * which basically summarize the data and MCMC-related inputs * followed by a call to the model Print function */ void Tgp::Print(FILE *outfile) { MYprintf(MYstdout, "\n"); /* DEBUG: print the input parameters */ MYprintf(MYstdout, "n=%d, d=%d, nn=%d\nBTE=(%d,%d,%d), R=%d, linburn=%d\n", n, d, nn, B, T, E, R, linburn); /* print the importance tempring information */ its->Print(MYstdout); /* print the random number generator state */ printRNGstate(state, MYstdout); /* print predictive statistic types */ if(pred_n || (delta_s2 || improv)) MYprintf(MYstdout, "preds:"); if(pred_n) MYprintf(MYstdout, " data"); if(krige && (pred_n || nn)) MYprintf(MYstdout, " krige"); if(delta_s2) MYprintf(MYstdout, " ALC"); if(improv) MYprintf(MYstdout, " improv"); if(pred_n || (((krige && (pred_n || nn)) || delta_s2) || improv)) MYprintf(MYstdout, "\n"); MYflush(MYstdout); /* print the model, uses the internal model printing variable OUTFILE */ model->Print(); } /* * Verb: * * returns the verbosity level */ int Tgp::Verb(void) { return verb; } /* * GetPseudoPrior: * * write the iTemps->tprobs to the last n entries * of the ditemps vector */ void Tgp::GetPseudoPrior(double *ditemps) { its->CopyPrior(ditemps); } /* * GetTreeStats: * * get the (Tree) acceptance rates for (G)row, (P)rune, * (C)hange and (S)wap tree operations in the model module */ void Tgp::GetTreeStats(double *gpcs) { model->TreeStats(gpcs); } tgp/src/randomkit.c0000644000176200001440000001617413531032535014000 0ustar liggesusers/* Random kit 1.3 */ /* * Copyright (c) 2003-2005, Jean-Sebastien Roy (js@jeannot.org) * * The rk_random and rk_seed functions algorithms and the original design of * the Mersenne Twister RNG: * * Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura, * All rights reserved. * * Original algorithm for the implementation of rk_interval function from * Richard J. Wagner's implementation of the Mersenne Twister RNG, optimised by * Magnus Jonsson. * * Constants used in the rk_double implementation by Isaku Wada. * * Permission is hereby granted, free of charge, to any person obtaining a * copy of this software and associated documentation files (the * "Software"), to deal in the Software without restriction, including * without limitation the rights to use, copy, modify, merge, publish, * distribute, sublicense, and/or sell copies of the Software, and to * permit persons to whom the Software is furnished to do so, subject to * the following conditions: * * The above copyright notice and this permission notice shall be included * in all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. */ /* static char const rcsid[] = "@(#) $Jeannot: randomkit.c,v 3.28 2005/07/21 22:14:09 js Exp $"; */ #include #include #include #include #include #include #include #ifdef _WIN32 /* Windows */ #include #ifndef RK_NO_WINCRYPT /* Windows crypto */ #ifndef _WIN32_WINNT #define _WIN32_WINNT 0x0400 #endif #include #include #endif #else /* Unix */ #include #include #endif #include "randomkit.h" #ifndef RK_DEV_URANDOM #define RK_DEV_URANDOM "/dev/urandom" #endif #ifndef RK_DEV_RANDOM #define RK_DEV_RANDOM "/dev/random" #endif char *rk_strerror[RK_ERR_MAX] = { "no error", "random device unvavailable" }; /* static functions */ static unsigned long rk_hash(unsigned long key); void rk_seed(unsigned long seed, rk_state *state) { int pos; seed &= 0xffffffffUL; /* Knuth's PRNG as used in the Mersenne Twister reference implementation */ for (pos=0; poskey[pos] = seed; seed = (1812433253UL * (seed ^ (seed >> 30)) + pos + 1) & 0xffffffffUL; } state->pos = RK_STATE_LEN; state->has_gauss = 0; } /* Thomas Wang 32 bits integer hash function */ unsigned long rk_hash(unsigned long key) { key += ~(key << 15); key ^= (key >> 10); key += (key << 3); key ^= (key >> 6); key += ~(key << 11); key ^= (key >> 16); return key; } rk_error rk_randomseed(rk_state *state) { #ifndef _WIN32 struct timeval tv; #else struct _timeb tv; #endif if(rk_devfill(state->key, sizeof(state->key), 0) == RK_NOERR) { state->key[0] |= 0x80000000UL; /* ensures non-zero key */ state->pos = RK_STATE_LEN; state->has_gauss = 0; return RK_NOERR; } #ifndef _WIN32 gettimeofday(&tv, NULL); rk_seed(rk_hash(getpid()) ^ rk_hash(tv.tv_sec) ^ rk_hash(tv.tv_usec) ^ rk_hash(clock()), state); #else _ftime(&tv); rk_seed(rk_hash(tv.time) ^ rk_hash(tv.millitm) ^ rk_hash(clock()), state); #endif return RK_ENODEV; } /* Magic Mersenne Twister constants */ #define N 624 #define M 397 #define MATRIX_A 0x9908b0dfUL #define UPPER_MASK 0x80000000UL #define LOWER_MASK 0x7fffffffUL /* Slightly optimised reference implementation of the Mersenne Twister */ unsigned long rk_random(rk_state *state) { unsigned long y; if (state->pos == RK_STATE_LEN) { int i; for (i=0;ikey[i] & UPPER_MASK) | (state->key[i+1] & LOWER_MASK); state->key[i] = state->key[i+M] ^ (y>>1) ^ (-(y & 1) & MATRIX_A); } for (;ikey[i] & UPPER_MASK) | (state->key[i+1] & LOWER_MASK); state->key[i] = state->key[i+(M-N)] ^ (y>>1) ^ (-(y & 1) & MATRIX_A); } y = (state->key[N-1] & UPPER_MASK) | (state->key[0] & LOWER_MASK); state->key[N-1] = state->key[M-1] ^ (y>>1) ^ (-(y & 1) & MATRIX_A); state->pos = 0; } y = state->key[state->pos++]; /* Tempering */ y ^= (y >> 11); y ^= (y << 7) & 0x9d2c5680UL; y ^= (y << 15) & 0xefc60000UL; y ^= (y >> 18); return y; } long rk_long(rk_state *state) { return rk_ulong(state) >> 1; } unsigned long rk_ulong(rk_state *state) { #if ULONG_MAX <= 0xffffffffUL return rk_random(state); #else return (rk_random(state) << 32) | (rk_random(state)); #endif } unsigned long rk_interval(unsigned long max, rk_state *state) { unsigned long mask = max, value; if (max == 0) return 0; /* Smallest bit mask >= max */ mask |= mask >> 1; mask |= mask >> 2; mask |= mask >> 4; mask |= mask >> 8; mask |= mask >> 16; #if ULONG_MAX > 0xffffffffUL mask |= mask >> 32; #endif /* Search a random value in [0..mask] <= max */ while ((value = (rk_ulong(state) & mask)) > max); return value; } double rk_double(rk_state *state) { /* shifts : 67108864 = 0x4000000, 9007199254740992 = 0x20000000000000 */ long a = rk_random(state) >> 5, b = rk_random(state) >> 6; return (a * 67108864.0 + b) / 9007199254740992.0; } void rk_fill(void *buffer, size_t size, rk_state *state) { unsigned long r; unsigned char *buf = buffer; for (; size >= 4; size -= 4) { r = rk_random(state); *(buf++) = r & 0xFF; *(buf++) = (r >> 8) & 0xFF; *(buf++) = (r >> 16) & 0xFF; *(buf++) = (r >> 24) & 0xFF; } if (!size) return; r = rk_random(state); for (; size; r >>= 8, size --) *(buf++) = (unsigned char)(r & 0xFF); } rk_error rk_devfill(void *buffer, size_t size, int strong) { #ifndef _WIN32 FILE *rfile; int done; if (strong) rfile = fopen(RK_DEV_RANDOM, "rb"); else rfile = fopen(RK_DEV_URANDOM, "rb"); if (rfile == NULL) return RK_ENODEV; done = fread(buffer, size, 1, rfile); fclose(rfile); if (done) return RK_NOERR; #else #ifndef RK_NO_WINCRYPT HCRYPTPROV hCryptProv; BOOL done; if (!CryptAcquireContext(&hCryptProv, NULL, NULL, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) || !hCryptProv) return RK_ENODEV; done = CryptGenRandom(hCryptProv, size, (unsigned char *)buffer); CryptReleaseContext(hCryptProv, 0); if (done) return RK_NOERR; #endif #endif return RK_ENODEV; } rk_error rk_altfill(void *buffer, size_t size, int strong, rk_state *state) { rk_error err; err = rk_devfill(buffer, size, strong); if (err) rk_fill(buffer, size, state); return err; } double rk_gauss(rk_state *state) { if (state->has_gauss) { state->has_gauss = 0; return state->gauss; } else { double f, x1, x2, r2; do { x1 = 2.0*rk_double(state) - 1.0; x2 = 2.0*rk_double(state) - 1.0; r2 = x1*x1 + x2*x2; } while (r2 >= 1.0 || r2 == 0.0); f = sqrt(-2.0*log(r2)/r2); /* Box-Muller transform */ state->has_gauss = 1; state->gauss = f*x1; /* Keep for next call */ return f*x2; } } tgp/src/base.h0000644000176200001440000001243613531032535012724 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __BASE_H__ #define __BASE_H__ extern "C" { #include "rhelp.h" } #include using namespace std; typedef enum BASE_MODEL {GP=901} BASE_MODEL; class Model; class Tree; class Base_Prior; /* * CLASS for the generic implementation of a base model * e.g., a Gaussian Process (GP) */ class Base { private: protected: bool pcopy; /* is this a private copy of the prior? */ Base_Prior *prior; /* Base (Gaussian Process) prior module */ unsigned int d; /* dim for X of input variables */ unsigned int col; /* dim for design */ unsigned int n; /* number of input data points-- rows in the design matrix */ unsigned int nn; /* number of predictive input data locations */ double **X; /* pointer to inputs X from tree module */ double **XX; /* pointer to inputs XX from tree module */ double *Z; /* pointer to responses Z from tree module */ double mean; /* mean of the Zs */ double itemp; /* importance annealing inv-temperature */ FILE* OUTFILE; /* where to print tree-specific info */ int verb; /* printing level (0=none, ... , 3+=verbose) */ public: Base(unsigned int d, Base_Prior *prior, Model *model); Base(double **X, double *Z, Base *gp_old, bool economy); virtual ~Base(void); BASE_MODEL BaseModel(void); Base_Prior* Prior(void); virtual Base* Dup(double **X, double *Z, bool economy)=0; virtual void Clear(void)=0; virtual void ClearPred(void)=0; virtual void Update(double **X, unsigned int n, unsigned int d, double *Z)=0; virtual void UpdatePred(double **XX, unsigned int nn, unsigned int d, bool Ds2xy)=0; virtual bool Draw(void *state)=0; virtual void Predict(unsigned int n, double *zp, double *zpm, double *zpvm, double *zps2, unsigned int nn, double *zz, double *zzm, double *zzvm, double *zzs2, double **ds2xy, double *improv, double Zmin, bool err, void *state)=0; virtual void Match(Base* gp_old)=0; virtual void Combine(Base *l_gp, Base *r_gp, void *state)=0; virtual void Split(Base *l_gp, Base *r_gp, void *state)=0; virtual void Compute(void)=0; virtual void ForceLinear(void)=0; virtual void ForceNonlinear(void)=0; virtual bool Linear(void)=0; virtual bool Constant(void)=0; virtual void printFullNode(void)=0; virtual double Var(void)=0; virtual double Posterior(void)=0; virtual double MarginalLikelihood(double itemp)=0; virtual double FullPosterior(double itemp)=0; virtual double MarginalPosterior(double itemp)=0; virtual double Likelihood(double itemp)=0; virtual char* State(unsigned int which)=0; virtual unsigned int sum_b(void)=0; virtual void Init(double *dbase)=0; virtual void X_to_F(unsigned int n, double **X, double **F)=0; virtual double* Trace(unsigned int* len, bool full)=0; virtual char** TraceNames(unsigned int* len, bool full)=0; virtual double NewInvTemp(double itemp, bool isleaf)=0; unsigned int N(void); }; /* * generic CLASS for the prior to the correlation function * including a nugget parameter */ class Base_Prior { private: protected: unsigned int d; /* col dimension of the data */ unsigned int col; /* col dimension of the design (eg F for GP) */ BASE_MODEL base_model; /* indicator for type of model (e.g., GP) */ public: /* start public functions */ Base_Prior(unsigned int d); Base_Prior(Base_Prior* prior); virtual ~Base_Prior(void); BASE_MODEL BaseModel(void); unsigned int Col(void); virtual void read_ctrlfile(std::ifstream* ctrlfile)=0; virtual void read_double(double *dparams)=0; virtual void Init(double *dhier)=0; virtual void Draw(Tree** leaves, unsigned int numLeaves, void *state)=0; virtual bool LLM(void)=0; virtual double ForceLinear(void)=0; virtual void ResetLinear(double gamb)=0; virtual void Print(FILE* outfile)=0; virtual Base* newBase(Model *model)=0; virtual Base_Prior* Dup(void)=0; virtual double log_HierPrior(void)=0; virtual double* Trace(unsigned int* len, bool full)=0; virtual char** TraceNames(unsigned int* len, bool full)=0; virtual double GamLin(unsigned int which)=0; }; #endif tgp/src/sim.cc0000644000176200001440000006512713726653664012767 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ extern "C" { #include "rhelp.h" #include "matrix.h" #include "lh.h" #include "rand_draws.h" // this fixes a problem with clang-11 conflict with string.h int linalg_dpotrf(int n, double **var); // #include "linalg.h" // Alternatively, use -DDO_NOT_USE_CXX_HEADERS in CXXFLAGS #include "rand_pdf.h" #include "all_draws.h" #include "gen_covar.h" } #include "corr.h" #include "params.h" #include "model.h" #include "sim.h" #include #include #include #include #include #include using namespace std; #define BUFFMAX 256 #define PWR 2.0 /* * Sim: * * constructor function */ Sim::Sim(unsigned int dim, Base_Prior *base_prior) : Corr(dim, base_prior) { /* Sanity Checks */ assert(base_prior->BaseModel() == GP); assert( ((Gp_Prior*) base_prior)->CorrPrior()->CorrModel() == SIM); /* set pointer to correllation prior from the base prior */ prior = ((Gp_Prior*) base_prior)->CorrPrior(); assert(prior); /* no LLM for sim covariance */ assert(!prior->Linear() && !prior->LLM()); linear = false; /* let the prior choose the starting nugget value */ nug = prior->Nug(); /* allocate and initialize (from prior) the range params */ d = new_dup_vector(((Sim_Prior*)prior)->D(), dim); /* counter of the number of d-rejections in a row */ dreject = 0; } /* * Sim (assignment operator): * * used to assign the parameters of one correlation * function to anothers. Both correlation functions * must already have been allocated */ Corr& Sim::operator=(const Corr &c) { Sim *e = (Sim*) &c; /* sanity check */ assert(prior == ((Gp_Prior*) base_prior)->CorrPrior()); /* copy everything */ log_det_K = e->log_det_K; linear = e->linear; dupv(d, e->d, dim); nug = e->nug; dreject = e->dreject; return *this; } /* * ~Sim: * * destructor */ Sim::~Sim(void) { free(d); } /* * Init: * * initialise this corr function with the parameters provided * from R via the vector of doubles */ void Sim::Init(double *dsim) { dupv(d, &(dsim[1]), dim); NugInit(dsim[0], false); } /* * Jitter: * * fill jitter[ ] with the variance inflation factor. That is, * the variance for an observation with covariates in the i'th * row of X will be s2*(1.0 + jitter[i]). In standard tgp, the * jitter is simply the nugget. But for calibration and mr tgp, * the jitter value depends upon X (eg real or simulated data). * */ double* Sim::Jitter(unsigned int n1, double **X) { double *jitter = new_vector(n1); for(unsigned int i=0; in); /* with probability 0.5, skip drawing the nugget */ double ru = runi(state); if(ru > 0.5) return false; /* make the draw */ double nug_new = nug_draw_margin(n, col, nug, F, Z, K, log_det_K, *lambda, Vb, K_new, Ki_new, Kchol_new, &log_det_K_new, &lambda_new, Vb_new, bmu_new, gp_prior->get_b0(), gp_prior->get_Ti(), gp_prior->get_T(), tau2, prior->NugAlpha(), prior->NugBeta(), gp_prior->s2Alpha(), gp_prior->s2Beta(), (int) linear, itemp, state); /* did we accept the draw? */ if(nug_new != nug) { nug = nug_new; success = true; swap_new(Vb, bmu, lambda); } return success; } /* * Update: (symmetric) * * takes in a (symmetric) distance matrix and * returns a correlation matrix (INCLUDES NUGGET) */ void Sim::Update(unsigned int n, double **K, double **X) { sim_corr_symm(K, dim, X, n, d, nug, PWR); } /* * Update: (symmetric) * * computes the internal correlation matrix K * (INCLUDES NUGGET) */ void Sim::Update(unsigned int n, double **X) { /* sanity checks */ assert(!linear); assert(this->n == n); /* compute K */ sim_corr_symm(K, dim, X, n, d, nug, PWR); } /* * Update: (non-symmetric) * * takes in a distance matrix and returns a * correlation matrix (DOES NOT INCLUDE NUGGET) */ void Sim::Update(unsigned int n1, unsigned int n2, double **K, double **X, double **XX) { sim_corr(K, dim, XX, n1, X, n2, d, PWR); } /* * propose_new_d: * * propose new d values. */ /* extern "C" { double orthant_miwa(int m, double *mu, double **Rho, int log2G, int conesonly, int *nconep); #define _orthant_miwa orthant_miwa } */ /* use code from Peter Craig: gridcalc.c orschm.c, orthant.c/h with minor modifications to get to compile */ void Sim::propose_new_d(double* d_new, double *q_fwd, double *q_bak, void *state) { /* pointer to sim prior */ Sim_Prior* sp = (Sim_Prior*) prior; /* calculate old signs */ /* double *signs = new_zero_vector(dim); for(unsigned int i=0; i 0) signs[i] = 1.0; else signs[i] = -1.0; } */ /* calculate probability of old signs */ /* double **P = new_zero_matrix(dim, dim); linalg_dgemm(CblasNoTrans,CblasNoTrans,dim,dim,1, 1.0,&signs,dim,&signs,1,0.0,P,dim); double **RhoP = new_dup_matrix(sp->DpRho(), dim, dim); for(unsigned int i=0; iDpCov_chol(), dim, state); *q_fwd = *q_bak = 1.0; /* random signs from same MVN */ /* mvnrnd(signs, NULL, sp->DpCov_chol(), dim, state); for(unsigned int i=0; i 0) signs[i] = 1.0; else signs[i] = -1.0; d_new[i] = signs[i] * fabs(d_new[i]); } */ /* calculate probability of proposed signs */ /* linalg_dgemm(CblasNoTrans,CblasNoTrans,dim,dim,1, 1.0,&signs,dim,&signs,1,0.0,P,dim); dup_matrix(RhoP, sp->DpRho(), dim, dim); for(unsigned int i=0; ilog_DPrior_pdf(d_new); pRatio_log -= ep->log_DPrior_pdf(d); /* MH acceptance ratio for the draw */ success = d_sim_draw_margin(d_new, n, dim, col, F, X, Z, log_det_K,*lambda, Vb, K_new, Ki_new, Kchol_new, &log_det_K_new, &lambda_new, Vb_new, bmu_new, gp_prior->get_b0(), gp_prior->get_Ti(), gp_prior->get_T(), tau2, nug, qRatio, pRatio_log, gp_prior->s2Alpha(), gp_prior->s2Beta(), itemp, state); /* see if the draw was accepted; if so, we need to copy (or swap) the contents of the new into the old */ if(success == 1) { swap_vector(&d, &d_new); swap_new(Vb, bmu, lambda); } /* iclean up */ free(d_new); /* something went wrong, abort; otherwise keep track of the number of d-rejections in a row */ if(success == -1) return success; else if(success == 0) dreject++; else dreject = 0; /* abort if we have had too many rejections */ if(dreject >= REJECTMAX) return -2; /* draw nugget */ bool changed = DrawNugs(n, X, F, Z, lambda, bmu, Vb, tau2, itemp, state); success = success || changed; return success; } /* * Combine: * * used in tree-prune steps, chooses one of two * sets of parameters to correlation functions, * and choose one for "this" correlation function */ void Sim::Combine(Corr *c1, Corr *c2, void *state) { get_delta_d((Sim*)c1, (Sim*)c2, state); CombineNug(c1, c2, state); } /* * Split: * * used in tree-grow steps, splits the parameters * of "this" correlation function into a parameterization * for two (new) correlation functions */ void Sim::Split(Corr *c1, Corr *c2, void *state) { propose_new_d((Sim*) c1, (Sim*) c2, state); SplitNug(c1, c2, state); } /* * get_delta_d: * * compute d from two ds residing in c1 and c2 * and sample b conditional on the chosen d * * (used in prune) */ void Sim::get_delta_d(Sim* c1, Sim* c2, void *state) { /* create pointers to the two ds */ double **dch = (double**) malloc(sizeof(double*) * 2); dch[0] = c1->d; dch[1] = c2->d; /* randomly choose one of the d's */ int ii[2]; propose_indices(ii, 0.5, state); /* and copy the chosen one */ dupv(d, dch[ii[0]], dim); /* clean up */ free(dch); } /* * propose_new_d: * * propose new D parameters using this->d for possible * new children partitions c1 and c2 * * (used in grow) */ void Sim::propose_new_d(Sim* c1, Sim* c2, void *state) { int i[2]; double **dnew = new_matrix(2, dim); /* randomply choose which of c1 and c2 will get a copy of this->d, and which will get a random d from the prior */ propose_indices(i, 0.5, state); /* from this->d */ dupv(dnew[i[0]], d, dim); /* from the prior */ draw_d_from_prior(dnew[i[1]], state); /* copy into c1 and c2 */ dupv(c1->d, dnew[0], dim); dupv(c2->d, dnew[1], dim); /* clean up */ delete_matrix(dnew); } /* * draw_d_from_prior: * * get draws of separable d parameter from * the prior distribution */ void Sim::draw_d_from_prior(double *d_new, void *state) { ((Sim_Prior*)prior)->DPrior_rand(d_new, state); } /* * State: * * return a string depecting the state * of the (parameters of) correlation function */ char* Sim::State(unsigned int which) { char buffer[BUFFMAX]; /* slightly different format if the nugget is going to get printed also */ #ifdef PRINTNUG string s = "(d"; sprintf(buffer, "%d=[", which); s.append(buffer); #else string s = ""; if(which == 0) s.append("d=["); else s.append("["); #endif for(unsigned int i=0; ilog_Prior(d); return prob; } /* * D: * * return the vector of range parameters for the * separable exponential family of correlation function */ double* Sim::D(void) { return d; } /* * Trace: * * return the current values of the parameters * to this correlation function */ double* Sim::Trace(unsigned int* len) { /* calculate the length of the trace vector, and allocate */ *len = 1 + dim + 1; double *trace = new_vector(*len); /* copy the nugget */ trace[0] = nug; /* copy the d-vector of range parameters */ dupv(&(trace[1]), d, dim); /* determinant of K */ trace[1+dim] = log_det_K; return(trace); } /* * TraceNames: * * return the names of the parameters recorded in Sim::Trace() */ char** Sim::TraceNames(unsigned int* len) { /* calculate the length of the trace vector, and allocate */ *len = 1 + dim + 1; char **trace = (char**) malloc(sizeof(char*) * (*len)); /* copy the nugget */ trace[0] = strdup("nug"); /* copy the d-vector of range parameters */ for(unsigned int i=0; in); inverse_chol(K, Ki, Kchol, n); log_det_K = log_determinant_chol(Kchol, n); } else { assert(n > 0); log_det_K = n * log(1.0 + nug); } } /* * Sim_Prior: * * constructor for the prior parameterization of the separable * exponential power distribution function */ Sim_Prior::Sim_Prior(unsigned int dim) : Corr_Prior(dim) { corr_model = SIM; /* default starting values and initial parameterization */ d = ones(dim, 0.5); dp_cov_chol = new_id_matrix(dim); // dp_Rho = new_id_matrix(dim); d_alpha = new_zero_matrix(dim, 2); d_beta = new_zero_matrix(dim, 2); default_d_priors(); /* set d_alpha and d_beta */ default_d_lambdas(); /* set d_alpha_lambda and d_beta_lambda */ } /* * Init: * * read hiererchial prior parameters from a double-vector * */ void Sim_Prior::Init(double *dhier) { for(unsigned int i=0; icorr_model == SIM); /* copy all parameters of the prior */ corr_model = e->corr_model; dupv(gamlin, e->gamlin, 3); d = new_dup_vector(e->d, dim); dp_cov_chol = new_dup_matrix(e->dp_cov_chol, dim, dim); // dp_Rho = new_dup_matrix(e->dp_Rho, dim, dim); fix_d = e->fix_d; d_alpha = new_dup_matrix(e->d_alpha, dim, 2); d_beta = new_dup_matrix(e->d_beta, dim, 2); dupv(d_alpha_lambda, e->d_alpha_lambda, 2); dupv(d_beta_lambda, e->d_beta_lambda, 2); } /* * ~Sim_Prior: * * destructor for the prior parameterization of the separable * exponential power distribution function */ Sim_Prior::~Sim_Prior(void) { free(d); delete_matrix(dp_cov_chol); // delete_matrix(dp_Rho); delete_matrix(d_alpha); delete_matrix(d_beta); } /* * read_double: * * read the double parameter vector giving the user-secified * prior parameterization specified in R */ void Sim_Prior::read_double(double *dparams) { /* read the parameters that have to to with the nugget */ read_double_nug(dparams); /* read the starting value(s) for the range parameter(s) */ for(unsigned int i=0; igetline(line, BUFFMAX); d[0] = atof(strtok(line, " \t\n#")); for(unsigned int i=1; igetline(line, BUFFMAX); strcpy(line_copy, line); if(!strcmp("fixed", strtok(line_copy, " \t\n#"))) { fix_d = true; MYprintf(MYstdout, "fixing d prior\n"); } else { fix_d = false; get_mix_prior_params(d_alpha_lambda, d_beta_lambda, line, "d lambda"); } } /* * default_d_priors: * * set d prior parameters * to default values */ void Sim_Prior::default_d_priors(void) { for(unsigned int i=0; iparameters for the jth dimension from each of the "howmany" corr modules */ for(unsigned int i=0; iD())[j]); /* use those gathered d values to make a draw for the parameters for the prior of the jth d */ mixture_priors_draw(d_alpha[j], d_beta[j], d, howmany, d_alpha_lambda, d_beta_lambda, state); } /* clean up */ free(d); } /* hierarchical prior draws for the nugget */ DrawNugHier(corr, howmany, state); } /* * newCorr: * * construct and return a new separable exponential correlation * function with this module governing its prior parameterization */ Corr* Sim_Prior::newCorr(void) { return new Sim(dim, base_prior); } /* * log_Prior: * * compute the (log) prior for the parameters to * the correlation function (e.g. d and nug) */ double Sim_Prior::log_Prior(double *d) { double prob = 0; /* if forcing the LLM, just return zero (i.e. prior=1, log_prior=0) */ assert(gamlin[0] <= 0); /* sum the log priors for each of the d-parameters */ for(unsigned int i=0; ibase_prior = base_prior; } /* * Print: * * pretty print the correllation function parameters out * to a file */ void Sim_Prior::Print(FILE *outfile) { MYprintf(MYstdout, "corr prior: separable power\n"); /* print nugget stuff first */ PrintNug(outfile); /* range parameter */ /* MYprintf(outfile, "starting d=\n"); printVector(d, dim, outfile, HUMAN); */ /* range gamma prior, just print once */ MYprintf(outfile, "d[a,b][0,1]=[%g,%g],[%g,%g]\n", d_alpha[0][0], d_beta[0][0], d_alpha[0][1], d_beta[0][1]); /* print many times, one for each dimension instead? */ /* for(unsigned int i=1; i #ifndef _RANDOMKIT_ #define _RANDOMKIT_ #define RK_STATE_LEN 624 typedef struct rk_state_ { unsigned long key[RK_STATE_LEN]; int pos; int has_gauss; /* !=0: gauss contains a gaussian deviate */ double gauss; } rk_state; typedef enum { RK_NOERR = 0, /* no error */ RK_ENODEV = 1, /* no RK_DEV_RANDOM device */ RK_ERR_MAX = 2 } rk_error; /* error strings */ extern char *rk_strerror[RK_ERR_MAX]; /* Maximum generated random value */ #define RK_MAX 0xFFFFFFFFUL #ifdef __cplusplus extern "C" { #endif /* * Initialize the RNG state using the given seed. */ extern void rk_seed(unsigned long seed, rk_state *state); /* * Initialize the RNG state using a random seed. * Uses /dev/random or, when unavailable, the clock (see randomkit.c). * Returns RK_NOERR when no errors occurs. * Returns RK_ENODEV when the use of RK_DEV_RANDOM failed (for example because * there is no such device). In this case, the RNG was initialized using the * clock. */ extern rk_error rk_randomseed(rk_state *state); /* * Returns a random unsigned long between 0 and RK_MAX inclusive */ extern unsigned long rk_random(rk_state *state); /* * Returns a random long between 0 and LONG_MAX inclusive */ extern long rk_long(rk_state *state); /* * Returns a random unsigned long between 0 and ULONG_MAX inclusive */ extern unsigned long rk_ulong(rk_state *state); /* * Returns a random unsigned long between 0 and max inclusive. */ extern unsigned long rk_interval(unsigned long max, rk_state *state); /* * Returns a random double between 0.0 and 1.0, 1.0 excluded. */ extern double rk_double(rk_state *state); /* * fill the buffer with size random bytes */ extern void rk_fill(void *buffer, size_t size, rk_state *state); /* * fill the buffer with randombytes from the random device * Returns RK_ENODEV if the device is unavailable, or RK_NOERR if it is * On Unix, if strong is defined, RK_DEV_RANDOM is used. If not, RK_DEV_URANDOM * is used instead. This parameter has no effect on Windows. * Warning: on most unixes RK_DEV_RANDOM will wait for enough entropy to answer * which can take a very long time on quiet systems. */ extern rk_error rk_devfill(void *buffer, size_t size, int strong); /* * fill the buffer using rk_devfill if the random device is available and using * rk_fill if is is not * parameters have the same meaning as rk_fill and rk_devfill * Returns RK_ENODEV if the device is unavailable, or RK_NOERR if it is */ extern rk_error rk_altfill(void *buffer, size_t size, int strong, rk_state *state); /* * return a random gaussian deviate with variance unity and zero mean. */ extern double rk_gauss(rk_state *state); #ifdef __cplusplus } #endif #endif /* _RANDOMKIT_ */ tgp/src/linalg.c0000644000176200001440000002106513531032535013251 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #include #include #include "linalg.h" #include "matrix.h" #include "rhelp.h" #ifdef FORTPACK char uplo = 'U'; #endif /* #define DEBUG */ /* * linalg_dtrsv: * * analog of dtrsv in cblas nad blas * assumed row-major lower-tri and non-unit */ void linalg_dtrsv(TA, n, A, lda, Y, ldy) const enum CBLAS_TRANSPOSE TA; int n, lda, ldy; double **A; double *Y; { #ifdef FORTBLAS char ta; char diag = 'N'; if(TA == CblasTrans) ta = 'T'; else ta = 'N'; dtrsv(&uplo, &ta, &diag, &n, *A, &lda, Y, &ldy); #else cblas_dtrsv(CblasRowMajor,CblasLower,TA,CblasNonUnit, /*cblas_dtrsv(CblasColMajor,CblasUpper,CblasNoTrans,CblasNonUnit,*/ n,*A,lda,Y,ldy); #endif } /* * linalg_ddot: * * analog of ddot in cblas nad blas */ double linalg_ddot(n, X, ldx, Y, ldy) int n, ldx, ldy; double *X, *Y; { double result; #ifdef FORTBLAS result = ddot(&n,X,&ldx,Y,&ldy); #else result = cblas_ddot(n, X, ldx, Y, ldy); #endif return result; } /* * linalg_daxpy: * * analog of daxpy in cblas nad blas */ void linalg_daxpy(n,alpha,X,ldx,Y,ldy) int n, ldx, ldy; double alpha; double *X, *Y; { #ifdef FORTBLAS daxpy(&n,&alpha,X,&ldx,Y,&ldy); #else cblas_daxpy(n, alpha, X, ldx, Y, ldy); #endif } /* * linalg_dgemm: * * analog of dgemm in cblas nad blas * assumed column major representation */ void linalg_dgemm(TA, TB, m, n, k, alpha, A, lda, B, ldb, beta, C, ldc) const enum CBLAS_TRANSPOSE TA, TB; int m, n, k, lda, ldb, ldc; double alpha, beta; double **A, **B, **C; { #ifdef FORTBLAS char ta, tb; if(TA == CblasTrans) ta = 'T'; else ta = 'N'; if(TB == CblasTrans) tb = 'T'; else tb = 'N'; dgemm(&ta,&tb,&m,&n,&k,&alpha,*A,&lda,*B,&ldb,&beta,*C,&ldc); #else cblas_dgemm(CblasColMajor,TA,TB,m,n,k,alpha,*A,lda,*B,ldb,beta,*C,ldc); #endif } /* * linalg_dgemv: * * analog of dgemv in cblas nad blas * assumed column major representation */ void linalg_dgemv(TA, m, n, alpha, A, lda, X, ldx, beta, Y, ldy) const enum CBLAS_TRANSPOSE TA; int m, n, lda, ldx, ldy; double alpha, beta; double **A; double *X, *Y; { #ifdef FORTBLAS char ta; if(TA == CblasTrans) ta = 'T'; else ta = 'N'; dgemv(&ta,&m,&n,&alpha,*A,&lda,X,&ldx,&beta,Y,&ldy); #else cblas_dgemv(CblasColMajor,TA,m,n,alpha,*A,lda,X,ldx,beta,Y,ldy); #endif } /* * linalg_dsymm: * * analog of dsymm in cblas nad blas * assumed column major and upper-triangluar representation */ void linalg_dsymm(SIDE, m, n, alpha, A, lda, B, ldb, beta, C, ldc) const enum CBLAS_SIDE SIDE; int m, n, lda, ldb, ldc; double alpha, beta; double **A, **B, **C; { #ifdef FORTBLAS char side; if(SIDE == CblasRight) side = 'R'; else side = 'L'; dsymm(&side,&uplo,&m,&n,&alpha,*A,&lda,*B,&ldb,&beta,*C,&ldc); #else cblas_dsymm(CblasColMajor,SIDE,CblasUpper,m,n,alpha,*A,lda,*B,ldb,beta,*C,ldc); #endif } /* * linalg_dsymv: * * analog of dsymv in cblas and blas * assumed column major representation */ void linalg_dsymv(n, alpha, A, lda, X, ldx, beta, Y, ldy) int n, lda, ldx, ldy; double alpha, beta; double **A; double *X, *Y; { #ifdef FORTBLAS dsymv(&uplo,&n,&alpha,*A,&lda,X,&ldx,&beta,Y,&ldy); #else cblas_dsymv(CblasColMajor,CblasUpper,n,alpha,*A,lda,X,ldx,beta,Y,ldy); #endif } /* * linalg_dposv: * * analog of dposv in clapack and lapack where * Mutil is with colmajor and uppertri or rowmajor * and lowertri */ int linalg_dposv(n, Mutil, Mi) int n; double **Mutil, **Mi; { int info; /* then use LAPACK */ #ifdef FORTPACK dposv(&uplo,&n,&n,*Mutil,&n,*Mi,&n,&info); #else /*info = clapack_dposv(CblasColMajor,CblasUpper,n,n,*Mutil,n,*Mi,n);*/ info = clapack_dposv(CblasRowMajor,CblasLower,n,n,*Mutil,n,*Mi,n); #endif #ifdef DEBUG if(info != 0) { matrix_to_file("M.dump", Mutil, n, n); error("offending matrix dumped into matrix.dump"); } #endif return (int) info; } /* * linalg_dgesv: * * analog of dgesv in clapack and lapack; * row or col major doesn't matter because it is * assumed that Mutil is symmetric * * inverse_lu used this with RowMajor, other with ColMajor */ int linalg_dgesv(n, Mutil, Mi) int n; double **Mutil, **Mi; { int info; int *p; p = new_ivector(n); #ifdef FORTPACK dgesv(&n,&n,*Mutil,&n,p,*Mi,&n,&info); #else info = clapack_dgesv(CblasColMajor,n,n,*Mutil,n,p,*Mi,n); /*info = clapack_dgesv(CblasRowMajor,n,n,*Mutil,n,p,*Mi,n);*/ #endif free(p); #ifdef DEBUG assert(info == 0); #endif return info; } /* * * analog of dpotrf in clapack and lapack where * var is with colmajor and uppertri or rowmajor * and lowertri */ int linalg_dpotrf(n, var) int n; double **var; { int info; #ifdef FORTPACK dpotrf(&uplo,&n,*var,&n,&info); #else info = clapack_dpotrf(CblasRowMajor,CblasLower,n,*var,n); /*info = clapack_dpotrf(CblasColMajor,CblasUpper,n,*var,n);*/ #endif #ifdef DEBUG assert(info == 0); #endif return (int) info; } #ifndef FORTPACK /* * solve_cg_symm: * * solve Ax=b by inverting A and computing using the conjugate * gradient method from Skilling (also takes advantage of symmetry in C) * C[n][n] double u[n], y[n], y_star[n] */ int solve_cg_symm(y, y_star, C, u, theta, n) unsigned int n; double **C; double *u, *y, *y_star; double theta; { double g[n], g_star[n], h[n], h_star[n], Ch[n], Ch_star[n]; double Cy[n], Cy_star[n], Ag_star[n], ACh_star[n], Ay_star[n], CAy_star[n]; double **A; double gamma, gamma_star, lambda, lambda_star, g_old_norm, g_old_norm_star, Q, Q_star, u_norm, upper; unsigned int k, i, j;/*, iter;*/ A = new_matrix(n, n); u_norm = linalg_ddot(n, u, 1, u, 1); /* initialize */ for(i=0; i void sens_sample(double **XX, int nn, int d, double **bnds, double *shape, double *mode, void *state); double** rect_sample(int dim, int n, void *state); double** rect_sample_lh(int dim, int n, double** rect, int er, void *state); double** beta_sample_lh(int dim, int n, double** rect, double* shape, double* mode, void *state); void rect_scale(double** z, int n, int d, double** rect); double** readRect(char* rect, unsigned int *d); void errorBadRect(void); void printRect(FILE* outfile, int d, double** rect); void errorBadRect(void); int* order(double *s, unsigned int n); void sortDouble(double *s, unsigned int n); #endif tgp/src/list.h0000644000176200001440000000317213531032535012762 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #ifndef __LIST_H__ #define __LIST_H__ class List; class LNode { private: void* entry; public: List* list; LNode* next; LNode* prev; LNode(void* entry); ~LNode(void); LNode* Next(void); LNode* Prev(void); void* Entry(void); }; class List { private: LNode* first; LNode* last; LNode* curr; unsigned int len; public: List(void); ~List(void); LNode* EnQueue(void *entry); void* DeQueue(void); bool isEmpty(void); unsigned int Len(void); void* detach_and_delete(LNode* node); LNode* First(void); }; #endif tgp/src/rand_pdf.c0000644000176200001440000002726613531032535013571 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ #include #include #include #include #include #include "rand_pdf.h" #include "matrix.h" #include "linalg.h" #include "rhelp.h" /* #define DEBUG */ /* * copyCovUpper: * * copy the upper trianglar part of (n x n) Sigma into cov * so that cov can be an argument to LAPACK (like Choleski * decomposition) routines which modify their argument */ void copyCovUpper(cov, Sigma, n, scale) unsigned int n; /*double cov[][n], Sigma[][n];*/ double **cov, **Sigma; double scale; { int i,j; for(i=0; i=0 && b>0); /* evaluate the pdf for each x */ for(i=0; i 0); if(a == 0) p[i] = 0; else p[i] = a*log(b) - lgammafn(a) + (a-1)*log(x[i]) - b*x[i]; } } /* * invgampdf_log_gelman: * * GELMAN PARAMATERIZATION * logarithm of the density of n x values distributed * as Gamma(a,b). * p must be pre-alloc'd n-array */ void invgampdf_log_gelman(p, x, a, b, n) unsigned int n; double *p, *x, a, b; { int i; /* sanity checks */ assert(a>0 && b>0); /* evaluate the pdf for each x */ for(i=0; i= 0); p[i] = a*log(b) - lgammafn(a) - (a+1)*log(x[i]) - b/x[i]; } } /* * gampdf_log: * * logarithm of the density of n x values distributed * as Gamma(a,b). * p must be pre-alloc'd n-array; not using Gelman parameterization */ void gampdf_log(p, x, a, b, n) unsigned int n; double *p, *x, a, b; { int i; /* sanity checks */ assert(a>0 && b>0); /* evaluate the pdf for each x */ for(i=0; i 0); p[i] = 0.0 - a*log(b) - lgammafn(a) + (a-1)*log(x[i]) - x[i]/b; } } /* * betapdf_log: * * logarithm of the density of n x values distributed * as Beta(a,b). * p must be pre-alloc'd n-array */ void betapdf_log(p, x, a, b, n) unsigned int n; double *p, *x, a, b; { int i; for(i=0; i 0); assert(nu > n); /* denominator */ /* gammapart <- 1 */ lgampart = 0.0; /* for(i in 1:k) gammapart <- gammapart * gamma((v + 1 - i)/2) */ for(i=1; i<=n; i++) lgampart += lgammafn((nu+1.0-(double)i)/2.0 ); /* denom <- gammapart * 2^(v * k / 2) * pi^(k*(k-1)/4) */ denom = lgampart + (nu*n/2.0)*M_LN2 + (n*(n-1.0)/2.0)*M_LN_SQRT_PI; /* numerator */ /* detW <- det(W) */ ldetW = log_determinant_dup(x, n); /* hold <- solve(S) %*% W */ hold = new_dup_matrix(x, n, n); Sdup = new_dup_matrix(S, n, n); linalg_dposv(n, Sdup, hold); /* detS <- det(S) */ /* dposv should have left us with chol(S) inside Sdup */ ldetS = log_determinant_chol(Sdup, n); /* tracehold <- sum(hold[row(hold) == col(hold)]) */ tracehold = 0.0; for(i=0; i 0); assert(*nu_in > *n_in); /* copy W_in vector to W matrix */ /* Bobby: this is wasteful; should write a function which allocates * the "skeleton" of a new matrix, and points W[0] to a vector */ W = new_matrix(*n_in, *n_in); dupv(W[0], W_in, *n_in * *n_in); /* copy S_in vector to S matrix */ S = new_matrix(*n_in, *n_in); dupv(S[0], S_in, *n_in * *n_in); /* evaluate the lpdf */ *lpdf_out = wishpdf_log(W, S, *n_in, *nu_in); /* clean up */ delete_matrix(W); delete_matrix(S); } /* * temper: * * apply temperature temp to pdf density p; i.e., * take p^temp when uselog = 0, and temp*k, when * uselog = 1, assuming that p is in log space */ double temper(double p, double temp, int uselog) { double tp; /* remove this later */ /* if(temp != 1.0) warning("temper(): temp = %g is not 1.0", temp); */ if(uselog) tp = temp * p; else { if(temp == 1.0) tp = p; else if(temp == 0.0) tp = 1.0; else tp = pow(p, temp); } return tp; } /* * temper_invgam: * * apply temperature t to the alpha (a) and beta (b) parameters * to the inverse gamma distribution */ void temper_invgam(double *a, double *b, double temp) { /* remove this later */ /* if(temp != 1.0) warning("temper_invgam(): temp = %g is not 1.0", temp); */ *a = temp*(*a+1.0) - 1.0; *b = temp * (*b); /* sanity check */ assert(*a > 0 && *b > 0); } /* * temper_gamma: * * apply temperature t to the alpha (a) and beta (b) parameters * to the inverse gamma distribution */ void temper_gamma(double *a, double *b, double temp) { /* remove this later */ /* if(temp != 1.0) warning("temper_gamma(): temp = %g is not 1.0", temp); */ *a = temp*(*a-1.0) + 1.0; *b = temp * (*b); /* sanity check */ assert(*a > 0 && *b > 0); } /* * temper_wish: * * apply temperature t to the rho and V (col x col) * parameters to a wishart distribution */ void temper_wish(int *rho, double **V, unsigned int col, double temp) { double drho; /* remove this later */ /* if(temp != 1.0) warning("temper_wish(): temp = %g is not 1.0", temp); */ /* adjust rho for temperature */ drho = temp * (*rho) + (col + 1.0)*(1.0 - temp); drho = ceil(drho); assert(drho > col); *rho = (int) drho; /* adjust V for temperature */ assert(V); scalev(V[0], col, 1.0/temp); } tgp/src/exp.cc0000644000176200001440000004771213531032535012751 0ustar liggesusers/******************************************************************************** * * Bayesian Regression and Adaptive Sampling with Gaussian Process Trees * Copyright (C) 2005, University of California * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * * Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) * ********************************************************************************/ extern "C" { #include "matrix.h" #include "lh.h" #include "rand_draws.h" #include "rand_pdf.h" #include "all_draws.h" #include "gen_covar.h" #include "rhelp.h" } #include "corr.h" #include "params.h" #include "model.h" #include "exp.h" #include #include #include #include #include #include using namespace std; #define BUFFMAX 256 #define PWR 2.0 /* * Exp: * * constructor function */ Exp::Exp(unsigned int dim, Base_Prior *base_prior) : Corr(dim, base_prior) { assert(base_prior->BaseModel() == GP); prior = ((Gp_Prior*) base_prior)->CorrPrior(); assert(prior); nug = prior->Nug(); /* check if we should really be starting in the LLM */ if(!prior->Linear() && !prior->LLM()) linear = false; assert( ((Gp_Prior*) base_prior)->CorrPrior()->CorrModel() == EXP); d = ((Exp_Prior*) prior)->D(); xDISTx = NULL; nd = 0; dreject = 0; } /* * Exp (assignment operator): * * used to assign the parameters of one correlation * function to anothers. Both correlation functions * must already have been allocated. */ Corr& Exp::operator=(const Corr &c) { Exp *e = (Exp*) &c; log_det_K = e->log_det_K; linear = e->linear; d = e->d; nug = e->nug; dreject = e->dreject; assert(prior->CorrModel() == EXP); assert(prior == ((Gp_Prior*) base_prior)->CorrPrior()); /* copy the covariance matrices -- no longer performed due to the economy argument in Gp/Base */ // Cov(e); return *this; } /* * ~Exp: * * destructor */ Exp::~Exp(void) { if(xDISTx) delete_matrix(xDISTx); xDISTx = NULL; } /* * Init: * * initialise this corr function with the parameters provided * from R via the vector of doubles */ void Exp::Init(double *dexp) { d = dexp[1]; NugInit(dexp[0], ! (bool) dexp[2]); } /* * Jitter: * * fill jitter[ ] with the variance inflation factor. That is, * the variance for an observation with covariates in the i'th * row of X will be s2*(1.0 + jitter[i]). In standard tgp, the * jitter is simply the nugget. But for calibration and mr tgp, * the jitter value depends upon X (eg real or simulated data). * */ double* Exp::Jitter(unsigned int n1, double **X) { double *jitter = new_vector(n1); for(unsigned int i=0; in); /* randomly reject 1/2 the time, to avoid having to do lots of matrix inversions -- as the nug mixes better than d already */ if(runi(state) > 0.5) return false; /* make the draw */ double nug_new = nug_draw_margin(n, col, nug, F, Z, K, log_det_K, *lambda, Vb, K_new, Ki_new, Kchol_new, &log_det_K_new, &lambda_new, Vb_new, bmu_new, gp_prior->get_b0(), gp_prior->get_Ti(), gp_prior->get_T(), tau2, prior->NugAlpha(), prior->NugBeta(), gp_prior->s2Alpha(), gp_prior->s2Beta(), (int) linear, itemp, state); /* did we accept the draw? */ if(nug_new != nug) { nug = nug_new; success = true; swap_new(Vb, bmu, lambda); } return success; } /* * Update: (symmetric) * * compute correlation matrix K */ void Exp::Update(unsigned int n, double **X) { if(linear) return; assert(this->n == n); if(!xDISTx || nd != n) { if(xDISTx) delete_matrix(xDISTx); xDISTx = new_matrix(n, n); nd = n; } dist_symm(xDISTx, dim, X, n, PWR); dist_to_K_symm(K, xDISTx, d, nug, n); //delete_matrix(xDISTx); } /* * Update: (symmetric) * * takes in a (symmetric) distance matrix and * returns a correlation matrix */ void Exp::Update(unsigned int n, double **K, double **X) { double ** xDISTx = new_matrix(n, n); dist_symm(xDISTx, dim, X, n, PWR); dist_to_K_symm(K, xDISTx, d, nug, n); delete_matrix(xDISTx); } /* * Update: (non-symmetric) * * takes in a distance matrix and * returns a correlation matrix */ void Exp::Update(unsigned int n1, unsigned int n2, double **K, double **X, double **XX) { double **xxDISTx = new_matrix(n2, n1); dist(xxDISTx, dim, XX, n1, X, n2, PWR); dist_to_K(K, xxDISTx, d, 0.0, n1, n2); delete_matrix(xxDISTx); } /* * Draw: * * draw parameters for a new correlation matrix; * returns true if the correlation matrix (passed in) * has changed; otherwise returns false */ int Exp::Draw(unsigned int n, double **F, double **X, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state) { int success = 0; bool lin_new; double q_fwd , q_bak, d_new; /* sometimes skip this Draw for linear models for speed, and only draw the nugget */ if(linear && runi(state) > 0.5) return DrawNugs(n, X, F, Z, lambda, bmu, Vb, tau2, itemp, state); /* proppose linear or not */ if(prior->Linear()) lin_new = true; else { q_fwd = q_bak = 1.0; d_proposal(1, NULL, &d_new, &d, &q_fwd, &q_bak, state); if(prior->LLM()) lin_new = linear_rand(&d_new, 1, prior->GamLin(), state); else lin_new = false; } /* if not linear then compute new distances */ /* allocate K_new, Ki_new, Kchol_new */ if(! lin_new) { if(!xDISTx || nd != n) { if(xDISTx) delete_matrix(xDISTx); xDISTx = new_matrix(n, n); nd = n; } dist_symm(xDISTx, dim, X, n, PWR); allocate_new(n); assert(n == this->n); } /* d; rebuilding K, Ki, and marginal params, if necessary */ if(prior->Linear()) { d_new = d; success = 1; } else { Exp_Prior* ep = (Exp_Prior*) prior; Gp_Prior *gp_prior = (Gp_Prior*) base_prior; success = d_draw_margin(n, col, d_new, d, F, Z, xDISTx, log_det_K, *lambda, Vb, K_new, Ki_new, Kchol_new, &log_det_K_new, &lambda_new, Vb_new, bmu_new, gp_prior->get_b0(), gp_prior->get_Ti(), gp_prior->get_T(), tau2, nug, q_bak/q_fwd, ep->DAlpha(), ep->DBeta(), gp_prior->s2Alpha(), gp_prior->s2Beta(), (int) lin_new, itemp, state); } /* did we accept the new draw? */ if(success == 1) { d = d_new; linear = (bool) lin_new; swap_new(Vb, bmu, lambda); dreject = 0; } else if(success == -1) return success; else if(success == 0) dreject++; /* abort if we have had too many rejections */ if(dreject >= REJECTMAX) return -2; /* draw nugget */ bool changed = DrawNugs(n, X, F, Z, lambda, bmu, Vb, tau2, itemp, state); success = success || changed; return success; } /* * Combine: * * used in tree-prune steps, chooses one of two * sets of parameters to correlation functions, * and choose one for "this" correlation function */ void Exp::Combine(Corr *c1, Corr *c2, void *state) { get_delta_d((Exp*)c1, (Exp*)c2, state); CombineNug(c1, c2, state); } /* * Split: * * used in tree-grow steps, splits the parameters * of "this" correlation function into a parameterization * for two (new) correlation functions */ void Exp::Split(Corr *c1, Corr *c2, void *state) { propose_new_d((Exp*) c1, (Exp*) c2, state); SplitNug(c1, c2, state); } /* * get_delta_d: * * compute d from two ds (used in prune) */ void Exp::get_delta_d(Exp* c1, Exp* c2, void *state) { double dch[2]; int ii[2]; dch[0] = c1->d; dch[1] = c2->d; propose_indices(ii, 0.5, state); d = dch[ii[0]]; linear = linear_rand(&d, 1, prior->GamLin(), state); } /* * propose_new_d: * * propose new D parameters for possible * new children partitions. */ void Exp::propose_new_d(Exp* c1, Exp* c2, void *state) { int i[2]; double dnew[2]; Exp_Prior *ep = (Exp_Prior*) prior; propose_indices(i, 0.5, state); dnew[i[0]] = d; if(prior->Linear()) dnew[i[1]] = d; else dnew[i[1]] = d_prior_rand(ep->DAlpha(), ep->DBeta(), state); c1->d = dnew[0]; c2->d = dnew[1]; c1->linear = (bool) linear_rand(&(dnew[0]), 1, prior->GamLin(), state); c2->linear = (bool) linear_rand(&(dnew[1]), 1, prior->GamLin(), state); } /* * State: * * return a string depecting the state * of the (parameters of) correlation function */ char* Exp::State(unsigned int which) { char buffer[BUFFMAX]; #ifdef PRINTNUG string s = "(d="; #else string s = ""; if(which == 0) s.append("d="); #endif if(linear) sprintf(buffer, "0(%g)", d); else sprintf(buffer, "%g", d); s.append(buffer); #ifdef PRINTNUG sprintf(buffer, ", g=%g)", nug); s.append(buffer); #endif char* ret_str = (char*) malloc(sizeof(char) * (s.length()+1)); strncpy(ret_str, s.c_str(), s.length()); ret_str[s.length()] = '\0'; return ret_str; } /* * sum_b: * * return 1 if linear, 0 otherwise */ unsigned int Exp::sum_b(void) { if(linear) return 1; else return 0; } /* * ToggleLinear: * * make linear if not linear, otherwise * make not linear */ void Exp::ToggleLinear(void) { if(linear) { linear = false; } else { linear = true; } } /* * D: * * return the range parameter */ double Exp::D(void) { return d; } /* * log_Prior: * * compute the (log) prior for the parameters to * the correlation function (e.g. d and nug) */ double Exp::log_Prior(void) { double prob = ((Corr*)this)->log_NugPrior(); prob += ((Exp_Prior*) prior)->log_Prior(d, linear); return prob; } /* * TraceNames: * * return the names of the parameters recorded in Exp::Trace() */ char** Exp::TraceNames(unsigned int* len) { *len = 4; char **trace = (char**) malloc(sizeof(char*) * (*len)); trace[0] = strdup("nug"); trace[1] = strdup("d"); trace[2] = strdup("b"); /* determinant of K */ trace[3] = strdup("ldetK"); return trace; } /* * Trace: * * return the current values of the parameters * to this correlation function: nug, d, then linear */ double* Exp::Trace(unsigned int* len) { *len = 4; double *trace = new_vector(*len); trace[0] = nug; trace[1] = d; trace[2] = (double) !linear; /* determinant of K */ trace[3] = log_det_K; return trace; } void Exp::Invert(unsigned int n) { if(! linear) { assert(n == this->n); inverse_chol(K, Ki, Kchol, n); log_det_K = log_determinant_chol(Kchol, n); } else { assert(n > 0); log_det_K = n * log(1.0 + nug); } } /* * newCorr: * * construct and return a new isotropic exponential correlation * function with this module governing its prior parameterization */ Corr* Exp_Prior::newCorr(void) { return new Exp(dim, base_prior); } /* * Exp_Prior: * * constructor for the prior distribution for * the exponential correlation function */ Exp_Prior::Exp_Prior(unsigned int dim) : Corr_Prior(dim) { corr_model = EXP; /* defaults */ d = 0.5; default_d_priors(); default_d_lambdas(); } /* * Init: * * read hiererchial prior parameters from a double-vector * */ void Exp_Prior::Init(double *dhier) { d_alpha[0] = dhier[0]; d_beta[0] = dhier[1]; d_alpha[1] = dhier[2]; d_beta[1] = dhier[3]; NugInit(&(dhier[4])); } /* * Dup: * * duplicate this prior for the isotropic exponential * power family */ Corr_Prior* Exp_Prior::Dup(void) { return new Exp_Prior(this); } /* * Exp_Prior (new duplicate) * * duplicating constructor for the prior distribution for * the exponential correlation function */ Exp_Prior::Exp_Prior(Corr_Prior *c) : Corr_Prior(c) { Exp_Prior *e = (Exp_Prior*) c; assert(e->corr_model == EXP); corr_model = e->corr_model; dupv(gamlin, e->gamlin, 3); d = e->d; fix_d = e->fix_d; dupv(d_alpha, e->d_alpha, 2); dupv(d_beta, e->d_beta, 2); dupv(d_alpha_lambda, e->d_alpha_lambda, 2); dupv(d_beta_lambda, e->d_beta_lambda, 2); } /* * ~Exp_Prior: * * destructor the the prior distribution for * the exponential correlation function */ Exp_Prior::~Exp_Prior(void) { } /* * read_double: * * read prior parameterization from a vector of doubles * passed in from R */ void Exp_Prior::read_double(double *dparams) { /* read the parameters that have to do with the * nugget first */ read_double_nug(dparams); /* starting value for the range parameter */ d = dparams[1]; //MYprintf(MYstdout, "starting d=%g\n", d); /* reset dparams to start after the nugget gamlin params */ dparams += 13; /* initial parameter settings for alpha and beta */ get_mix_prior_params_double(d_alpha, d_beta, &(dparams[0]), "d"); dparams += 4; /* reset */ /* d hierarchical lambda prior parameters */ if((int) dparams[0] == -1) { fix_d = true; /*MYprintf(MYstdout, "fixing d prior\n");*/ } else { fix_d = false; get_mix_prior_params_double(d_alpha_lambda, d_beta_lambda, &(dparams[0]), "d lambda"); } dparams += 4; /* reset */ } /* * read_ctrlfile: * * read prior parameterization from a control file */ void Exp_Prior::read_ctrlfile(ifstream *ctrlfile) { char line[BUFFMAX], line_copy[BUFFMAX]; /* read the parameters that have to do with the * nugget first */ read_ctrlfile_nug(ctrlfile); /* read the d parameter from the control file */ ctrlfile->getline(line, BUFFMAX); d = atof(strtok(line, " \t\n#")); MYprintf(MYstdout, "starting d=%g\n", d); /* read d and nug-hierarchical parameters (mix of gammas) */ ctrlfile->getline(line, BUFFMAX); get_mix_prior_params(d_alpha, d_beta, line, "d"); /* d hierarchical lambda prior parameters */ ctrlfile->getline(line, BUFFMAX); strcpy(line_copy, line); if(!strcmp("fixed", strtok(line_copy, " \t\n#"))) { fix_d = true; MYprintf(MYstdout, "fixing d prior\n"); } else { fix_d = false; get_mix_prior_params(d_alpha_lambda, d_beta_lambda, line, "d lambda"); } } /* * default_d_priors: * * set d prior parameters * to default values */ void Exp_Prior::default_d_priors(void) { d_alpha[0] = 1.0; d_beta[0] = 20.0; d_alpha[1] = 10.0; d_beta[1] = 10.0; } /* * default_d_lambdas: * * set d (lambda) hierarchical prior parameters * to default values */ void Exp_Prior::default_d_lambdas(void) { d_alpha_lambda[0] = 1.0; d_beta_lambda[0] = 10.0; d_alpha_lambda[1] = 1.0; d_beta_lambda[1] = 10.0; fix_d = false; //fix_d = true; } /* * D: * * return the default range parameter setting * for the exponential correllation function */ double Exp_Prior::D(void) { return d; } /* * DAlpha: * * return the alpha prior parameter setting to the gamma * distribution prior for the range parameter */ double* Exp_Prior::DAlpha(void) { return d_alpha; } /* * DBeta: * * return the beta prior parameter setting to the gamma * distribution prior for the range parameter */ double* Exp_Prior::DBeta(void) { return d_beta; } /* * Draw: * * draws for the hierarchical priors for the Exp * correlation function which are * contained in the params module */ void Exp_Prior::Draw(Corr **corr, unsigned int howmany, void *state) { if(!fix_d) { double *d = new_vector(howmany); for(unsigned int i=0; iD(); mixture_priors_draw(d_alpha, d_beta, d, howmany, d_alpha_lambda, d_beta_lambda, state); free(d); } /* hierarchical prior draws for the nugget */ DrawNugHier(corr, howmany, state); } /* * log_Prior: * * compute the (log) prior for the parameters to * the correlation function (e.g. d and nug) : does * not include priors of hierarchical params. See * log_HierPrior, below */ double Exp_Prior::log_Prior(double d, bool linear) { double prob = 0; /* force linear model */ if(gamlin[0] < 0) return prob; /* force gp model */ prob += log_d_prior_pdf(d, d_alpha, d_beta); if(gamlin[0] <= 0) return prob; /* using 1.0, because of 1.0 - lin_pdf, and will adjust later */ double lin_pdf = linear_pdf(&d, 1, gamlin); if(linear) prob += log(lin_pdf); else prob += log(1.0-lin_pdf); /* return the log pdf */ return prob; } /* * BasePrior: * * return the prior for the Base (eg Gp) model */ Base_Prior* Exp_Prior::BasePrior(void) { return base_prior; } /* * SetBasePrior: * * set the base_prior field */ void Exp_Prior::SetBasePrior(Base_Prior *base_prior) { this->base_prior = base_prior; } /* * Print: * * pretty print the correllation function parameters out * to a file */ void Exp_Prior::Print(FILE *outfile) { MYprintf(MYstdout, "corr prior: isotropic power\n"); /* print nugget stuff first */ PrintNug(outfile); /* range parameter */ // MYprintf(outfile, "starting d=%g\n", d); /* range gamma prior */ MYprintf(outfile, "d[a,b][0,1]=[%g,%g],[%g,%g]\n", d_alpha[0], d_beta[0], d_alpha[1], d_beta[1]); /* range gamma hyperprior */ if(fix_d) MYprintf(outfile, "d prior fixed\n"); else { MYprintf(MYstdout, "d lambda[a,b][0,1]=[%g,%g],[%g,%g]\n", d_alpha_lambda[0], d_beta_lambda[0], d_alpha_lambda[1], d_beta_lambda[1]); } } /* * log_HierPrior: * * return the log prior of the hierarchial parameters * to the correllation parameters (i.e., range and nugget) */ double Exp_Prior::log_HierPrior(void) { double lpdf; lpdf = 0.0; /* mixture prior for the range parameter, d */ if(!fix_d) { lpdf += mixture_hier_prior_log(d_alpha, d_beta, d_alpha_lambda, d_beta_lambda); } /* mixture prior for the nugget */ lpdf += log_NugHierPrior(); return lpdf; } /* * Trace: * * return the current values of the hierarchical * parameters to this correlation function: * nug(alpha,beta), d(alpha,beta), then linear */ double* Exp_Prior::Trace(unsigned int* len) { /* first get the hierarchical nug parameters */ unsigned int clen; double *c = NugTrace(&clen); /* calculate and allocate the new trace, which will include the nug trace */ *len = 4; double* trace = new_vector(clen + *len); trace[0] = d_alpha[0]; trace[1] = d_beta[0]; trace[2] = d_alpha[1]; trace[3] = d_beta[1]; /* then copy in the nug trace */ dupv(&(trace[*len]), c, clen); /* new combined length, and free c */ *len += clen; if(c) free(c); else assert(clen == 0); return trace; } /* * TraceNames: * * return the names of the traces recorded in Exp_Prior::Trace() */ char** Exp_Prior::TraceNames(unsigned int* len) { /* first get the hierarchical nug parameters */ unsigned int clen; char **c = NugTraceNames(&clen); /* calculate and allocate the new trace, which will include the nug trace */ *len = 4; char** trace = (char**) malloc(sizeof(char*) * (clen + *len)); trace[0] = strdup("d.a0"); trace[1] = strdup("d.g0"); trace[2] = strdup("d.a1"); trace[3] = strdup("d.g1"); /* then copy in the nug trace */ for(unsigned int i=0; i #include #include #include #include #include #include using namespace std; #define BUFFMAX 256 #define PWR 1.0 /* * Matern: * * constructor function */ Matern::Matern(unsigned int dim, Base_Prior *base_prior) : Corr(dim, base_prior) { /* sanity checks */ assert(base_prior->BaseModel() == GP); assert( ((Gp_Prior*) base_prior)->CorrPrior()->CorrModel() == MATERN); /* set the prior */ prior = ((Gp_Prior*) base_prior)->CorrPrior(); assert(prior); /* check if we should really be starting in the LLM */ if(!prior->Linear() && !prior->LLM()) linear = false; /* get default nugget for starters */ nug = prior->Nug(); /* get defualt nu for starters, and assert that it is positive */ nu = ((Matern_Prior*) prior)->NU(); assert(nu > 0); /* allocate vector for K_bessel */ nb = (long) floor(nu)+1; bk = new_vector(nb); /* set up stuff for the range parameter */ d = ((Matern_Prior*) prior)->D(); xDISTx = NULL; nd = 0; dreject = 0; } /* * Matern (assignment operator): * * used to assign the parameters of one correlation * function to anothers. Both correlation functions * must already have been allocated. */ Corr& Matern::operator=(const Corr &c) { Matern *e = (Matern*) &c; /* copy nu parameter */ nu = e->nu; /* allocate a new bk if nb has changed */ if(floor(nu)+1 != nb) { free(bk); nb = (long) floor(nu)+1; bk = new_vector(nb); } /* copy "global" correllation stuff */ log_det_K = e->log_det_K; linear = e->linear; /* copy stuff for range parameter; don't copy nd */ d = e->d; dreject = e->dreject; /* copy nugget */ nug = e->nug; /* sanity checks */ assert(prior->CorrModel() == MATERN); assert(prior == ((Gp_Prior*) base_prior)->CorrPrior()); /* copy the covariance matrices -- no longer performed due the new economy argument in Gp/Base */ // Cov(e); return *this; } /* * ~Matern: * * destructor */ Matern::~Matern(void) { if(bk) free(bk); if(xDISTx) delete_matrix(xDISTx); xDISTx = NULL; } /* * Init: * * initialise this corr function with the parameters provided * from R via the vector of doubles */ void Matern::Init(double *dmat) { d = dmat[1]; NugInit(dmat[0], ! (bool) dmat[2]); } /* * Jitter: * * fill jitter[ ] with the variance inflation factor. That is, * the variance for an observation with covariates in the i'th * row of X will be s2*(1.0 + jitter[i]). In standard tgp, the * jitter is simply the nugget. But for calibration and mr tgp, * the jitter value depends upon X (eg real or simulated data). * */ double* Matern::Jitter(unsigned int n1, double **X) { double *jitter = new_vector(n1); for(unsigned int i=0; in); if(runi(state) > 0.5) return false; /* make the draw */ double nug_new = nug_draw_margin(n, col, nug, F, Z, K, log_det_K, *lambda, Vb, K_new, Ki_new, Kchol_new, &log_det_K_new, &lambda_new, Vb_new, bmu_new, gp_prior->get_b0(), gp_prior->get_Ti(), gp_prior->get_T(), tau2, prior->NugAlpha(), prior->NugBeta(), gp_prior->s2Alpha(), gp_prior->s2Beta(), (int) linear, itemp, state); /* did we accept the draw? */ if(nug_new != nug) { nug = nug_new; success = true; swap_new(Vb, bmu, lambda); } return success; } /* * Update: (symmetric) * * compute correlation matrix K */ void Matern::Update(unsigned int n, double **X) { if(linear) return; assert(this->n == n); if(!xDISTx || nd != n) { if(xDISTx) delete_matrix(xDISTx); xDISTx = new_matrix(n, n); nd = n; } dist_symm(xDISTx, dim, X, n, PWR); matern_dist_to_K_symm(K, xDISTx, d, nu, bk, nug, n); //delete_matrix(xDISTx); } /* * Update: (symmetric) * * takes in a (symmetric) distance matrix and * returns a correlation matrix */ void Matern::Update(unsigned int n, double **K, double **X) { double ** xDISTx = new_matrix(n, n); dist_symm(xDISTx, dim, X, n, PWR); matern_dist_to_K_symm(K, xDISTx, d, nu, bk, nug, n); delete_matrix(xDISTx); } /* * Update: (non-symmetric) * * takes in a distance matrix and * returns a correlation matrix */ void Matern::Update(unsigned int n1, unsigned int n2, double **K, double **X, double **XX) { double **xxDISTx = new_matrix(n2, n1); dist(xxDISTx, dim, XX, n1, X, n2, PWR); matern_dist_to_K(K, xxDISTx, d, nu, bk, nug, n1, n2); delete_matrix(xxDISTx); } /* * Draw: * * draw parameters for a new correlation matrix; * returns true if the correlation matrix (passed in) * has changed; otherwise returns false */ int Matern::Draw(unsigned int n, double **F, double **X, double *Z, double *lambda, double **bmu, double **Vb, double tau2, double itemp, void *state) { int success = 0; bool lin_new; double q_fwd , q_bak, d_new; /* sometimes skip this Draw for linear models for speed */ if(linear && runi(state) > 0.5) return DrawNugs(n, X, F, Z, lambda, bmu, Vb, tau2, itemp, state); /* proppose linear or not */ if(prior->Linear()) lin_new = true; else { q_fwd = q_bak = 1.0; d_proposal(1, NULL, &d_new, &d, &q_fwd, &q_bak, state); if(prior->LLM()) lin_new = linear_rand(&d_new, 1, prior->GamLin(), state); else lin_new = false; } /* if not linear than compute new distances */ /* allocate K_new, Ki_new, Kchol_new */ if(! lin_new) { if(!xDISTx || nd != n) { if(xDISTx) delete_matrix(xDISTx); xDISTx = new_matrix(n, n); nd = n; } dist_symm(xDISTx, dim, X, n, PWR); allocate_new(n); assert(n == this->n); } /* d; rebuilding K, Ki, and marginal params, if necessary */ if(prior->Linear()) d_new = d; else { Gp_Prior *gp_prior = (Gp_Prior*) base_prior; Matern_Prior* ep = (Matern_Prior*) prior; success = matern_d_draw_margin(n, col, d_new, d, F, Z, xDISTx, log_det_K, *lambda, Vb, K_new, Ki_new, Kchol_new, &log_det_K_new, &lambda_new, Vb_new, bmu_new, gp_prior->get_b0(), gp_prior->get_Ti(), gp_prior->get_T(), tau2, nug, nu, bk, q_bak/q_fwd, ep->DAlpha(), ep->DBeta(), gp_prior->s2Alpha(), gp_prior->s2Beta(), (int) lin_new, itemp, state); } /* did we accept the new draw? */ if(success == 1) { d = d_new; linear = (bool) lin_new; swap_new(Vb, bmu, lambda); dreject = 0; } else if(success == -1) return success; else if(success == 0) dreject++; /* abort if we have had too many rejections */ if(dreject >= REJECTMAX) return -2; /* draw nugget */ bool changed = DrawNugs(n, X, F, Z, lambda, bmu, Vb, tau2, itemp, state); success = success || changed; /* return true if anything has changed about the corr matrix */ return success; } /* * Combine: * * used in tree-prune steps, chooses one of two * sets of parameters to correlation functions, * and choose one for "this" correlation function */ void Matern::Combine(Corr *c1, Corr *c2, void *state) { get_delta_d((Matern*)c1, (Matern*)c2, state); CombineNug(c1, c2, state); } /* * Split: * * used in tree-grow steps, splits the parameters * of "this" correlation function into a parameterization * for two (new) correlation functions */ void Matern::Split(Corr *c1, Corr *c2, void *state) { propose_new_d((Matern*) c1, (Matern*) c2, state); SplitNug(c1, c2, state); } /* * get_delta_d: * * compute d from two ds (used in prune) */ void Matern::get_delta_d(Matern* c1, Matern* c2, void *state) { double dch[2]; int ii[2]; dch[0] = c1->d; dch[1] = c2->d; propose_indices(ii, 0.5, state); d = dch[ii[0]]; linear = linear_rand(&d, 1, prior->GamLin(), state); } /* * propose_new_d: * * propose new D parameters for possible * new children partitions. */ void Matern::propose_new_d(Matern* c1, Matern* c2, void *state) { int i[2]; double dnew[2]; Matern_Prior *ep = (Matern_Prior*) prior; propose_indices(i, 0.5, state); dnew[i[0]] = d; if(prior->Linear()) dnew[i[1]] = d; else dnew[i[1]] = d_prior_rand(ep->DAlpha(), ep->DBeta(), state); c1->d = dnew[0]; c2->d = dnew[1]; c1->linear = (bool) linear_rand(&(dnew[0]), 1, prior->GamLin(), state); c2->linear = (bool) linear_rand(&(dnew[1]), 1, prior->GamLin(), state); } /* * State: * * return a string depecting the state * of the (parameters of) correlation function */ char* Matern::State(unsigned int which) { char buffer[BUFFMAX]; #ifdef PRINTNUG string s = "(d="; #else string s = ""; #endif if(linear) sprintf(buffer, "0(%g)", d); else sprintf(buffer, "%g", d); s.append(buffer); #ifdef PRINTNUG sprintf(buffer, ", g=%g)", nug); s.append(buffer); #endif char* ret_str = (char*) malloc(sizeof(char) * (s.length()+1)); strncpy(ret_str, s.c_str(), s.length()); ret_str[s.length()] = '\0'; return ret_str; } /* * sum_b: * * return 1 if linear, 0 otherwise */ unsigned int Matern::sum_b(void) { if(linear) return 1; else return 0; } /* * ToggleLinear: * * make linear if not linear, otherwise * make not linear */ void Matern::ToggleLinear(void) { if(linear) { linear = false; } else { linear = true; } } /* * D: * * return the range parameter */ double Matern::D(void) { return d; } /* * NU: * * return the nu parameter */ double Matern::NU(void) { return nu; } /* * log_Prior: * * compute the (log) prior for the parameters to * the correlation function (e.g. d and nug). Does not * include hierarchical prior params; see log_HierPrior * below */ double Matern::log_Prior(void) { double prob = ((Corr*)this)->log_NugPrior(); prob += ((Matern_Prior*) prior)->log_Prior(d, linear); return prob; } /* * TraceNames: * * return the names of the parameters recorded by Matern::Trace() */ char** Matern::TraceNames(unsigned int* len) { *len = 4; char **trace = (char**) malloc(sizeof(char*) * (*len)); trace[0] = strdup("nug"); trace[1] = strdup("d"); trace[2] = strdup("b"); /* determinant of K */ trace[3] = strdup("ldetK"); return trace; } /* * Trace: * * return the current values of the parameters * to this correlation function */ double* Matern::Trace(unsigned int* len) { *len = 4; double *trace = new_vector(*len); trace[0] = nug; trace[1] = d; trace[2] = (double) !linear; /* determinant of K */ trace[3] = log_det_K; return trace; } void Matern::Invert(unsigned int n) { if(! linear) { assert(n == this->n); inverse_chol(K, Ki, Kchol, n); log_det_K = log_determinant_chol(Kchol, n); } else { assert(n > 0); log_det_K = n * log(1.0 + nug); } } /* * newCorr: * * construct and return a new isotropic exponential correlation * function with this module governing its prior parameterization */ Corr* Matern_Prior::newCorr(void) { return new Matern(dim, base_prior); } /* * Matern_Prior: * * constructor for the prior distribution for * the exponential correlation function */ Matern_Prior::Matern_Prior(unsigned int dim) : Corr_Prior(dim) { corr_model = MATERN; /* defaults */ d = 0.5; nu = 1.0; default_d_priors(); default_d_lambdas(); } /* * Init: * * read hiererchial prior parameters from a double-vector * */ void Matern_Prior::Init(double *dhier) { d_alpha[0] = dhier[0]; d_beta[0] = dhier[1]; d_alpha[1] = dhier[2]; d_beta[1] = dhier[3]; NugInit(&(dhier[4])); } /* * Dup: * * duplicate this prior for the isotropic exponential * power family */ Corr_Prior* Matern_Prior::Dup(void) { return new Matern_Prior(this); } /* * Matern_Prior (new duplicate) * * duplicating constructor for the prior distribution for * the exponential correlation function */ Matern_Prior::Matern_Prior(Corr_Prior *c) : Corr_Prior(c) { Matern_Prior *e = (Matern_Prior*) c; assert(e->corr_model == MATERN); corr_model = e->corr_model; dupv(gamlin, e->gamlin, 3); d = e->d; nu = e->nu; fix_d = e->fix_d; dupv(d_alpha, e->d_alpha, 2); dupv(d_beta, e->d_beta, 2); dupv(d_alpha_lambda, e->d_alpha_lambda, 2); dupv(d_beta_lambda, e->d_beta_lambda, 2); } /* * ~Matern_Prior: * * destructor the the prior distribution for * the exponential correlation function */ Matern_Prior::~Matern_Prior(void) { } /* * read_double: * * read prior parameterization from a vector of doubles * passed in from R */ void Matern_Prior::read_double(double *dparams) { /* read the parameters that have to to with the * nugget first */ read_double_nug(dparams); /* starting value for the range parameter */ d = dparams[1]; // MYprintf(MYstdout, "starting range=%g\n", d); /* reset dparams to start after the nugget gamlin params */ dparams += 13; /* initial parameter settings for alpha and beta */ get_mix_prior_params_double(d_alpha, d_beta, &(dparams[0]), "d"); dparams += 4; /* reset */ /* d hierarchical lambda prior parameters */ if((int) dparams[0] == -1) { fix_d = true; /*MYprintf(MYstdout, "fixing d prior\n");*/ } else { fix_d = false; get_mix_prior_params_double(d_alpha_lambda, d_beta_lambda, &(dparams[0]), "d lambda"); } dparams += 4; /* reset */ /* read the fixed nu parameter */ nu = dparams[0]; // MYprintf(MYstdout, "fixed nu=%g\n", nu); dparams += 1; /* reset */ } /* * read_ctrlfile: * * read prior parameterization from a control file */ void Matern_Prior::read_ctrlfile(ifstream *ctrlfile) { char line[BUFFMAX], line_copy[BUFFMAX]; /* read the parameters that have to do with the * nugget first */ read_ctrlfile_nug(ctrlfile); /* read the d parameter from the control file */ ctrlfile->getline(line, BUFFMAX); d = atof(strtok(line, " \t\n#")); MYprintf(MYstdout, "starting d=%g\n", d); /* read d and nug-hierarchical parameters (mix of gammas) */ ctrlfile->getline(line, BUFFMAX); get_mix_prior_params(d_alpha, d_beta, line, "d"); /* d hierarchical lambda prior parameters */ ctrlfile->getline(line, BUFFMAX); strcpy(line_copy, line); if(!strcmp("fixed", strtok(line_copy, " \t\n#"))) { fix_d = true; MYprintf(MYstdout, "fixing d prior\n"); } else { fix_d = false; get_mix_prior_params(d_alpha_lambda, d_beta_lambda, line, "d lambda"); } /* read the (fixed) nu parameter */ ctrlfile->getline(line, BUFFMAX); nu = atof(strtok(line, " \t\n#")); MYprintf(MYstdout, "fixed nu=%g\n", nu); } /* * default_d_priors: * * set d prior parameters * to default values */ void Matern_Prior::default_d_priors(void) { d_alpha[0] = 1.0; d_beta[0] = 20.0; d_alpha[1] = 10.0; d_beta[1] = 10.0; } /* * default_d_lambdas: * * set d (lambda) hierarchical prior parameters * to default values */ void Matern_Prior::default_d_lambdas(void) { d_alpha_lambda[0] = 1.0; d_beta_lambda[0] = 10.0; d_alpha_lambda[1] = 1.0; d_beta_lambda[1] = 10.0; fix_d = false; //fix_d = true; } /* * D: * * return the default nu parameter setting * for the exponential correllation function */ double Matern_Prior::D(void) { return d; } /* * NU: * * return the nu parameter */ double Matern_Prior::NU(void) { return nu; } /* * DAlpha: * * return the alpha prior parameter setting to the gamma * distribution prior for the nu parameter */ double* Matern_Prior::DAlpha(void) { return d_alpha; } /* * DBeta: * * return the beta prior parameter setting to the gamma * distribution prior for the nu parameter */ double* Matern_Prior::DBeta(void) { return d_beta; } /* * Draw: * * draws for the hierarchical priors for the Matern * correlation function which are * contained in the params module */ void Matern_Prior::Draw(Corr **corr, unsigned int howmany, void *state) { if(!fix_d) { double *d = new_vector(howmany); for(unsigned int i=0; iD(); mixture_priors_draw(d_alpha, d_beta, d, howmany, d_alpha_lambda, d_beta_lambda, state); free(d); } /* hierarchical prior draws for the nugget */ DrawNugHier(corr, howmany, state); } /* * log_Prior: * * compute the (log) prior for the parameters to * the correlation function (e.g. d and nug) */ double Matern_Prior::log_Prior(double d, bool linear) { double prob = 0; /* force linear model */ if(gamlin[0] < 0) return prob; prob += log_d_prior_pdf(d, d_alpha, d_beta); /* force GP model */ if(gamlin[0] <= 0) return prob; /* using 1.0, because of 1.0 - lin_pdf, and will adjust later */ double lin_pdf = linear_pdf(&d, 1, gamlin); if(linear) prob += log(lin_pdf); else prob += log(1.0-lin_pdf); /* return the log pdf */ return prob; } /* * BasePrior: * * return the prior for the Base (eg Gp) model */ Base_Prior* Matern_Prior::BasePrior(void) { return base_prior; } /* * SetBasePrior: * * set the base_prior field */ void Matern_Prior::SetBasePrior(Base_Prior *base_prior) { this->base_prior = base_prior; } /* * Print: * * pretty print the correllation function parameters out * to a file */ void Matern_Prior::Print(FILE *outfile) { MYprintf(MYstdout, "corr prior: matern\n"); /* print nugget stuff first */ PrintNug(outfile); /* range parameter */ // MYprintf(outfile, "starting d=%g\n", d); /* nu, smoothness parameter */ MYprintf(MYstdout, "fixed nu=%g\n", nu); /* range gamma prior */ MYprintf(outfile, "d[a,b][0,1]=[%g,%g],[%g,%g]\n", d_alpha[0], d_beta[0], d_alpha[1], d_beta[1]); /* range gamma hyperprior */ if(fix_d) MYprintf(outfile, "d prior fixed\n"); else { MYprintf(MYstdout, "d lambda[a,b][0,1]=[%g,%g],[%g,%g]\n", d_alpha_lambda[0], d_beta_lambda[0], d_alpha_lambda[1], d_beta_lambda[1]); } } /* * log_HierPrior: * * return the log prior of the hierarchial parameters * to the correllation parameters (i.e., range and nugget) */ double Matern_Prior::log_HierPrior(void) { double lpdf; lpdf = 0.0; /* mixture prior for the range parameter, d */ if(!fix_d) { lpdf += mixture_hier_prior_log(d_alpha, d_beta, d_alpha_lambda, d_beta_lambda); } /* mixture prior for the nugget */ lpdf += log_NugHierPrior(); return lpdf; } /* * Trace: * * return the current values of the hierarchical * parameters to this correlation function: * nug(alpha,beta), d(alpha,beta), then linear */ double* Matern_Prior::Trace(unsigned int* len) { /* first get the hierarchical nug parameters */ unsigned int clen; double *c = NugTrace(&clen); /* calculate and allocate the new trace, which will include the nug trace */ *len = 4; double* trace = new_vector(clen + *len); trace[0] = d_alpha[0]; trace[1] = d_beta[0]; trace[2] = d_alpha[1]; trace[3] = d_beta[1]; /* then copy in the nug trace */ dupv(&(trace[*len]), c, clen); /* new combined length, and free c */ *len += clen; if(c) free(c); else assert(clen == 0); return trace; } /* * TraceNames: * * return the names of the traces recorded in Matern_Prior::Trace() */ char** Matern_Prior::TraceNames(unsigned int* len) { /* first get the hierarchical nug parameters */ unsigned int clen; char **c = NugTraceNames(&clen); /* calculate and allocate the new trace, which will include the nug trace */ *len = 4; char** trace = (char**) malloc(sizeof(char*) * (clen + *len)); trace[0] = strdup("d.a0"); trace[1] = strdup("d.g0"); trace[2] = strdup("d.a1"); trace[3] = strdup("d.g1"); /* then copy in the nug trace */ for(unsigned int i=0; i> endobj 2 0 obj << /Type /Pages /Kids [ 3 0 R ] /Count 1 >> endobj 3 0 obj << /Type /Page /Parent 2 0 R /Resources << /XObject << /Im0 8 0 R >> /ProcSet 6 0 R >> /MediaBox [0 0 504 360] /CropBox [0 0 504 360] /Contents 4 0 R /Thumb 11 0 R >> endobj 4 0 obj << /Length 5 0 R >> stream q 504 0 0 360 0 0 cm /Im0 Do Q endstream endobj 5 0 obj 31 endobj 6 0 obj [ /PDF /Text /ImageC ] endobj 7 0 obj << >> endobj 8 0 obj << /Type /XObject /Subtype /Image /Name /Im0 /Filter [ /RunLengthDecode ] /Width 504 /Height 360 /ColorSpace 10 0 R /BitsPerComponent 8 /SMask 15 0 R /Length 9 0 R >> stream            & ZC )ւ , b  9t  + (+(+}Yd}:d}0~k~*IIFIdIOW[OeIxxLHSS`OxIqGERhzET\[tdETE1Y~kN4cE]K`KKKLG&&t"&m !  Qwm9I6+;t%Q( ^       Q t   )%CQR  Z|m66q$$ endstream endobj 9 0 obj 24004 endobj 10 0 obj /DeviceRGB endobj 11 0 obj << /Filter [ /RunLengthDecode ] /Width 106 /Height 76 /ColorSpace 10 0 R /BitsPerComponent 8 /Length 12 0 R >> stream  <_T0D`ق < A    G#fXS ~ 4N gk/ ! #\8   {L 4d6( fp iF@ϊ+&&3+$G|Vj)0P 4 %%90u56ia"6o &&47flW^gYYafuq*, S7_ZQb`3V=59,1Fs9H~?GM c  r (h Qt FNXy) Th A>m ?ng zI3; ̓L"  g5O =  Qm? g e 4+;!S R" W0]k I $.u1 6 f  e   =Y l L  v > 0    }  'Lz ^r   `} A݂|y? 2  endstream endobj 12 0 obj 3380 endobj 13 0 obj endobj 14 0 obj 3380 endobj 15 0 obj << /Type /XObject /Subtype /Image /Name /Ma0 /Filter [ /RunLengthDecode ] /Width 504 /Height 360 /ColorSpace /DeviceGray /BitsPerComponent 8 /Length 16 0 R >> stream fݙDUD33݈Uf3ff" ݻ3DUUf"U3Uf333w333DD33݈UwwUDDÜ"UU f"UDU"ݻDUUD̈"UUUDff  w33w Uwwf3UD""3UDD"fD"wwwffwUDD3DDw 3ww3fD" 3DUDDUDDfU  3DDwDUU  ݈ ݈ ݻ DDDD3ff f3" ݪ "U3Dww"DDDD" 3 ww D3 ff3Üwf ̻fw fDUÜÜݻD w UU f݈f fD3D ffUU"f݈f݈ff 3݈ UfwfD3D"3"DDDDUUۈωDDDDUDD wUDDwUD"U3DDwfwf3DD"D"DfDDDDwUwU3DDDf3D3̙DDD"wU33DDD f"U UUf3DDUf 3̈UN̻"DD3ffDD"DD"DDfDDUDD3DDDD"D"DDf3DD3fDDf3DDDUUDDD3wDDUDw3UDD3̻݈U̪DDf3UDݙD""w3̪D""DwUUUDDDUw3̪D""DfDwUDݙD33"w"DfĂDD 3݈DDDuDuǂ̻fݙ"3@DuǤ[" 3f"f"߉DuǂϷDwfĭw"DD""uǂU"݈UD"fDffD"݈uǂUwDD f"D"ݪD"UffD3"fuǤf"U ̈3݈DD3wf"DDuǂD̻f̈D݊DuǂUD"3Duǂf3DuǤUUDuǂUUDDwDuǂfDDw3"ff3DDuǂf3f3DẅݙDU"DuǤ U"DݻDf݈f3"Duǂf̻f3D"UDDw3w"DuǂDf"DUٙ3̈ٻwDDuǂUww33N3DuǤf3fU fw߈kDuǂ3"UfֈDwDuǂUf33Uwѻf"Duǂf3f3Df3fDuǤU33 iwDuǟ"fw3f "ڈ Duǟf"33fw3Duǟ3D3"UUUDuǤUwDf33"Df3DuǠU"̭UDfwff3Duǡ"fffUf3Duǡww"3 DUf3DuǤ33̯3U w3w݈f3DuǢ33wD""f3Df3DuǢww"D3fUf"D̈DuǢ"ݱ"fwfݻw"̪D3w̻UDD3DuǤU3w""f3wwݻfDDU"DuǣUw3"f"fD3" DfݻU3DU̻UDDuǤ"3ݪ"f"D Dw̻DD"DD̻UDDuǤwUfUwww"wU DfݗUDDD"DuǤ3f UUD3"D3"f݈"̈"UU"3w3D3fwDU3UwDuǤ3 UfU3D"D݈"fDDD"fUUfwDuǤff3f"Uݻ̪U3fDDf"wDDuǤUUD3Ư"33D3"w"Uwf3wDDuǥD3UU"wUfUf݈f݈3ݙ̻݈ݙDuǥDw DffU"D"z"̙"wU"fUDw3Dw3Dw3Duǥwfݸw UwfwffwUDuǥ33 Dw33"DwDDDuǥwf33UU"ljf UwݻfֻDuǥDDf3w33i Dw"UDݙuwU33U"3DD"￈www3UUf3D""uU"w\DUffUw""UU""wĴuw3D̵f3"wi"DDwD"DUD`N3#"DDiD̈DD0DDuw3D3DD"3D3 3D3"DDwf3fDUUU"D3UUf3DD0DDD""Di̻$ߏf3w݈̻f""3DU3Ǫ컧UDf3"Df̻Dݙuf͏3fȾuڬu*~쑑uеڑ왇uDDḭu~ʧ߈@ݻ3fÜDUDDP\P͂wfDwLjǻD֖i[Du׿&߈߻ѻػֻ֣DUf"f"ff"f݈3DD "wDDu(ѿڻ߻ǿU[UDUw3ȧݴ̈3D̈i3 UU"Du3wDD3' \Ȉ"ÏDU\\DiD\uw wD3"Df3f3w3wU3 Du ݈3DÙ̈D\3D3w"DȈpDU"wU݈DuUwU3 3ⵈw[3Dw 3"D̈"Duǿ DNwU ̕ݫwwDDfU݈ݪw"wݻfDD"D"DuǾw"f Df֣Dֈ3߀D3D""̪3ݻ݈Duǥfw3"̙ݪ3w3fDDuǥ ݯw3DwfUfUff"DDw3fDuǥ Uw3U33f Df3"U"DDfUD"Duǥ D뗈fDD"f3UD3D"̻UD3U̻Duǥ "ffDf3DfUD3"D3DuǤ w@DD"DDwwD"f"U333fDD"DDuǤ ߂Uw3̗33Uf3"DDwf̈D"DfDuǤ ?ff"fUf33wDf""UDD wf"Uf3DUwDD"DuǤ D "fUUf"P D3DfUUD"\fD"D3uǤUf DDDw3Df "UUݙ Df"DD33ݙݙ"UUff 3DfD3DwDDU3uǤLjDi݈3Dݙ33i ̻fDUu33"D3Dݙ3wU 3Df"Dww3DUDuǤDN3wDf 3Dw "3333D̈3wfDD3DuǤDwꏏߧu"U3ݦDfDfD3""fD"D"uǣ33ѻւw3" UfUDDDfwD"uǤ"U@www"""UDD3D""Duǣ3DU""33̈D3Uݙf3݈̈3Df3uǣDݻwݻ3f3D3DfD"uǣ f3"3fUD"ffwUf33w"DDuǤwfDUD3Df3"DDuǣD 3ffU3ff3"3DuǣD굙i3f DD̪DDfݙ"fݻDDuǢכUU"3w3"wf݈U"3Df3uǤ333U""3fD"uǢ"DUf3"f3DDDuǢD"wDwwwUݙ"wDuǢfẁ3"3w"D"݈w"DuǤwDND33ݻ݈3Uݙ"DuǢDww33wf3UfU"DDDwuǢ3D"DDwfU3w3 "DwfDwuǡ3݈3U""wfDf"DD""fDD3wuǤff33UwD"D33 U݈"DDDuǡ3"w"UfDUD3w3ݙuǡDD["Dw3"D""uǡwDUU"ݙ"fD"uǤf3"U"wDw "UD""uǡD3"3"wDDf"ݞDݙuǡ"DǿUwDfw"DuǠ""""3Uw`3"DuǤDD"ffD̂DuǠ3"֪"fȻ""3ݻfDuǠD w@w@"f3"Dfՠ zfUww"D"wfD""uǤf 3謹DDf3D"3ݪ3UD"݈uǠD ݤ괿DU33wU"D3"fuǠ"DD3UDUU݈Dw"DfuǟifDDwfk"fDffwwDuǤ DUUf3 U3fwDDuǟ D"Ư"UDD 3"w3fwDuǟDw̏3Dי̈UfUwwDuǟDw"Df"D"D3"ffDuǤUD0DD3"ݙDfuǟD 3UU3DUfݻwDuǞDfDD3i"f3DuǞfD3fwUDuǤwD3Dw""`fU3UDuǝf݈ff"""D3UfDuǝUDw3fwPUf"DuǜU3"3UUD̗DuǤffU3UwݒDuǜUUpU̪w3DuǛ`3U"D3D"݂DuǛUffݻ݈3"DwݻffDuǤUwD""ffD̄""UDuǚwwfwDf"ݪDDuǚU݈DwkfDDÜ3"wfUUDuǚf""Df3w݈"3U"3"fDuǤ"wD"wUDuǙw݈Dw"3f3̂DuǙfww"UwDuǘ "Dw3DuǤfffwD3"݂DuǘDUwffDuǘ33D`fU""ݒDuǗw3ffDfDuǤ3D̻U"3"`DDuǖ3D"fU3̈Df3ff̈UDuǖw"""UfDU3DuǖDu33"̂DuǤU3"wDݙuǕD D3p̈w"D""uǕfw݈fw"f3f3"̂DuǕ "3Df33fD""uǤUwD3fUDݙuǓUw"3DuǓ0D"Dw̻33̏DuǓfDUfwUwDݙuǤDUD"DD""uǒ"D"f"DuǒDfݻ"3D""uǒf DUDDݙuǤD D"Uf3D3"3DDґ3"љff3݈̪f3̂D"D~f"3DfDw3wDDk"fDfDD U w""ff3DDD fߗ""fD3UDf3DݙD3DD fݻDDfw"33 wDfDff 3U3UDDU3DDffDU"݂DD"DDDfDDwDUw3w"f3ݻDD"UfU"D̪̙DD"DDD3333U3DUf݂DfDwDD3D3̂DD3fDUwwDDUUwfwfu3D U""DDf3DfDff3̈DD "P"3DwDDfDĈf"DD3wU""̂DD""D"UwDD w"ww"w3DDPw w"fwwfw"݂DD333U"DD3"wDDD"fDU33DDw ψ3""3w3DDP "̻ffݻ̻"fDD3Pw3 @DD3UDDU3wwDDD"D3DDDD3U"DD"Uf"wD"̂DD3"wDDwwUDDDDDUDDDf3"DD̻DfDDf3DDDDUD̂DDfDD""DDDUݿ3DDDDDDDDDDDDDD f3 333" D wU3DD"""f33DD333"" D33̂w3U"3w"""fD33f"33""33݂  D 3 UU3D"U 3  D݂ "3 endstream endobj 16 0 obj 18421 endobj 17 0 obj << /Title (motovate_btgp.pdf) /CreationDate (D:20110401184121) /ModDate (D:20110401184121) /Producer (ImageMagick 6.5.8-4 2009-12-15 Q16 http://www.imagemagick.org) >> endobj xref 0 18 0000000000 65535 f 0000000010 00000 n 0000000059 00000 n 0000000118 00000 n 0000000300 00000 n 0000000383 00000 n 0000000401 00000 n 0000000439 00000 n 0000000460 00000 n 0000024664 00000 n 0000024685 00000 n 0000024712 00000 n 0000028237 00000 n 0000028258 00000 n 0000028274 00000 n 0000028295 00000 n 0000046909 00000 n 0000046931 00000 n trailer << /Size 18 /Info 17 0 R /Root 1 0 R >> startxref 47115 %%EOF tgp/vignettes/motovate_bgp.pdf0000644000176200001440000013156313531032535016246 0ustar liggesusers%PDF-1.4 1 0 obj << /Pages 2 0 R /Type /Catalog >> endobj 2 0 obj << /Type /Pages /Kids [ 3 0 R ] /Count 1 >> endobj 3 0 obj << /Type /Page /Parent 2 0 R /Resources << /XObject << /Im0 8 0 R >> /ProcSet 6 0 R >> /MediaBox [0 0 504 360] /CropBox [0 0 504 360] /Contents 4 0 R /Thumb 11 0 R >> endobj 4 0 obj << /Length 5 0 R >> stream q 504 0 0 360 0 0 cm /Im0 Do Q endstream endobj 5 0 obj 31 endobj 6 0 obj [ /PDF /Text /ImageC ] endobj 7 0 obj << >> endobj 8 0 obj << /Type /XObject /Subtype /Image /Name /Im0 /Filter [ /RunLengthDecode ] /Width 504 /Height 360 /ColorSpace 10 0 R /BitsPerComponent 8 /SMask 15 0 R /Length 9 0 R >> stream "6h9 ` 6     ZKP  "  "   )     4   %  4 %6"6o  Q 9)? mCKCh?9 m   o    ?       %" % (    L4,&Go6   t !oh|Yo$6Ђ endstream endobj 9 0 obj 23310 endobj 10 0 obj /DeviceRGB endobj 11 0 obj << /Filter [ /RunLengthDecode ] /Width 106 /Height 76 /ColorSpace 10 0 R /BitsPerComponent 8 /Length 12 0 R >> stream A΂k & :m W v   ** 39K2pyv  c  y  %%m4\ d}^P /  R\{ ! \'F cM  &% ۂK;]:\  endstream endobj 12 0 obj 2782 endobj 13 0 obj endobj 14 0 obj 2782 endobj 15 0 obj << /Type /XObject /Subtype /Image /Name /Ma0 /Filter [ /RunLengthDecode ] /Width 504 /Height 360 /ColorSpace /DeviceGray /BitsPerComponent 8 /Length 16 0 R >> stream D U wU" U3Uwf"U333333333f3D3݈UU3݈D"!"UUU"ݻUDUU!ff"UU3U""33U3D"3D"ff 3UwwwUDD D3wDDwDDff wDD U ݻ ݈ ݈  w"w!3wf"fD"D"D"D"" " ff D"D" ww DݻUf33 f 3 UU UD!3݈"fw݈DDfU fU D UDDŵDDDDDUUDDDDDDDDDD"wf3DD "݈D3UwDfDDDwDfݙ"3DDDPwݻ3DDDwUU݈3DDDUDf3DD"̙fDfUN̻"DDfDffDDD"݂DD"DDẅDDDDDD3DDwU3DD"D݂DDfDDD"݂DDfff3DDD"fwDDDwU3݂DDDDw3UDDD̻݈fDDf3DݙDD"wwD""DfUU̙DDDDUwUD""DfDfDݙD""ẅDfĂ0D 3݈DDD̙DDDuǂw̻fݙ"3ݪ3Duǂ3ݏw" 3f" f3݂DuǂDDwff33D""uǂfU"݈UDf3"3D"݈uǂDD f"D3ݷ@"3wwD3"fuǂ"U ̈33ݷ߈DDDDuǵDDwD̻ ̈""݈UfUDDuǽ "fUfݻ̪"D""݈DD"DݻDwDݪw3DuǾ "݈fDw3w݈DwwݙUDf"ݙU3f3DuǾUDffDU"3f3Du3̈D̪"DDwDf"wDuUw݈3DDw3D"3 3ݻwDD "ww"3DuUDf3fwݪwD3U 3Dw"f݈33Du3"DDݻfD̻"ݦ"D3̈D"fݻDf3"fݪDf3DuUDDD""wf3̻f3DfUDDw3wfݻDfUDu3ݻU3̙UD3݈3f݈3fwDf"DU3wUٻwfݻDfUDuDDfwf3f3w3̈3N3UwfUDuDf3"3 fw"Dݻ̙wD"wUDuǥwwUDUfֈDw3"U̙wD"w݈DDuǥ"ݢ333Uwѻf "Ü̪3DuǤfwDDf3"D"DuǤDUD3݈iwDuǣ3fD "wDuǣf"fwDuǢ"3fUUDuǢwUU33"DDuǢ"Uf33wfDuǡfD33fUDuǡD̩f UDUDuǠUwD ݈w݈DuǠf3f"""DDuǟ3fD3wDuǟwffwfwݻwDuǟݪ"D"̙3wDuǝ"D""3"ݐDuǝDf3ݪDf3DDuǝf3UDww"wUw3"DD"DuǜD"UD3D3"f݈"̈"UU"3w3fwDU3UwDuǜfwUfU3D"D"fDDD"fUUfwDuǛD 3fUݻ̪3݈3fDDf"wDDuǛD"ٻ3݀"3 "D3"w"Uwf3wDDuǚDw3f3U"wU3UfUf݈f݈3ݙ̻݈ݙDuǚD"ffUD"3̈Uf"̙"wU"fUDw3Dw3\3DuǙ33UffwUw3wUUwDuǙDwDwf3U݈UDw"3f"DuǶ3f3Df33UU ""ff"f "Dwݻ̻f3D"fw3Duǻ D݈f3f333"wDDDDf ̻UDDÜUDݙuwU3 3wD"U3Uw"3DD"fU3Dz3̪f"D""uU"w\DUffUfȻ"DwD3UDw""wDD"3"wiz"Dwf̙D"DUD`N3#"DDiD̈DD0DDuw3P"3D3w݈ 3DD"3"DDݹ3"DUUUwUUݪff3 fDDD""Di3ݙ$fݙ̻3ᙪ݈ݏ3ݟf3w݈̻wfff wDw݈w3""3DUw3wDDUff3 UU̙DDݙuf͏""iݻf*33w3D"PDf"f"ffUݯݻ3UUf"DfD̈DUDDD"UUf"3UUp33DuU&DD""D[uU"Up"3U"֣Df"w 3"3f"ff"f݈UfU݈Dwf "wDDu޿iψfD3(3w`׿wDׯNǯ"`f3U[UfUw3̙Pf33̈̈3D̈iUf3 DݪD UU"Du?3wDDi߯[D"Ȉ"ÏDU"ݙ"3"D3wwDDfUUf"3w3wUf"wݪDU3 Du ݈3D "DUÙ̈D\3D3""ufwDwfUUD3̈3U݈DuUwU3fⵈw[iDw3f3̻ݙUwUDUݻw"Duǿ DNwU f{ݫfϻUwD̟UD"f݈DD"D""wݪfDuǾw"f D֣D3f3ֈD""̪3ݻ݈DuǤDw3Uww3fDDuǤ Dzw33f""f"DDw3fDuǣUNUw"f Df3"U"DDfUD"DuǣDݪpfD33D33UD3D"̻UD3U̻DuǢwffUDDfDfUD3"D3DuǢ3"w@fU"DD[w"k333fDD"DDuǡUU"333҈LjUf3"DDwf̈D"Duǡ刈ff3ffw3Df" wf"UfDuǡψ"DwUfUDD̟fff""D3uǡf DDDw@ D"UUݻ Df"3D"UUDU3uǟ"݈D Dݙ33 ̻fUD"3Dݙ3DUDuǠ33w̧ D3D" N@w3D݂Duǡwwꏏߧuw3"ݙDUwU3̂D"uǡ3ѻւD UfUD3̈D"uǡ"fU@w""`"UD"""Duǡ3DU"D 3Ȼ̈DUրẅ3Df3uǠݻݻffD3fD"uǟ3D3"fwU"wU"DDuǛ"f"D3"3̈DDuǛ wff3"3"ww33DuǛ3ઙi33fD̪fDUwݻDDuǛiUU"3wU3"U""3Df3uǜ3w3"wUUf3U̙D"uǜD"DfUDfD3̪DDD 3UD"Duǜ"DDUfwf̙f"3ݪfDf̙3 wDDuǸD3w̶3ND"3"D""f3Dw"3f"̙3ffDDuǿ33UDD0Dfݻ݈DDw݈Df3ݙ3Dww3UDuD݈ݪ"3ffUUf"wf fUf3f3Dwuw333fwDDDfUfUUfUDwufݪ"3وf3wwf" ffD3wu"wDUff3Pw"f3"D33"""wݙUDDDuwDU"DU"3̈wff"DUwݪD"̈3D3w3ݙu "wDẅfD 3ff3D["UDw3"wf̻fD݈"D""u 3wݻwD3D3ffDD݈DUU ݙ""DwfݻfD"u 3Dw333"wfwDf"P"""3D""u"DU3Uf3D3DDDfffݙDUwDݙuǦ"DݷU3fw""f̈3Df"Duǥ""D3Uw@3U̙Dww3Duǥ33D"wf"DDDuǤ"""w""3 DuǤ3 w@w3"wU""`DfգU zfU"w" "3"wwfD""uǢ 3謹DDwD"3ݪ"D"݈uǢ" ݤ괿D3U"U"D3"fuǡw DD3ψU"Dwf݈Dw"DfuǠfifDDw0p"DD3DwwDuǠ "DUDw fU3f3wDDuǟ "Ư"UD3"̂"fwDuǞw̏3Dݏ̈DfUwwDuǞwDw"D`""3D3"ffDuǞ"D"fD"3"̂Dfuǝw 3U 3"wfȈwDuǝ3fDf"i"DDDuǜ"D3UDfUDuǜwwDfDD""@fUiDuǜ3݈fDwD3UDuǛ"Dw3f"DwUzDuǛwUU"3UD"DuǛ3"UDUwp3Duǚ"UfwD̪Duǚ""UD3DDuǚ"Df"fDfݻf3DuǙDwDڈ""UfD""wDuǙDwwwPD3DuǙw݈Dw"DfDDUDuǙ""f"D D wU"3"UDuǘ"Df"wUfDuǗ ݈Dw"ffD""DuǗwwU3wDDf3̂Duǖ ""DD3"UDuǖwffwDUw3PDuǖ"U3Uwf"݂DuǕ`fUw"fDuǕ`33D"ݻDfDuǕU̻U3"w"DuǕUD"fU3̈Df3ffֈ"݂Duǔ"zUfDUfDuǔU3fUDuǔUUD3Dݙuǔ"D3ff̈33D""uǓ݈fw""3fwwDuǓ3f"3D""uǒD"D݂DݙuǒUUf"3fDuǒ"i"DU"̻3UDuǑU"wUDݙuǑDw"̂D""uǐDDU"DDuǐffݻ"UwDD""uǐf DUf"Dݙuǐ "UD"U"3D33DDҏ "љfff݈̪"D"D~ "3D"DwU3DD3kfDfUDD f w"""fwDDD ݈ߗ"fD3wDDf3D3ݙD3D""ݻDDffwf3wwDfDU3U3wDDD33DDff"""݂DDfDDUUfDD"DUD3ww"U"3ݻDD3UfUD ̪̙" D"wDDw3U3UUf"DfD"DD"̂DDf3D3UwwDDwUwfw3DUU"UDDD3DfDDD""zfݙDDDwww3wDDwUD3DD "D"UwwUDDπ w"ww"wDD w"fwwfw3DDN3U"DD3"UDDߛ"fDU3fDDw3 ψ3""3w3"DD̪D3 "̻ffݻ̻""݂DD3Dw3 @DD3fDD"3wwUDDDD3DDDDf3UDDUf"wDDDDU"@݂DDUwwDDDDDfDfDDU3DDDw̻D3݂DD33DwDDUDDUDD3fDDDDUݿ3DDDDDDDDDDDDDD f3 333" D wU3DD"""f33DD333"" D33̂w3U"3w"""fD33f"33""33݂  D 3 UU3D"U 3  D݂ "3 endstream endobj 16 0 obj 18098 endobj 17 0 obj << /Title (motovate_bgp.pdf) /CreationDate (D:20110401184102) /ModDate (D:20110401184102) /Producer (ImageMagick 6.5.8-4 2009-12-15 Q16 http://www.imagemagick.org) >> endobj xref 0 18 0000000000 65535 f 0000000010 00000 n 0000000059 00000 n 0000000118 00000 n 0000000300 00000 n 0000000383 00000 n 0000000401 00000 n 0000000439 00000 n 0000000460 00000 n 0000023970 00000 n 0000023991 00000 n 0000024018 00000 n 0000026945 00000 n 0000026966 00000 n 0000026982 00000 n 0000027003 00000 n 0000045294 00000 n 0000045316 00000 n trailer << /Size 18 /Info 17 0 R /Root 1 0 R >> startxref 45499 %%EOF tgp/vignettes/tree.pdf0000644000176200001440000026704213531032535014521 0ustar liggesusers%PDF-1.3 % 4 0 obj << /Length 5 0 R /Filter /FlateDecode >> stream xɒ$qd=&tr$%j!f bAb Lg}GGdUdNgv6.1%3=5<~ۮ|kNGM{؝}}vӮݟmMqnێ}헟اzw4w{n#>ߵKwߵ}tǟorf3uv{qMOjgn:/̳slݹ{qٓ #NB38s7C>~a{]N؝^7yoqoçۻ_>f?X77TH]^7~w tRk"X@i7nq}f=".Hn8-P]sc;$fn{'̙c$88d.HdTD%nNj:.f}Ӯ?;ň32|ޝ@0/AR Y$ Xx. e=\.)}RC[B v2VG@=GZV~ў0> X!*CJY sy9O"o5pڊ2ֲ`o!#o5 ]̻pcŕ  |?M˿\|c }p FR0JEZv9=$q,#O%ӲqYVɾpV}`Ҟ.fc:bEǎD#cE~Ģ%b3+~_F:l*]B eujgg#Y5)bԉ`T\jo4;)[Y/BŴnu^q{q)h#AЃ:wk~Yg'-ʗf. WYeaiٸjnbd##lv~۝^Qr:ǁgt̅ 0DsˠCu)  C;Ly?:aP~6# RΊ -,E؟Rg6Y;aC H}Nܒ8: wYw+ܢ-`Q=Z=)N&*$t{͓(D@]"$rJ#D ۸͔f-iL0'a)24z(,M" a0{7ZKN 'j*dKSZKN{lQi>M1x }bɸ.YH[ fswm֚NsbՐ夿fci>d]C-r^92nmJ랱~Ÿ{bOC盻|ug|wh|3)=̋^maPq99Zڎʔ lm -Kafag6pv񶃣_gB{8'0q\;%f1_"|wO5Q DX<<@ d6H4.͵ʯ`p0<F:$X[ɲ&#3ƌ5RN*ߧmOmR)lt `g]u48hr^&(AO>)Sj]Qљ^}jCR$]{qeÁڷ m4]'_+v/h0£ocnx) q p7J d$z<*p%5S8vxB0 K}`f(Z%nx?G:ˑZ֞3A8P5` .DQw M !ӘV43Ѥ6h@eQ`' tF׵1eeȰce10Esś&1E۰eކ^ EHidO ,㩨q)wfF -5Rb9O.j<|#:FP*cRg[SAK$4FDOeĎ=j5aO\qSӆpsW~6V̌;s 3ab(eV92q.FǔyfPV:A.g9[e=b~ (Z EHrvhlž* h_t"a=͉i zƂ#Ԕ^ e5*  %b o0 54ToVW?z2d"gQ&b,Ld*2D-·%ekImˡ4%2h9qHP̭e(Y7j@a$) juz@. {k~eR{/Z2yj]&(|*f󛒃 h]>y-n ` HPX%}Y;z8bdτe-\(bIvɖ8XJ<'_ާA$}pVɄȥ9mA5p@22RUĉh'j:8id9p2hP4 i6}VW``O =5Anb׵.eFD29 Y+i\)kqz7\+ck8RjD[.S(` ,%9xb m1#|)ѐ, & ,S߉o|FVOg$Zv֫ 4rsG  ֲ)t3)y,Z`]OGZ6FFW->%2RDja).jZoi&ڛ?c_/`jPZ(-;kSfj-8 Dr>;и8{]uȫgwnFJ r`)y+l#sIG"zuܑR&s|*KMvly1wfe%}gt;_/+Ñؓ o* O 9~ɑ>ۻ3_>xg0;H_we̷R^tD\q>Ǖܵmi&B^dLL괈>9/UXE*Uv "2 }jbqvo_m )5J\D٪`O7t>l,&f2{6R@Ϙߒ2[8 ae& I} !B-pM>(uPSHͶ jɉUe9f|ND_Ula"?**^bq@^2^[ Q&}zQJ+BGۆtGr_MCmcWwǓІjsu*+p/懣5C=&%+&)z-JhEID -J|]/33O"HuMr"IR5MXe',5nfO|::@?^lZz A9)l7z PK[ڧm4-mMŶ"r](;J-fkvGg;Y;dVma|7zFR sy˫lr{6 sC,&Hؼ+Sg`Y"9kTHp$Q$[~*eœti2#D64"{'1Rr8.m/$ߖ$*淥qxE>2yʖsTu_ȩ""f2d͔o?" X_b>r`b~rP{*LCyj'5.)(ҧ6鰹4Y^K+fѾIyG+6Fu$.8T=x1T-TI]%̸&6L0ws 90Ț>+aɴ n9]|`21R\B;/ 6_ {NofƶJq7/)\tp{Oc4j)jO_-?f)?d:YÜӹP[N>k۸T&U% H)U)TGҕ8z*m` IA4*]JĀ6)wc("5 2-ԣ8]4"Beջ)wh?B =@@RuTs:U*mkj=y#)L_'hY@9p@acyI[bS:k?굸knMc|]tWUJK;@\s&g0Rb38B!gF⣉$~p۲5F۴Ó" eTH=1ЭaTlK,kpA [3Z׊guX.Pw!7k)Cyms˷+oFW Һxrbk>`|>Tp:zLv'0]~?54K3EYm6y2o( K3c ȀRhYN%l2vOIHnI R IqTA.6An ubзr1ƽ /s1]!zw ]eUZ{_^Y+ζб'߹{Emjk{h9J0$MHf)HFzH/f;BT'`Fҗ TAD0,R=j3/m,#P_)u2g)kBO+iĘjw jV=oݶbXh:`L0 bIqa?.Co;~j+({qJJbA@ů(vLBk<4Qے$QBy 8t&;Ury/fTN*-SpdNHG†.R2[ou?+bbIihJp"!`pyJd6IF~eH^j:0 Ud4SKZPK#øF2Det#a5-ϱB;.8_,;4 j/Nd»T.\>#^#i3C%۬`W #l|Fnuu' X2񮜛$dPXgQPa !)?Τe=W; _1 ۫r-fo;eGDf4*|Iˌ~>a!G-|%N=p&!6ڇ >͝ g~ƃlmeyj\?D5xۭ>d n ̄wWɆ]K$wSsr 4%;wjE/=kQ&4/Ct7gO A +ʞmQ[xj ܇h;/$lJs|v̒ˡ`-3H|Be8L ܯX3;_ n |٦D< қa]hOۈ#`NcEȞUM9YF4x[ Dw8) z<@6j7I|M)<OUȩYFfd> frOu35"R$ ) iH;)C3*' sDE/1xRre{,4zvl݌޵X/z~ > )<] )ttS&ojW95DIM59K>r0s $}lnwM??d7D endstream endobj 5 0 obj 9464 endobj 2 0 obj << /Type /Page /Parent 3 0 R /Resources 6 0 R /Contents 4 0 R /MediaBox [0 0 841.89 595.29] /CropBox [24.44898 120.2857 780.0816 475.551] /BleedBox [0 0 841.89 595.29] /TrimBox [0 0 841.89 595.29] /ArtBox [0 0 841.89 595.29] >> endobj 6 0 obj << /ProcSet [ /PDF /Text ] /ColorSpace << /Cs1 7 0 R >> /ExtGState << /Gs1 34 0 R >> /Font << /Tc12.0 21 0 R /Tc8.0 17 0 R /Tc3.0 11 0 R /Tc6.0 14 0 R /Tc14.1 24 0 R /Tc9.0 18 0 R /Tc11.0 20 0 R /Tc1.0 8 0 R /Tc7.1 16 0 R /Tc13.0 22 0 R /Tc17.0 27 0 R /Tc21.1 33 0 R /Tc15.0 25 0 R /Tc16.0 26 0 R /Tc4.0 12 0 R /Tc18.1 29 0 R /Tc19.0 30 0 R /Tc10.0 19 0 R /Tc2.1 10 0 R /Tc20.0 31 0 R /Tc5.0 13 0 R >> >> endobj 34 0 obj << /Type /ExtGState /OPM 1 >> endobj 35 0 obj << /Length 36 0 R /N 3 /Alternate /DeviceRGB /Filter /FlateDecode >> stream xwTSϽ7" %z ;HQIP&vDF)VdTG"cE b PQDE݌k 5ޚYg}׺PtX4X\XffGD=HƳ.d,P&s"7C$ E6<~&S2)212 "įl+ɘ&Y4Pޚ%ᣌ\%g|eTI(L0_&l2E9r9hxgIbטifSb1+MxL 0oE%YmhYh~S=zU&ϞAYl/$ZUm@O ޜl^ ' lsk.+7oʿ9V;?#I3eE妧KD d9i,UQ h A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf endstream endobj 36 0 obj 2612 endobj 7 0 obj [ /ICCBased 35 0 R ] endobj 3 0 obj << /Type /Pages /MediaBox [0 0 612 792] /Count 1 /Kids [ 2 0 R ] >> endobj 37 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 20 0 obj << /Type /Font /Subtype /Type1 /BaseFont /VQFJAY+CMTI8 /FontDescriptor 38 0 R /Encoding /MacRomanEncoding /FirstChar 101 /LastChar 116 /Widths [ 493 329 493 548 329 0 0 274 0 0 0 0 0 452 0 356 ] >> endobj 38 0 obj << /Type /FontDescriptor /FontName /VQFJAY+CMTI8 /Flags 32 /FontBBox [-57 -236 936 736] /ItalicAngle 0 /Ascent 704 /Descent -204 /CapHeight 625 /StemV 73 /XHeight 469 /StemH 33 /MaxWidth 991 /FontFile3 39 0 R >> endobj 39 0 obj << /Length 40 0 R /Subtype /Type1C /Filter /FlateDecode >> stream x tSU_ OqP":8 ({ަMB&iI|ٚ6m&MҖڔPjARE :u}1mʸ9'{;ɽ~'r]G03'0wsl3G ̼}Tr*mBp9nP)̒ ,{ ,]|8;=@.U%OyMlT)DTZؒ%r|qjdHy4KQ(e=U >5_(,nqy(pT( -X!*KԴ{Yىy-"l"@l"6bXD !UjYb xxXG3b:.18 MHp{qbc¨CxNZ= 2-'(ZnscaԆ:auF;چS'nHeytR%+⧇׀Ae,6Pr0}Mԇ8EL|8iTA2:v@6H,ez=Ȓzjؚ(ϐx!iLJ =bҙ`U՗z۫k(gwZ{5@0g4C.Z_ :h<4ݎx_A_+ 64r5j=zX#42tBĢl &uR 6[}C\%؉t sdheeP sX>;e'\NbBRuIz$I &\̸\i;Ŀn m~/@Ҫkakcѳnht@Hn@w9Aao+ ݁h"_3]TD3o9jS@oZn>_m[ T:wMRVk8mVŁ+M`Zw. V#Q[j*rR7Nސ!t9m;obAN0kcWЂK}!z`=e0Y:tzpb(u#;#jEb*5 +_*md~SYm@FnP,Ot"MA_JvBj9N{GY^)aASd53u1:ѽvX$wru&j$jO9&zxql =hcs~s uT%*yN<Hqe0uCG.3=ͯ,1j5JL dZf[g䉴P4VPrc,}v7>^tR:̀~::M6 ~ eLK-EgE˜"(=ysnM3zC;j}Ty?Sfn[Zp %uŚ:,Nfoc米塣zOU1zJ,H׍Wm!~y֚LR~4ecm}XK5Q16RY$6%}u B&kx̝x-Io'W!]nRt'E+ \zKln/'Ck&TU}WO  ډ!\>OAIUmqK>ﱤ8.Lh9 {3wuI}lk'%Maq \w@64ƴz&uU+8+ jߴQF-åM"/R{z@S%wf v"6nyXpyyhaLaE|v1d1*CFJ}#~{Ӏ~yX}5S+AB4jw7%a +(ˉ1"f]I[>V/Uo~ /q|ӇF$ 11&b@E[1LH {YsOo wӲezIAnljr2(A5WXTk{bYsatős uk8IQ68@yK+&wu8a\\iXKhԺ#X]8~}\lbon냛NNK]WqЌ]gQ.E*[(Ie`?DmgW?ws7ܤBQEDZ %(c#SH6g+f{$RVyaoÌ0_ۜVimF ?1Ԛ+:|ma-FY/!j~WƳJÀ { ֚ѽtC xLf +ieK,X4^#^8d9콄W *KEbι6F8_ E~0v_Cm:v.*!!gJ#gR(#7u᫣NAUT&l't5U8]\ռ=N9f/x hnqZ9(Y/١4[MpSUUH_K`F:^EB](^czy"a~P~p8;/c?u9&.vYǂS`5&^djxYYBR7cS\“Gn&O\%䈎&˛F endstream endobj 40 0 obj 2979 endobj 25 0 obj << /Type /Font /Subtype /Type1 /BaseFont /VOFAGL+CMR10 /FontDescriptor 41 0 R /Encoding /MacRomanEncoding /FirstChar 40 /LastChar 246 /Widths [ 388 388 0 777 277 333 277 0 500 500 500 500 0 0 0 0 500 0 0 277 0 777 0 0 0 750 708 722 0 680 652 784 0 361 0 0 625 916 750 777 680 0 736 555 722 0 0 0 0 0 0 277 0 277 0 0 0 500 555 444 555 444 305 500 555 277 0 527 277 833 555 500 555 527 391 394 388 555 527 722 527 527 444 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 277 0 0 0 0 0 0 0 0 555 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 500 ] >> endobj 41 0 obj << /Type /FontDescriptor /FontName /VOFAGL+CMR10 /Flags 32 /FontBBox [-72 -282 1041 782] /ItalicAngle 0 /Ascent 750 /Descent -250 /CapHeight 666 /StemV 69 /XHeight 500 /StemH 31 /MaxWidth 1111 /FontFile3 42 0 R >> endobj 42 0 obj << /Length 43 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xz XHfB+TP;}ߵZ+(!,$O} q ZOպ/XUOkkkk=szu2$g~^ջ%DVo:Q`? k_;,;d9zyEUꢀ]^ޡcN=n)Sf.o%%pa;fwhhɓ&L `۰]޶CP}-)jM Qsz}j$ESʁKmQj!5J-&Rۨ$j;5ZBMRSerj:AfRՔECQ)kʆD P"*X*EARDʏOSPT&5zb*Ԃ># 2՛R  pF]OY e"7~b_e1,Z&io5@3Zi,v3l;{۬sm޴9(grݵ>q_۹N 1uͰa~tDe#6⛑#bF;*cњD<6w\6H#j Ulr2# @!OnXGlqvP1tЦU7Ho 6Thjh@tOThbg/ݠ Q5+MDk!&CV`=" |KE|yf <. F3N2XF~^ݪ r]^&ʩ s6p8~w3A4<oCLnzX;V3?x—MbJ(( G]C_HMKLTz)BR$"<AM΄TT3F[<V=5JPTVa5cv2u$4(^ޡbҦfaMÉm (l NzU׎7Þ=FƲc E=oBvt< {HEi2Z8Y{VnBYɥ py8~[.yI:i^J\/?Dl~cad5"GeFUu͓-<{ĒW մ yEo~O!1#KOÉCGZJV +A,ur FǦ/}񓳩@tS:P&Ǧ%x6.I٠4RCaH{@ PUL 䉿ƛnE +Õ0(Km)5vL4ZzB߰ 5;$AL6d@pXe/j@mhO.k&, _-,pQ$n3Bҡo}ڇi)1B*13l~x6 1$A}5E,JOD4$6'k!~NM'%U|Έ АGh7h B4c5Q3!. ƓBl R5,=f|qSQY 1Ԣ\O[{ˋ/ D/YԋSMzESMMֵ^iI<S (rkk}wr kYNRȶ#:eFNRv\Hcu.z-Rqw'@^fl{<7wOƁs`KJ Cŏ;SE"f<;_s'[O@\`=Wt!6p r> bM4Aj7Lmo2}+ު'UB7TJ`J?ɿ+9lOvN#M(~F[ 3{r?]dEU"7nZRY4𠣧ݧI_Ucjbi.$gs&4?.w83v>5juf~e #>Zм6{,"yt dE4:pp=*\u^UϹ*~UUj><`2[gcHEAA:\OZ 4 )|5lB$&<5QЁ8<%ca#R7i$WZlWf UGkuQ5j?7*?_Sx(@:Y[/h6OI#٬Sc!W cI{%!=" %$dpvB6q 1i7#9yt4Iv9FGؗoY`ac1ߍA̾jTJYv'NSW :8Ma\R㾺Q4Gr"sFajRϮilBJNnotUBp/"QD%Ur~B38*|(GJhyA2[Mv6wWR@I|+JB.Fe7E6. {XT+k{g# ɹA?#a$,N$'(J{TV1\buîB@SE;x2KD<Z7 OAK 4MGNŎǃB(!gbd%:cnhL-CH*R"b! - .Е7zmMC9LoQlDF2ZƠ}p{Hb#v7#76g'1߈,QZoǴn6U5_$O#2/?VrV5$t)pBO{絑 z:I|QH,b E/YKCԴٚj5ꝂG. HDzo}o>Iwզ#ZHT}^D/Z+`nݫJ"$$$ [cޱnc a5iiuG>װD?˒o`}OתOhI;3'O* . ꃌUZHmDPReu"&␫GޚoW36O|r dz9d4hyLR8 ~ծMh7} oJrRZ.G2⧕I5IUA٤C1.vt₪A@?;U1߈)qZdAup؄g^] 5^3s!tHxQ>XvɎ]t50BёLҎvlv{l~ce&'\e-嶩J]JTȕrs55|R56է`zB2(o=OzWi<(MZZ>k}0o!on!7]]3ۋGrX*Dj(q`MO"c-&\H8cUt2 ל zv4B#k,\g20?uHMDm|d|5әGG!BCh`ձQ#cj(o/mu$2ܢ7/?KW%H%l [FZ%zL<$FIQ:34T.]hÎ̈BO;leįH& q q AܻxY-1tҺ"CyyawwҎ!"EbI%{PЗVuT2P?`υTؠN'YV@LOҢU%qq LRZJZN ԇCO.3{V`5rNd4JGo57wh7p-d?,6LHuD )~wrxڷXȉ;疰d V j#W [ n^~kwFnd)M)7O| 2& NaKP楔0ؕ ¬y鷈P 7,j.HwOŃwc $t:rgs4Ԟh\dL;=e"4N͎\N\c3 㲟74{4sQ+.,zs^UxY3}~—-I6<_Ə0N /DWX߱>A7;Y]d )F%/;%٪XC|mN;9WPzs_>eglp h)mվxC]O㦌s63˳KkF}Lt]I>*k^7]=GaO5ꋧNYc}FX<C #ˆHs-}- E\eTqRKL^Emd HVR =[Y/s*JF _Tkj}Z_Y6k>`}qe'5 ֖ ?#DqK8&@V>h=Z-DoyN.u+ '9j3Hp{~EnFZnPb-zsgd&OI+@Y!ni<x1~ [v<5%=ϑ,׊z"!7MHXjBiLeƽ [4gMN[4 (ҤutgGע:Q>Ax pݝGDމb \|se^|.xs!r- JҪ]E9ީ‚BBtA5Uz}i2Q@AD?j[V=1+P;_ɈuM_y!HUd-߮R*!f0,D?h!>Tǹ*쮈-)++9y$w pXRȟ3dt69L:J7L|GjB[Mvj*fegG\N*L5roFkQNf׋Xkd)h/n ȉ|WҧaX`?\Z,M\ƑkYP%DCDdF.}ILH`n~0 +D3T,Dh-{': !2Y}g-%ݕt(WJ#И(&%>^09 IrS$;(lىp'.t0uϒy>|:sFoj/݂ WYwXgVvY3O׳ DQ2&*\*[=a\Tm4 P5!jx-M(zt KOU0d6j vo}詊FCG]*J*ߢxD?q)ɾ| xnDS`Kl`4c-=PQᝨ+D`3s7x̤؈iQZHd$d"sW(C}~(O(:~fULvo毝[^m髏9B4g~#Gn V^jz@N 2.-7lviMcڈ~ ǻuGI@ңc;\.| I)7\^NұGȯX&)"IsTLb:r+D鐩MrO,w6Zt6#1D](8hGs h0&.~1˜öf2ָ¤Cu7='FN10 ьI4%ǟi<Ǔ1a%?§ЖMq:]".j2IѶxIx'%#Bt\;. uxYcn(MOTyC!2DIfD>n9Rt^u)ɜ}Z 00Sn##'J&EK ٽώVSё0#WW&y'ȿ&(h! )wPRa{> n\h ow79fZ?>9sW&@HsK_Ts"K\m>_K~)ՊH endstream endobj 43 0 obj 8897 endobj 18 0 obj << /Type /Font /Subtype /Type1 /BaseFont /QUCZTJ+CMR8 /FontDescriptor 44 0 R /Encoding /MacRomanEncoding /FirstChar 38 /LastChar 121 /Widths [ 826 0 413 413 0 0 295 0 295 0 0 0 0 531 0 0 0 0 0 0 295 0 0 826 0 0 0 795 0 0 0 0 693 0 0 0 0 0 0 0 0 0 0 0 0 0 767 0 0 1091 0 0 0 295 0 295 0 0 0 531 590 472 590 472 324 531 590 295 0 0 295 885 590 531 590 0 414 419 413 590 560 767 560 560 ] >> endobj 44 0 obj << /Type /FontDescriptor /FontName /QUCZTJ+CMR8 /Flags 32 /FontBBox [-68 -282 1102 782] /ItalicAngle 0 /Ascent 750 /Descent -250 /CapHeight 666 /StemV 76 /XHeight 500 /StemH 33 /MaxWidth 1168 /FontFile3 45 0 R >> endobj 45 0 obj << /Length 46 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xyXTGXP= ƜAc=XػFEA"Ha{ Q$1ceɽߞA|s%[W $=ײ+΀-F ?ٛ>rG{XQRsp72T lKv^r٣Cs.}g.ɉ]Uy-rDwٷf/[A =1i?H;8p78,=g%z~cpp` ΰ ƭkɹ>9gش[Ok02>z.Y'9҇7X({31h0e=h!PN95˂1Ƣ}%"Ө]Ak(n]<|Ԍ̷Y)i&VV6W;;D '22Og4B'dEsİ T]˩Mx&f.;ߒٗ0\CgU_N1v"`0 k#÷bUBJ1c$0EqJHHTT%A9 nԟ[6k}A5YSo&R+uO& YEjJ?\@6Rr5rA+(yV՛wߏ_%}iYRonVHISWjFuh#&E96ߗvmBg~_`d7)C`=l॥~UWCniYvW{{콀̪kR4/"Csk44]܂3LEM>yyH>pPPB#n*%FY)^7pX׈#xg$pUL=s$%gK_u\G™@eEГ:LB:5Pm7jlRСf #'1~P3bރ(UɱPYZ(ZP+._dtUg8&g,` PNBo>^'hfp\]wTOXKqsu_)=[BQ6ڼ1\Ҧx2N}BllMkClJ8(O3-EmyB*@ylJJ|&}6r!ۦn7QdmU@,DYst%~8<ۑKYv MDή);iz?}V hjW(3THH,-7z)!N^1;q2X*s@ywntwq{JXЦB芞bSҢKI.R)Lπ |嚙xn±)3,7TT6( muΜ%d))?]vhjA]};9zH8?~V6'#?zJ%0764L~~sLX*T9 HL"q|k xzN[RgZMf_yCҌ{hCR8I͊Zc*o:i"O$Rҗx,ا0 b7ӎXy5Ik[Ʒ'oK1k,VֆfkMc`hpiC='Yv4VA]7ɥAU 6E+.Fm}W.E9p+`m,T8}kj:4Uph鳳a'W|-S9Ͳխ؛QRAM|%-|,+ǍźԪ*ui5)6r~;ǥ҉N"':ZU,NYK<1!\#\FO7G׮|'~WDXuT̄.(&Ĥ-YBxW pc,yۥ޷*FYXŸ[˄0g$MW_R)/165>($ =d߀C`ƹcw*M%J3ZDJ,?,^A*oŁ.ЕA#LYTd:j雅Q3q=tV07E{){fڣ fP{;OwZ]q|XiW5]}{H& N>\_ƃ뒤PɺułMc'oZ|#K0J~vo uz!@汱'j UfIxZ.d֦4Ҝg* 77e9$ IkiJ5׽ȚL0̶i>i^9+ߥ)FgֺZ<C>;qQw^Nr\>uŦ!#\b@NaU;})xeIA6jTWF*K St*;. 䤃PNmNPXګlpǖmv/Qo q +`ȋZu.-(&. eԏPzDoDlvI6%001h#>avWwR;OgQ𠠪}AnSm W/9sHQy,sMǎ@QߡuSeA2T_[X=SJkHjqвGN8$w92>.) O>m!2~XSoPC%&:c[lpZ)/ةH,5N9j ~K ,}DC_H"AM P8>G/5,{LwLc1SO_0ѧȯ.X(Q"7.B*G=מP&ė5Oqd>,Z W}׹9 W9*-.K.M=psgo5t^E  懷iӓ꾕OXmh5EE'{/=y_8 7F>'!8->8px@.]!*-]ްn.˵UΚ!:a`b1)Tb_%:/*4Ĕ0ZM Z]Hp4bqx7gԐioO1 Qa&juyE~ $ѩ>]]9\Q չJɔHf.ŕFUx7{ ‘7f޺W(=ܖV)q ilںDZ\f$ss v |"=YW'N-9|Mr)]}w,W?[A5[QlD=mQ{7FiWU]\6=~cUph TӖ$š=Z/\aG 26ܑ/[oxA2ᵑ>CBa/W?}yokP{u ̾ub;~z'mYxMÉy!Nޞ f .oj67+#Ƃ2y^Fs)fDcDrIܔFh-VXPtv9IB jj"`d;" 2J]/_RK1}c%CPH6fHIp=6x>=ig%#Bc7 JMjH*OPYul j]/:mxesvZ꺦z 3c}\wT}%ڪ*%?]D,&HN^EN܏}E 8]V^JMi4Ɖm* D> pt/J>|JKcWl 9]B&G[6&%MM/=v\ShkeLRh;~)v2;Lj-Ҧ! %|5٣75 *4πNGf#M_PRzk8mSxIŻIo%J߈JPTSC̲_TR1CG}Nǜ򂎪 Z9]<?mG%>Õ%*øHZWPgPg PBL[$`O;E)N>]y]!P.!K̞+RgڑhCWd=ׁ!ϒ/ @Đ Tc kG1zI(9C=ȑHr%O*ՂU?~_-p%rJKp$џ^dz컌i(nIRߠ҄ #&.~au>J__.7 p_v$y6~;F/-i7?ya17iݔi{ӋK ڥ>bk I_Nd6\ֈKi[IYf Khk^z{~z^rGM\:nZa^I_ȚАm~\Mƨj-CedlgKonl (ojˁ6rqGb<(0R&+VD=yCIEvFHLLȇ,u&J77CYzA"ٹJzSpvhw[> endobj 47 0 obj << /Type /FontDescriptor /FontName /DYMHCT+CMSY8 /Flags 32 /FontBBox [-32 -282 915 803] /ItalicAngle 0 /Ascent 771 /Descent -250 /CapHeight 685 /StemV 46 /XHeight 514 /StemH 46 /MaxWidth 945 /FontFile3 48 0 R >> endobj 48 0 obj << /Length 49 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xEmL[e塞N`/yfjXl.AcF0%/1 -^ i/-Rvt@y] jTP3,KWbbcȓ<''9988./.9) Sd zI -urQAC;)p\guCLIiQTVIl-4tTUZ+=ک*QC&*@Ͳ:ٙr}KlSêJ@oM4ǗmT9Du5hVj0:N :E2etvAasWŰ\]8n|# ` ?/TerYÆFpFUȑ͐ljt8VPH=i~9718:{n{D·w5ʻ8tԝْ֋}=0.> 8D=QnFhѧ[2L S0N>YIJk\S |Rs5s,`/BpO3!6( lB"8@/ܙ9#+y B@ _D"zxL@B]0 UKz ,=`޳5ZfB ꪮ\r;!*z[5FWgq%lž~Mk l'J_=bQ߇]p,,'/]iT?Rrc=~|nOȾa~W-=<- Pۏƿa-]N &'}#NhKlXy"Ԭ:OʯGZ1{JX'-(s\+Pbj50VVZBp$da% ė J1+dD; ~[Y_~禇2 qgoW6!|=/ $˂T^i`pqRa6` +Kf$riiMǰ4U endstream endobj 49 0 obj 1054 endobj 19 0 obj << /Type /Font /Subtype /Type1 /BaseFont /LJTSIL+CMMI5 /FontDescriptor 50 0 R /Encoding /MacRomanEncoding /FirstChar 68 /LastChar 117 /Widths [ 1109 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 670 0 846 ] >> endobj 50 0 obj << /Type /FontDescriptor /FontName /LJTSIL+CMMI5 /Flags 32 /FontBBox [-32 -43 1121 715] /ItalicAngle 0 /Ascent 683 /Descent -11 /CapHeight 607 /StemV 90 /XHeight 455 /StemH 36 /MaxWidth 1151 /FontFile3 51 0 R >> endobj 51 0 obj << /Length 52 0 R /Subtype /Type1C /Filter /FlateDecode >> stream x]klSeO1TVֈ=' ! !CD L@RF:NiO/k=i׮=da0D@a~Ĩg/o7o2dem]֋/ĵ%+rp~{ˡtlQ{:,j~d&w=e`6ز|v[eZr^kԵh:F ݦk yjiiܸ kjVkFo;7UVF6iMZE{|}\z鬧35)ð{L}: cl/V*!-]|#1(PuRwLUaY#qWgypPzg'Ni qCFԄVG#ˬOLO GPUіp%]$ &酺mu$yepBOC(ԏ+淸&'F2tKd-DW=Qp3{;:Z[KƩg_wauR1j4cfChc?WI~hlQ+&5-\g W@sVS1طDb$:<~WH/i\\Dwgg. %Ksktz{3pFKSw gX_gڶlp;?!LiTCDxA3OVCC ']eha<.% lu),af" .g;xOvWJ@a8| iBkpk*O2waYrYA-6ɀ>#h(*D=Yx`(*\$" q|}Kv4@.a&{j7Sy096>@+~Om?x7"XbH/>kj*[ + (ݍk..2H];~f;j9/'ID$MjϨW/_5+/ǰt endstream endobj 52 0 obj 1276 endobj 24 0 obj << /Type /Font /Subtype /Type1 /BaseFont /VCZUZX+CMSY8 /FontDescriptor 53 0 R /Encoding << /Type /Encoding /Differences [ 33 /union /intersection /emptyset /negationslash ] >> /ToUnicode 54 0 R /FirstChar 33 /LastChar 36 /Widths [ 708 708 531 0 ] >> endobj 54 0 obj << /Length 55 0 R /Filter /FlateDecode >> stream x]j0D= gc():EAk࿯zAz3gHJ` X gux%mU&*a[@mWF$\h '} kwD:rċAO>S/[F8<*Dc!'it4&U$j~O=?c endstream endobj 55 0 obj 207 endobj 53 0 obj << /Type /FontDescriptor /FontName /VCZUZX+CMSY8 /Flags 4 /FontBBox [-32 -282 915 803] /ItalicAngle 0 /Ascent 771 /Descent -250 /CapHeight 685 /StemV 46 /XHeight 514 /StemH 46 /MaxWidth 945 /FontFile3 56 0 R >> endobj 56 0 obj << /Length 57 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xEmL[e塞N`/yfjXl.AcF0%/1 -^ i/-Rvt@y] jTP3,KWbbcȓ<''9988./.9) Sd zI -urQAC;)p\guCLIiQTVIl-4tTUZ+=ک*QC&*@Ͳ:ٙr}KlSêJ@oM4ǗmT9Du5hVj0:N :E2etvAasWŰ\]8n|# ` ?/TerYÆFpFUȑ͐ljt8VPH=i~9718:{n{D·w5ʻ8tԝْ֋}=0.> 8D=QnFhѧ[2L S0N>YIJk\S |Rs5s,`/BpO3!6( lB"8@/ܙ9#+y B@ _D"zxL@B]0 UKz ,=`޳5ZfB ꪮ\r;!*z[5FWgq%lž~Mk l'J_=bQ߇]p,,'/]iT?Rrc=~|nOȾa~W-=<- Pۏƿa-]N &'}#NhKlXy"Ԭ:OʯGZ1{JX'-(s\+Pbj50VVZBp$da% ė J1+dD; ~[Y_~禇2 qgoW6!|=/ $˂T^i`pqRa6` +Kf$riiMǰ4U endstream endobj 57 0 obj 1054 endobj 21 0 obj << /Type /Font /Subtype /Type1 /BaseFont /TJKKWN+CMBX8 /FontDescriptor 58 0 R /Encoding /MacRomanEncoding /FirstChar 88 /LastChar 90 /Widths [ 922 0 748 ] >> endobj 58 0 obj << /Type /FontDescriptor /FontName /TJKKWN+CMBX8 /Flags 32 /FontBBox [-32 -32 914 718] /ItalicAngle 0 /Ascent 686 /Descent 0 /CapHeight 609 /StemV 122 /XHeight 457 /StemH 52 /MaxWidth 944 /FontFile3 59 0 R >> endobj 59 0 obj << /Length 60 0 R /Subtype /Type1C /Filter /FlateDecode >> stream x=KSaq;9 ɕ-'ԤlYAf0fml$G14B((HEu7E]Ezњ/KS idW5h='C?l@*xƥ$ͻ=~t*ˬ֊bXiU<'KN-N%u\}.tnE*) BgŐGq)5>"^tʒ~͒6쿡Hk^ M-]e* e^=†4F =' ȳqt[P: 6B-E|;04 TR@jI!giz@&Y&Qn$ҩ(k0 j*Tc1.m7`5MY!uN%30 nEdqElͯ^wr4F&8RATV~|> endobj 61 0 obj << /Type /FontDescriptor /FontName /TNMOXN+CMMI8 /Flags 32 /FontBBox [-56 -236 878 726] /ItalicAngle 0 /Ascent 694 /Descent -204 /CapHeight 616 /StemV 78 /XHeight 462 /StemH 32 /MaxWidth 932 /FontFile3 62 0 R >> endobj 62 0 obj << /Length 63 0 R /Subtype /Type1C /Filter /FlateDecode >> stream x PSw_ '"nMXۮt]{lYZ]zJBIA~$!9$!# "Z=U{=:=;ݶ;쳳Ny3o18Xrrs_|}z~)dvBHBZJT(ta 9hmΑjUJJaHdCs gΰ -drzEGbB.$u:|tG 79z`#k"Lx&ãG"8W0P$!̧JwT~Eaq zK+]1t!҂>Or?ZL񫀣e_6>FB.o÷z=v{z33GP Ua7WGF'#٫l!e;Jhkq $oYu.Z!(WAh'-hR_eUi@k@ąMݹOwqMa| SWK{ \3}C~ цCh^Qi+da"fCW[9/8;|4v *߽Yw=M(H*I c)wegߛ<"OhF` =᎑kV^oȚ.2)c4rw9W wo` xw[UfVf| kox-!xC a:C+.vQl3dC-.c tIDB#KTM'hpB4$Qp3M.mWK+0(;;bQuE(ODٍ1<.ր_=wD:n>,Q>aQkw{ 2P&` Z&PӲFI +]ɺ[wxs&=FC''z eΕ&8o#5.ͮ8AWV޺fmV LmǠd(o'LUGs[X$BSbqj;py޾8ᡱWN4qd[\"yK|Wj(sFt݆y(_,a6wT(,[Q砜Ż6C\A?rMui*ee}axѢ?,y߹7~K֙-uD!S`lA& C2V^S32LB|d4ɛvuA|26gͽ/P|75vbGɾcݠʳdR]\'8ﳊB>kwR{uFpx>^&y.xwHw_T>~@hTTg "EǠ} ׬?&do*TjYTR_.IFrT0#FҦ];\43l8H$xO_W?<|FpT|,z}ko' ޶ށ?dVᝏ?*qs"54k 5d:D@ƛb㬞hcTQ#auWO`DߘW)eoz7gV^-:$?s-EiuOgp橒W^Zv҄=Dj=sqs}R:}nA_gYGֳQ]&|M&}4; xn=ǘc(q9(?Ea>ln͵lM&OOo(TIkQ顮p`E%C} *cC7C};h*9;6ZC=45L*4͟h)zU=x J2̗]%ɫ,E[z9&Ie OC[t];v^7rfr~S<H,3;m^uWByO1fJWL*f rD*FPmǔ ^[B<ݑ8JKð?h.D endstream endobj 63 0 obj 2418 endobj 13 0 obj << /Type /Font /Subtype /Type1 /BaseFont /CLRLCH+CMR5 /FontDescriptor 64 0 R /Encoding /MacRomanEncoding /FirstChar 49 /LastChar 116 /Widths [ 680 680 680 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 750 0 0 0 0 0 0 0 0 0 0 0 541 ] >> endobj 64 0 obj << /Type /FontDescriptor /FontName /CLRLCH+CMR5 /Flags 32 /FontBBox [-32 -54 1063 726] /ItalicAngle 0 /Ascent 694 /Descent -22 /CapHeight 616 /StemV 89 /XHeight 462 /StemH 44 /MaxWidth 1093 /FontFile3 65 0 R >> endobj 65 0 obj << /Length 66 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xLuǟ5G9E9~Ha "CE'88$D}MS$'`i+jեn+h0+LPj0Po0z>"T/k"MU|]Pj m"S Hb2V 3i*2+)JˌQ1PTKR/R:j.B=AͣQT#u^IgV0_}ߒӍ Jx0ti';߰H$΢(`'ޤ%V@c:W_l70h~t8У,*~lgp@ҋJcI5*T\Wږ­԰͹ylRAe*;8NwW댔0aylq"KHbBP:HoG6$BdJ7٘YfsrE~@Wϝ:zNTy?9 fI_f> c[ "viL`4qVuUkK=:I 2w__?h;~]pV3loC=h03kZ֒T`̷ӐU0s#[AL#=p:9㤿S.NhvqLY l1M1ľgOmIk_ Ckc#zH%+ AV>QcEٱo1Rt :Pm/hQMUVYs".@zkw^E`z_7JovH70WWZ_ۙ]{bAFßa(> endobj 67 0 obj << /Type /FontDescriptor /FontName /FBHFUC+CMBX10 /Flags 32 /FontBBox [-32 -233 1196 736] /ItalicAngle 0 /Ascent 704 /Descent -201 /CapHeight 625 /StemV 114 /XHeight 469 /StemH 47 /MaxWidth 1226 /FontFile3 68 0 R >> endobj 68 0 obj << /Length 69 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xXy\WR}_hLTYJwDhAOw#"(AhIt}K⒙̈́qtN۾ {_Kݺ|sd]?F&q+<{͚i};A!F^ig٢{9۝C4w a2YD܁IѻCb]'Lr5gΜ,,(zw__lHP_,]b\'. \0cFBBt'MuM)(&(:>(=" 02V lMzy8L.p&g#.dȃ &.ߍU$6Vmж"|7l Q^%C#=q?|0K/>i3ӛJl g )&b-~N"Sz`}vx Ͷ&И~D &=y=cPP[GW 1id#~H_фQ+;`LNMdN`qϏ4>oT9ѨhPt$D$.8>?Ü_b$nj߼8QniZ{p_drf+8oߢ]f>"cn{7)V|7+)o &x_F}!Jg@P!w_xM|tҝ^c-c-_g.QPNG= }āO\Yi醴$96Si! t)a{]pī]]]ҵzzcg5=]-jN"=ɦ%(b2Z"q.=Q06"fzǩx}\L-b];Y q*szy ċ컘x!W<=0aևq̖4Ost.V@G9PmcFcF_'U`H }Bmm}y[k=U7w TXw"NܳPPR3(3`A+zGHz(i{f4ޱSL(=(Dwp-UcV9` ZzH TE >LPYn iμW>l,u3 nT4UVq>2cD%B<)WzʀCNwkCs͙-OɞҪ ʟR&5O?|[Ƌ[nTj5aŽu|0cfST\~!-["r"qN5?'p37kź *|oq_UL[y>[ ZĊ59(Yihxk YCjV@Z{rD˥!Zz_.%{!8'"7DC469V0j3Qb2Fmnpb(0R(4ST}ڻKUOc텃sXwՇb 4] Z.ӠS&SK"jԇV]ʷ m]lqEօz? L4ˀUR9ysrWH^l qIXPc%xi],[vWBzP?ICkN&LCDS+u$/>$}RbkEܔ^g*\~W)I/Tm4Tt `Kop"*$;X3FF(|5 z@תE 1WO9%)#B[hs@VBCRSQV!]_ `|pqnW"r!zOCvSDobЁlzyӜ'!h(Z}(R-Ùd-q"a'hFyAe6 %%51/_e؏԰ƏL:lV_Xznrfi?kSD.)]][IOmZ6V,1 |.(`Wx"U! 4%*P 7W)y: =&+="KGdv_'GZD$}Hc\oY{2̯ip@˲ߔz˨؝q;CW}7f r*?s|wDxb·.POU3P9Z)B^} ٘d 7(hCA¡"p)#9X/g l;hף>a$ M#(.·Ɏ:Mi\J_d2A_T95#+}ZoXRoaҵ]14:D]Gkm1"m8|BRߵ ;8\J g$]{AƏ~")?xnG\jA էյmba\ЊpzT֞9{OsE!e~NNӶs%C'\h"d%fwn ]MW2SvƶS--j8Cx0IFy_ ,|FkiJ"'AAR6&V/om X40~DAz ~+v4yHҍΓEw7@mk4(Qw(2paɊLQx7ǟ6alc#7J{Nh17 o͎o&ΘU^}*D}Tdg!.M.=v2;E ٥J:WsEne+0!{CJΎTxX{]\t{哓jPm>@,xxQ9Su0 ߾ ;K}.Zo]dsGU{n-6Oɯ+=4&S TmR!Uai>KDyܩ>UPU|Gh.HYO֣ng.ߣ4kE&(߶ڵ8Sx"N5CJBDF-Ɵi> endobj 70 0 obj << /Type /FontDescriptor /FontName /MPDPFJ+CMMI10 /Flags 32 /FontBBox [-64 -282 1080 782] /ItalicAngle 0 /Ascent 750 /Descent -250 /CapHeight 666 /StemV 72 /XHeight 500 /StemH 31 /MaxWidth 1142 /FontFile3 71 0 R >> endobj 71 0 obj << /Length 72 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xYy|Tex -Lߋ ؈ZD" E![e$UTe}j߲V*{*!EȢNc.=|/~ng왞~%=sƏI6_(v.7=,`nttw/)[l.5|JPY%%Kx% hUiReT]!S&[. =Tii|BIq֊ KemҌbyFz⋒YıhI27I3 RS3d%SX""M-gdS3dm|o;N{^A~5o1)oZ&֥W0Zep=tD =.83Ǯ 46=#ch~=BV^ge.@:,*Je3yx%2H(ޠbdAw qa0}}"sAFJY {BnNZ¿w]agasD~[92ZUjjG\O f +tڜ{*Z0p!ꭃ}In")t<2Lf SQBY]s 8.ۢ?J aڠc4ǒ &r~ ů(4E=s͹h-`U2dfkz":9x2^/'Uw\,7sDÏl .kRzdP VAzPVҽh5D8r?'T inl6W Tosࠜ&Vk5<{_^^)~"|ri-2$g*/40#!J'B3h<~c?Vk̠lVQ=P!Ý8~o)3xS|%F:AX 046 <`YOqZn7$r]zuZZA]r.6;O7:v9e<ˬItV(tACR#v.`m1T3ۃf2aMLd@ I^ݨR:I>Y>b0X x^:D7mW /փJϐB zcw8!T5etTfZR){ 'csu,TȀHzTChŐ0 Kc@v& i+jwEjMZ]Ft i}:َzOw;6Gdsh=PAD ET_Aܽ^ duZ/ ,V~:IBIB,nHb--[78J9s+: fP ;"/):=TU ^&bfrbm*PrM;8a^u$8|IElX}'vZMiϮjfZ3Ng54PG,scD:_[k͕ L<&K-^|Zt \G8@d"of40\ڞKj m0Ţe𬑨6ӬY 2ٙeNm Di&zX7^W}C_81G*E%UN_M7 J݌xnY[;~2{7ǚ:AnPd`*Rq |}4He1ʼnG ^!$2 ߏs|}3OjOΩW C@[Ca?Y7Sʤ%%fBTQ ;KS3]hZ &rqH_J3XD~s..nj7ŘV_$4+Gvgzav(6K! Y";n+9e`n{$x!ձFIf  {u 9r8oE*vhg!l%/[rǴ] L Ի]a{ S=<D(4(!UV↥Gp1*j2lUފ'(5Ɩ>_E֦'4CcXZ Q6 w &Wgok/ 6,*zYWZУݚW.'2ĩ2[FBem%ܔ3ǯEq@f4PBX'k-&I\+%^u28n(Pf?%)@"\U:KHkNz^mK=r',86=Ϧ*˧KW\a`oԴmxKJ*;v4^!dQ yѹ -8)Or٢5RNTrN4`@#4t}~@Y$)/_N ò~MӶIC~yir͌lFE%wg+rrКI[;V@k)#I3껤-X3ּ |6nGӠY73WN9X}s  1PfKՌǏlE\jq),q(+^Ӥ.3'V>X65Յ!nG\K#wevp.cFo^:9'aN~8R\scHuU#/\? oIx<<ٷyi׸Jn+9ԇg?Co&co1?6"+miSI# JVjhHi:r^>m5R_osM|l.H0?aFjRE%zzJj N!.a0MM\GEV--Hďͻ|ɓ~c:6{#BUn(,U:R;4jh%2ɊKreϞ>x'ƴ>ԵeF#a|?4pdx(TY++,,*TT57u6u+Gdk}Ix-rܤatE`*Sd"D|)g{21}ώz.`tT Ƅqtyd"Ϣ)1vֶT,,h&?4V}a~$ ci?L447:a1X&3v,JѱFqBI#>w_箊Z7G860\Lz;^oWBfkx%QM#޲%64.v(/  qM-'ݢQ@ YQFrE"glZ Ҧ.o :ɹ㏌5 !.K>;`x g\n')֫6[@_EIFP%c9E|PA^_T0MoC q:9r[ ZUkj=Åm*Fh^΂;HǡNr#z+>Z6ѵ9ŒPQw h;kـ٬[rrb)ŠNbgwgEYAppm4z`DrkhpAE5Sd]TMl$9JfUc#I/TUuz pxhaW)сv+G$' uY`5[\N$6ro7-W[tMD|l*~I7L|LQ{pn7䈰A6v}ycAfzׂZ#/vE‘y/ȥ$S )rۃ6ڟwKuƭ|l5?b]n?4GKԤ1X8ro qwa'|۞4肭L5(]ܪܗ6Z8D.|oS(A:Sh&nvogښNhIPFJE-^Sk=[Y*?pYj e%qk fTқTD}V]-|'G;Nf*/0[d>sDh0uPlP܄7κ)$pY ,, 8_^Bn ڀux\_\ ^/㩩tPꂝ#3$lR[]V &qf5%b`/=Xd|A P~XTw5aߍGuڵq^nt?)pA2ʏE}n G:U

a*uzyvyIz벶2 8{=@…-䞒U]7TǭOR?t-Fig謁w85t**TE6\n0d⣞:LDԒ2$Q3 wfE e@[cٜ}" W* ?:D Re Dv.!(Hh V61oʃbI)Ԇ_׸jh6-tL^d&Oq]z EPW2?#l Ւ/ȗb!g>]՛oVBV6Z&4> /ToUnicode 74 0 R /FirstChar 33 /LastChar 33 /Widths [ 571 ] >> endobj 74 0 obj << /Length 75 0 R /Filter /FlateDecode >> stream x]j0D= gc():EAk࿯zAz3gHJ` X gux%mU&*a[@mWF$\h '} kwD:rċAO>S/[F8<*Dc!'it4&U$j~O=?c endstream endobj 75 0 obj 207 endobj 73 0 obj << /Type /FontDescriptor /FontName /AMMHAX+CMMI10 /Flags 4 /FontBBox [-64 -282 1080 782] /ItalicAngle 0 /Ascent 750 /Descent -250 /CapHeight 666 /StemV 72 /XHeight 500 /StemH 31 /MaxWidth 1142 /FontFile3 76 0 R >> endobj 76 0 obj << /Length 77 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xYy|Tex -Lߋ ؈ZD" E![e$UTe}j߲V*{*!EȢNc.=|/~ng왞~%=sƏI6_(v.7=,`nttw/)[l.5|JPY%%Kx% hUiReT]!S&[. =Tii|BIq֊ KemҌbyFz⋒YıhI27I3 RS3d%SX""M-gdS3dm|o;N{^A~5o1)oZ&֥W0Zep=tD =.83Ǯ 46=#ch~=BV^ge.@:,*Je3yx%2H(ޠbdAw qa0}}"sAFJY {BnNZ¿w]agasD~[92ZUjjG\O f +tڜ{*Z0p!ꭃ}In")t<2Lf SQBY]s 8.ۢ?J aڠc4ǒ &r~ ů(4E=s͹h-`U2dfkz":9x2^/'Uw\,7sDÏl .kRzdP VAzPVҽh5D8r?'T inl6W Tosࠜ&Vk5<{_^^)~"|ri-2$g*/40#!J'B3h<~c?Vk̠lVQ=P!Ý8~o)3xS|%F:AX 046 <`YOqZn7$r]zuZZA]r.6;O7:v9e<ˬItV(tACR#v.`m1T3ۃf2aMLd@ I^ݨR:I>Y>b0X x^:D7mW /փJϐB zcw8!T5etTfZR){ 'csu,TȀHzTChŐ0 Kc@v& i+jwEjMZ]Ft i}:َzOw;6Gdsh=PAD ET_Aܽ^ duZ/ ,V~:IBIB,nHb--[78J9s+: fP ;"/):=TU ^&bfrbm*PrM;8a^u$8|IElX}'vZMiϮjfZ3Ng54PG,scD:_[k͕ L<&K-^|Zt \G8@d"of40\ڞKj m0Ţe𬑨6ӬY 2ٙeNm Di&zX7^W}C_81G*E%UN_M7 J݌xnY[;~2{7ǚ:AnPd`*Rq |}4He1ʼnG ^!$2 ߏs|}3OjOΩW C@[Ca?Y7Sʤ%%fBTQ ;KS3]hZ &rqH_J3XD~s..nj7ŘV_$4+Gvgzav(6K! Y";n+9e`n{$x!ձFIf  {u 9r8oE*vhg!l%/[rǴ] L Ի]a{ S=<D(4(!UV↥Gp1*j2lUފ'(5Ɩ>_E֦'4CcXZ Q6 w &Wgok/ 6,*zYWZУݚW.'2ĩ2[FBem%ܔ3ǯEq@f4PBX'k-&I\+%^u28n(Pf?%)@"\U:KHkNz^mK=r',86=Ϧ*˧KW\a`oԴmxKJ*;v4^!dQ yѹ -8)Or٢5RNTrN4`@#4t}~@Y$)/_N ò~MӶIC~yir͌lFE%wg+rrКI[;V@k)#I3껤-X3ּ |6nGӠY73WN9X}s  1PfKՌǏlE\jq),q(+^Ӥ.3'V>X65Յ!nG\K#wevp.cFo^:9'aN~8R\scHuU#/\? oIx<<ٷyi׸Jn+9ԇg?Co&co1?6"+miSI# JVjhHi:r^>m5R_osM|l.H0?aFjRE%zzJj N!.a0MM\GEV--Hďͻ|ɓ~c:6{#BUn(,U:R;4jh%2ɊKreϞ>x'ƴ>ԵeF#a|?4pdx(TY++,,*TT57u6u+Gdk}Ix-rܤatE`*Sd"D|)g{21}ώz.`tT Ƅqtyd"Ϣ)1vֶT,,h&?4V}a~$ ci?L447:a1X&3v,JѱFqBI#>w_箊Z7G860\Lz;^oWBfkx%QM#޲%64.v(/  qM-'ݢQ@ YQFrE"glZ Ҧ.o :ɹ㏌5 !.K>;`x g\n')֫6[@_EIFP%c9E|PA^_T0MoC q:9r[ ZUkj=Åm*Fh^΂;HǡNr#z+>Z6ѵ9ŒPQw h;kـ٬[rrb)ŠNbgwgEYAppm4z`DrkhpAE5Sd]TMl$9JfUc#I/TUuz pxhaW)сv+G$' uY`5[\N$6ro7-W[tMD|l*~I7L|LQ{pn7䈰A6v}ycAfzׂZ#/vE‘y/ȥ$S )rۃ6ڟwKuƭ|l5?b]n?4GKԤ1X8ro qwa'|۞4肭L5(]ܪܗ6Z8D.|oS(A:Sh&nvogښNhIPFJE-^Sk=[Y*?pYj e%qk fTқTD}V]-|'G;Nf*/0[d>sDh0uPlP܄7κ)$pY ,, 8_^Bn ڀux\_\ ^/㩩tPꂝ#3$lR[]V &qf5%b`/=Xd|A P~XTw5aߍGuڵq^nt?)pA2ʏE}n G:U

a*uzyvyIz벶2 8{=@…-䞒U]7TǭOR?t-Fig謁w85t**TE6\n0d⣞:LDԒ2$Q3 wfE e@[cٜ}" W* ?:D Re Dv.!(Hh V61oʃbI)Ԇ_׸jh6-tL^d&Oq]z EPW2?#l Ւ/ȗb!g>]՛oVBV6Z&4> endobj 78 0 obj << /Type /FontDescriptor /FontName /QABTAG+CMR7 /Flags 32 /FontBBox [-32 -52 838 706] /ItalicAngle 0 /Ascent 674 /Descent -20 /CapHeight 599 /StemV 79 /XHeight 449 /StemH 36 /MaxWidth 868 /FontFile3 79 0 R >> endobj 79 0 obj << /Length 80 0 R /Subtype /Type1C /Filter /FlateDecode >> stream x}LwzОZ..3[&EA "l&!X,e-՛XʛbC MR`-E9 n% d2Ȉm02_z' x&=+>% K7>`  Q.8n,0%Mz]!KEDR1 CjulMm1e i: GLf/RlIbt4qQZ91G8=[Heft>G`Y*Ck@0 Ktm*0KcŰW0%V°=X8maaAX/[I!qT6^gG;xԴNhaJmځD{r^Vp\}KN9SzP */oeeP\ޢ4w? 2'y&YHyܘ^'79(0T ;]I)wywpuCol63MR#E[`UZY0{ME(oB!|S UӠl|^JKus{\^AkS-_[j%~ҋOUBhC$y7_RاрFVd~"2iX~sMyf={,lϮ@,$C-S`)@B/ۍ ?Tgi| u)/(+~%v֣]FaPnB&OCۍ;6ږi?uܘLJM?N%^̫Zp4<ϋdOGO/ЊblJ ՜,8:U7C S Tm,.n峱_ 8}L;y N@~=cՖTE4n:Q,oy gT-B:EBȒyRqʫͳ:K"QYN8g<¬cPY"K7U˲$mŦD܂ƅ[RQ*/Pnw˷yvy endstream endobj 80 0 obj 1073 endobj 31 0 obj << /Type /Font /Subtype /Type1 /BaseFont /HDZZKV+CMBX12 /FontDescriptor 81 0 R /Encoding /MacRomanEncoding /FirstChar 46 /LastChar 116 /Widths [ 312 0 0 0 562 562 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 782 0 0 0 0 0 0 0 0 0 0 0 0 546 0 0 625 513 0 562 0 312 0 0 0 0 625 562 625 0 459 0 437 ] >> endobj 81 0 obj << /Type /FontDescriptor /FontName /HDZZKV+CMBX12 /Flags 32 /FontBBox [-32 -283 1171 782] /ItalicAngle 0 /Ascent 750 /Descent -251 /CapHeight 666 /StemV 109 /XHeight 500 /StemH 43 /MaxWidth 1201 /FontFile3 82 0 R >> endobj 82 0 obj << /Length 83 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xX\TW"֧]D%EbbHޤe0"EHEFE &j$QkYw#DWd߷;a{?Wc$ kkdYw%~{R #L fFFZ,]1c nH%`Ow .f̛j5j[^ o6x[M\3BCC|4iUgz@7W+;? *7Ma78--a9}],.pyPʐPUpW=7lq|E̦M9k|Œa:fl`&0&f33qd0K-3,e3N2ƎYdV0+*f>g2ƄbLƜ a2yƘ1bbu~S{)u6sUOd e1?I+212Ybrt'nfoV=gm(/<5h ੃;C[Y +0*)}`@kT"4$u8I~m_J@J2]Pl 7K.[`"6:g1ʒB$i6&Q2.c0z JQ;Q"aicOc%e*vJB-;d~hY"9w&yW=z0Hp?H鱮%Uw(E;0ՇB+dm2GN6x싲[DStbѤ0;x~@XБ ԡ棙TF?ߝ$!Ɉ'p&{ ȉp@iI| {J@8ͻc X G -Ү9|?pjEb$ d:GvgD&Es4-NLZE=:8l1cNJ=33zFLꊅnmWǼOF1Ec[3 _nc`Z՟t8N|n>[N@͢,Lڽ,XcKi"E ֪dǩe8 ϵ|1θoLRv̅]= > g<*Vᜳ>J_xi*vTF.I{@eOkΡ-H\C_}[Mlڵ~]VCvx{Xb9i%'Xk|#Ά%d=I^4^ȫRa/}'ONU't·L2|4 KRT'ӡ))TGeMQgy)#(Ci<5:[,2HPhs9!5 -hka XVGNƱ~.q*X 쯻 ^}?ww^Yq4!BJ )J~}7E8Xܠi':MCQwq yʑ] \aLϵ JX˿-좝k~\uNOYbkıw d8ګB0bͅ}9 u sL]7^FݝH6C ]ϡt'Xui i6eYgA,4˩8O=N.'TB pWl.,Ef"RkBtRnP$oeCyYoX&)MR烥A8ԓv6,$#+R]cRVB"K2 Fb;Mm/1Od׮Uom&J?W(71ya{"É?ŕ CWN`9>UNKd/,Ch]$ (Xd4`3"ߞh&e\Z0,HϾ$V&8SR)bgaX+q -?h:Ģ}(ߤː^v b 6SZ>;0sqՅgo/YLAyYh*<ЄϏH6&IۻbQSOtաIj"%%zpUe[6s[FEKF0':oiBRtRCy" IY ZpM6 BwG}קX|ӵP RY~W Ő],RE]&ֽt%t2O6!>N 4la2:J LN!%2(?RH]7Kw ́R_VیUQEUKU\}"t'\ƎFtĊy6-ϵ)Y$H[)ACBQQw#x~=DnbnzcLUѪPlؿN sǑ!5N)'^HmJt'j1NWS5)7k!f[9s|HG|Df _^~Ui5}q¹ԇ,o(<޲ԚH'XyB*r Wa+R)9ÿF=WsS9z 5e`|%#3DT>t8z>,2Jq8OB6߆\EMQez.%+\HA%e*sHxܹ5g |G˼s[<a "`=pyp]M@ܩr5̦#.HJUf4RN-aL~\;y=xv;vy_:cճ/]BQA7ͼ3~RQ(-}d7܎ч CD8j}A HY{^mKB^$ooG١ ck=.63w8!-:L*zjP_Ix ݗخA=R`}KqبC>TeZ/BO8VF)vI=uޞnnuur=>j/L"6I|K1KXO,O 6}GgdD<-6{:Uhme[M6fL"YѰ JqPˠ5~S, F'ȵ - uU9򼼜UU-ND_zWDRE 3%KW:k},QAI} ܝdRv[ݫo {^ף{D~}8ܼk"}kB)_ʔdJdo,(i231p(p@-(jjP+JWԴ #!bSҒb ( {}웷X7 {9vQK]3h^ Wpqɝ3/bC?&H#m|YWM?|]=R C҂&9^At'o 2/tzK ̈́!u3Ď L(S!9X;&G2p@nUfd_K #=GGL78BR 2'OӅ"pB5EJzp *3 ?F8mu)b .BAӂ-եf  L[` ck >To*o'|a=/xӄDM5HZGw*%Hc)6T%G^ν:/FdBRH!ơŏ & CW\9J~5MΎmp`gᄉ*V7ŀPF5% <.1B#%.4E#THc )^!r2*Fh A.pOwp2<&BT-QV`9?tDpd)W8׆W-VU棟(5eƘ08/V"Te)"ɫťޫg}";r29r 1ɠ) W12M\bDcbZHb!#Ge#ثpĔ͙hV+F>}Rn۔r@vWhS]>c/R iBbط=\Y}+hQI3Bc)>b x&R2LY";MrP-A+]`G]w%l3HΣ%:0C/zuv^!k P6xʡ7'ٰdwwd{z.lTO42B/i:rrki~h/ʧGjF&dea'!jfgjM???Q-Xŗw"Q#> /ToUnicode 85 0 R /FirstChar 33 /LastChar 33 /Widths [ 583 ] >> endobj 85 0 obj << /Length 86 0 R /Filter /FlateDecode >> stream x]j0D= gc():EAk࿯zAz3gHJ` X gux%mU&*a[@mWF$\h '} kwD:rċAO>S/[F8<*Dc!'it4&U$j~O=?c endstream endobj 86 0 obj 207 endobj 84 0 obj << /Type /FontDescriptor /FontName /BJRKNI+CMR10 /Flags 4 /FontBBox [-72 -282 1041 782] /ItalicAngle 0 /Ascent 750 /Descent -250 /CapHeight 666 /StemV 69 /XHeight 500 /StemH 31 /MaxWidth 1111 /FontFile3 87 0 R >> endobj 87 0 obj << /Length 88 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xz XHfB+TP;}ߵZ+(!,$O} q ZOպ/XUOkkkk=szu2$g~^ջ%DVo:Q`? k_;,;d9zyEUꢀ]^ޡcN=n)Sf.o%%pa;fwhhɓ&L `۰]޶CP}-)jM Qsz}j$ESʁKmQj!5J-&Rۨ$j;5ZBMRSerj:AfRՔECQ)kʆD P"*X*EARDʏOSPT&5zb*Ԃ># 2՛R  pF]OY e"7~b_e1,Z&io5@3Zi,v3l;{۬sm޴9(grݵ>q_۹N 1uͰa~tDe#6⛑#bF;*cњD<6w\6H#j Ulr2# @!OnXGlqvP1tЦU7Ho 6Thjh@tOThbg/ݠ Q5+MDk!&CV`=" |KE|yf <. F3N2XF~^ݪ r]^&ʩ s6p8~w3A4<oCLnzX;V3?x—MbJ(( G]C_HMKLTz)BR$"<AM΄TT3F[<V=5JPTVa5cv2u$4(^ޡbҦfaMÉm (l NzU׎7Þ=FƲc E=oBvt< {HEi2Z8Y{VnBYɥ py8~[.yI:i^J\/?Dl~cad5"GeFUu͓-<{ĒW մ yEo~O!1#KOÉCGZJV +A,ur FǦ/}񓳩@tS:P&Ǧ%x6.I٠4RCaH{@ PUL 䉿ƛnE +Õ0(Km)5vL4ZzB߰ 5;$AL6d@pXe/j@mhO.k&, _-,pQ$n3Bҡo}ڇi)1B*13l~x6 1$A}5E,JOD4$6'k!~NM'%U|Έ АGh7h B4c5Q3!. ƓBl R5,=f|qSQY 1Ԣ\O[{ˋ/ D/YԋSMzESMMֵ^iI<S (rkk}wr kYNRȶ#:eFNRv\Hcu.z-Rqw'@^fl{<7wOƁs`KJ Cŏ;SE"f<;_s'[O@\`=Wt!6p r> bM4Aj7Lmo2}+ު'UB7TJ`J?ɿ+9lOvN#M(~F[ 3{r?]dEU"7nZRY4𠣧ݧI_Ucjbi.$gs&4?.w83v>5juf~e #>Zм6{,"yt dE4:pp=*\u^UϹ*~UUj><`2[gcHEAA:\OZ 4 )|5lB$&<5QЁ8<%ca#R7i$WZlWf UGkuQ5j?7*?_Sx(@:Y[/h6OI#٬Sc!W cI{%!=" %$dpvB6q 1i7#9yt4Iv9FGؗoY`ac1ߍA̾jTJYv'NSW :8Ma\R㾺Q4Gr"sFajRϮilBJNnotUBp/"QD%Ur~B38*|(GJhyA2[Mv6wWR@I|+JB.Fe7E6. {XT+k{g# ɹA?#a$,N$'(J{TV1\buîB@SE;x2KD<Z7 OAK 4MGNŎǃB(!gbd%:cnhL-CH*R"b! - .Е7zmMC9LoQlDF2ZƠ}p{Hb#v7#76g'1߈,QZoǴn6U5_$O#2/?VrV5$t)pBO{絑 z:I|QH,b E/YKCԴٚj5ꝂG. HDzo}o>Iwզ#ZHT}^D/Z+`nݫJ"$$$ [cޱnc a5iiuG>װD?˒o`}OתOhI;3'O* . ꃌUZHmDPReu"&␫GޚoW36O|r dz9d4hyLR8 ~ծMh7} oJrRZ.G2⧕I5IUA٤C1.vt₪A@?;U1߈)qZdAup؄g^] 5^3s!tHxQ>XvɎ]t50BёLҎvlv{l~ce&'\e-嶩J]JTȕrs55|R56է`zB2(o=OzWi<(MZZ>k}0o!on!7]]3ۋGrX*Dj(q`MO"c-&\H8cUt2 ל zv4B#k,\g20?uHMDm|d|5әGG!BCh`ձQ#cj(o/mu$2ܢ7/?KW%H%l [FZ%zL<$FIQ:34T.]hÎ̈BO;leįH& q q AܻxY-1tҺ"CyyawwҎ!"EbI%{PЗVuT2P?`υTؠN'YV@LOҢU%qq LRZJZN ԇCO.3{V`5rNd4JGo57wh7p-d?,6LHuD )~wrxڷXȉ;疰d V j#W [ n^~kwFnd)M)7O| 2& NaKP楔0ؕ ¬y鷈P 7,j.HwOŃwc $t:rgs4Ԟh\dL;=e"4N͎\N\c3 㲟74{4sQ+.,zs^UxY3}~—-I6<_Ə0N /DWX߱>A7;Y]d )F%/;%٪XC|mN;9WPzs_>eglp h)mվxC]O㦌s63˳KkF}Lt]I>*k^7]=GaO5ꋧNYc}FX<C #ˆHs-}- E\eTqRKL^Emd HVR =[Y/s*JF _Tkj}Z_Y6k>`}qe'5 ֖ ?#DqK8&@V>h=Z-DoyN.u+ '9j3Hp{~EnFZnPb-zsgd&OI+@Y!ni<x1~ [v<5%=ϑ,׊z"!7MHXjBiLeƽ [4gMN[4 (ҤutgGע:Q>Ax pݝGDމb \|se^|.xs!r- JҪ]E9ީ‚BBtA5Uz}i2Q@AD?j[V=1+P;_ɈuM_y!HUd-߮R*!f0,D?h!>Tǹ*쮈-)++9y$w pXRȟ3dt69L:J7L|GjB[Mvj*fegG\N*L5roFkQNf׋Xkd)h/n ȉ|WҧaX`?\Z,M\ƑkYP%DCDdF.}ILH`n~0 +D3T,Dh-{': !2Y}g-%ݕt(WJ#И(&%>^09 IrS$;(lىp'.t0uϒy>|:sFoj/݂ WYwXgVvY3O׳ DQ2&*\*[=a\Tm4 P5!jx-M(zt KOU0d6j vo}詊FCG]*J*ߢxD?q)ɾ| xnDS`Kl`4c-=PQᝨ+D`3s7x̤؈iQZHd$d"sW(C}~(O(:~fULvo毝[^m髏9B4g~#Gn V^jz@N 2.-7lviMcڈ~ ǻuGI@ңc;\.| I)7\^NұGȯX&)"IsTLb:r+D鐩MrO,w6Zt6#1D](8hGs h0&.~1˜öf2ָ¤Cu7='FN10 ьI4%ǟi<Ǔ1a%?§ЖMq:]".j2IѶxIx'%#Bt\;. uxYcn(MOTyC!2DIfD>n9Rt^u)ɜ}Z 00Sn##'J&EK ٽώVSё0#WW&y'ȿ&(h! )wPRa{> n\h ow79fZ?>9sW&@HsK_Ts"K\m>_K~)ՊH endstream endobj 88 0 obj 8897 endobj 11 0 obj << /Type /Font /Subtype /Type1 /BaseFont /ILDUPH+CMR6 /FontDescriptor 89 0 R /Encoding /MacRomanEncoding /FirstChar 49 /LastChar 93 /Widths [ 611 611 0 0 0 0 0 0 0 351 0 0 935 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 351 0 351 ] >> endobj 89 0 obj << /Type /FontDescriptor /FontName /ILDUPH+CMR6 /Flags 32 /FontBBox [-32 -282 887 782] /ItalicAngle 0 /Ascent 750 /Descent -250 /CapHeight 666 /StemV 83 /XHeight 500 /StemH 39 /MaxWidth 917 /FontFile3 90 0 R >> endobj 90 0 obj << /Length 91 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xeleu;]⦛`mHd.d#45뱭ٵ2vqa[D6enla1.!q%B&FC .d n/W21OyOE*>G49,5r8b?XUf!mC;j D,@QH1A3p5P@@U]5 ]7soV,R׭in'8RqD|+⮮$>)Z(?D#_D6.Tdij8,6?d ijnB1_i *>} +B2܆Y?˧؇2C &&FGr?~zߕxgil㥑D˓)g֬.d2+NO+> endobj 92 0 obj << /Type /FontDescriptor /FontName /KUCCWS+CMBX6 /Flags 32 /FontBBox [-32 -32 1003 718] /ItalicAngle 0 /Ascent 686 /Descent 0 /CapHeight 609 /StemV 130 /XHeight 457 /StemH 60 /MaxWidth 1033 /FontFile3 93 0 R >> endobj 93 0 obj << /Length 94 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xcd`ab`dddsu0T~H3a!+k7s7˦BcG``fd+nr/,L(QHT04Q020TpM-LNSM,HM,rr3SK*4l2JJ s4u3K2RSRSJsSN%E )Ey LQ @00adkF3CD{)S{J=cq.nþҞ<;tLmIw7ֳۭCûjwE]]ŝu]ulz>cAиqe}M=þJ|]vz@5+j~>qƟ?YDLG嬗ئn߽1۟?;%w-¶\Vjy9~;0{̙3~Mf?][|>)<<10' endstream endobj 94 0 obj 512 endobj 16 0 obj << /Type /Font /Subtype /Type1 /BaseFont /EQDKJN+CMSY6 /FontDescriptor 95 0 R /Encoding << /Type /Encoding /Differences [ 33 /greaterequal /equivalence ] >> /ToUnicode 96 0 R /FirstChar 33 /LastChar 34 /Widths [ 962 962 ] >> endobj 96 0 obj << /Length 97 0 R /Filter /FlateDecode >> stream x]j0D= gc():EAk࿯zAz3gHJ` X gux%mU&*a[@mWF$\h '} kwD:rċAO>S/[F8<*Dc!'it4&U$j~O=?c endstream endobj 97 0 obj 207 endobj 95 0 obj << /Type /FontDescriptor /FontName /EQDKJN+CMSY6 /Flags 4 /FontBBox [-32 -282 901 782] /ItalicAngle 0 /Ascent 750 /Descent -250 /CapHeight 666 /StemV 52 /XHeight 500 /StemH 52 /MaxWidth 931 /FontFile3 98 0 R >> endobj 98 0 obj << /Length 99 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xeO_Hss;lJ#C]Q 顰(leR!zsrvn쟛[i7t3;J˨fRPz-vBC|}(CPU54V2ehhQΉW,pK{0l`.d9PIן"k2hLrrK2Ź34YO8jlfX*ihS& G\#SW Q,tSRQ>W&, AeQ[ HAɗDH=_3 )6մ O)'-Wͭ.'St<ґ#:p}+ؐ?LD&32<!Ǥ:z 0~c/KGG> MjxkzJ#[,o]ٕ"*/ui0wbDJ`Ų2pIPӒ+ЎI=jpmd:F[fʿo|R a~)Iɾc| ]nZoa &­RWZ8+͠Sˏ={lg7:a|~/0ҋ_KW(4?HB'$_T^|@嵁Ͷ<. ,YCL-<^aL~$L}A<'F#^L endstream endobj 99 0 obj 684 endobj 14 0 obj << /Type /Font /Subtype /Type1 /BaseFont /QTDCDD+CMSY6 /FontDescriptor 100 0 R /Encoding /MacRomanEncoding /FirstChar 123 /LastChar 125 /Widths [ 638 0 638 ] >> endobj 100 0 obj << /Type /FontDescriptor /FontName /QTDCDD+CMSY6 /Flags 32 /FontBBox [-32 -282 901 782] /ItalicAngle 0 /Ascent 750 /Descent -250 /CapHeight 666 /StemV 52 /XHeight 500 /StemH 52 /MaxWidth 931 /FontFile3 101 0 R >> endobj 101 0 obj << /Length 102 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xeO_Hss;lJ#C]Q 顰(leR!zsrvn쟛[i7t3;J˨fRPz-vBC|}(CPU54V2ehhQΉW,pK{0l`.d9PIן"k2hLrrK2Ź34YO8jlfX*ihS& G\#SW Q,tSRQ>W&, AeQ[ HAɗDH=_3 )6մ O)'-Wͭ.'St<ґ#:p}+ؐ?LD&32<!Ǥ:z 0~c/KGG> MjxkzJ#[,o]ٕ"*/ui0wbDJ`Ų2pIPӒ+ЎI=jpmd:F[fʿo|R a~)Iɾc| ]nZoa &­RWZ8+͠Sˏ={lg7:a|~/0ҋ_KW(4?HB'$_T^|@嵁Ͷ<. ,YCL-<^aL~$L}A<'F#^L endstream endobj 102 0 obj 684 endobj 10 0 obj << /Type /Font /Subtype /Type1 /BaseFont /XMJSUQ+CMSY5 /FontDescriptor 103 0 R /Encoding << /Type /Encoding /Differences [ 33 /prime ] >> /ToUnicode 104 0 R /FirstChar 33 /LastChar 33 /Widths [ 440 ] >> endobj 104 0 obj << /Length 105 0 R /Filter /FlateDecode >> stream x]j0D= gc():EAk࿯zAz3gHJ` X gux%mU&*a[@mWF$\h '} kwD:rċAO>S/[F8<*Dc!'it4&U$j~O=?c endstream endobj 105 0 obj 207 endobj 103 0 obj << /Type /FontDescriptor /FontName /XMJSUQ+CMSY5 /Flags 4 /FontBBox [-23 -32 393 591] /ItalicAngle 0 /Ascent 559 /Descent 0 /CapHeight 496 /StemV 56 /XHeight 372 /StemH 56 /MaxWidth 414 /FontFile3 106 0 R >> endobj 106 0 obj << /Length 107 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xcd`ab`ddds 4T~H3a!ann }O=J19(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMUML:)槤e200000v1012q/dGhOϔyݳ8g/MjȩiǵKzkcϔ '/it\/b^ʽh endstream endobj 107 0 obj 295 endobj 12 0 obj << /Type /Font /Subtype /Type1 /BaseFont /LKMCOT+CMMI6 /FontDescriptor 108 0 R /Encoding /MacRomanEncoding /FirstChar 44 /LastChar 117 /Widths [ 379 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 962 0 0 0 0 0 0 0 998 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 445 511 0 0 0 0 0 0 0 0 584 0 737 ] >> endobj 108 0 obj << /Type /FontDescriptor /FontName /LKMCOT+CMMI6 /Flags 32 /FontBBox [-32 -236 976 715] /ItalicAngle 0 /Ascent 683 /Descent -204 /CapHeight 607 /StemV 85 /XHeight 455 /StemH 35 /MaxWidth 1006 /FontFile3 109 0 R >> endobj 109 0 obj << /Length 110 0 R /Subtype /Type1C /Filter /FlateDecode >> stream xMklSu{m|88G&y'ͭecw֮ZڵccA1Jq d(!A%,F?,FBv |99sH"7 I2wf%z- qefOE M,kgӗIj:Z]R(YzSfz{EŎRm*}j9jnUMRnbE}T۬]]Jܺh45;ʴbRڨby1[I-ʞJZg ]m3 VЫNz JcD5q8Hl ^$P."pb%"`_!3=aR zv[D cfqr++{6h{FGL. `@ oQVsx[PHؔߙ]a hO7.$>?g3sI|q 7u`R(-FP\9(aѵل Y^qu@C>E6yͭ$=Ϳ%T]MXԺ{k{#}p{J+8G6(P_R/z D!+kzt2e(P/ʻ?MLP#u7L` &ΜIM|-@?źN2do| )N?rio) ޘ#3z,NtvfxK|'q~G\x0Ӵkd*Ihd< DQAu"nM>]YFXgӀת*{`BW7]Eg-}.\Z@]x|` 2 sTv-YT#jne: ÝɉT2E 'ۥ{?= ȣ}?dC0 t{ȢSOV߲i,NQKx D+=(/tOs/ȅ 1k$+La3k2E|Z:0l1 .ais1NH8g|XtELax:O IlNBi1Fo{B#-Åڿmh1iԉ!.$_ĺD]5չ;₩XL\ endstream endobj 110 0 obj 1115 endobj 111 0 obj (tgp) endobj 112 0 obj (Mac OS X 10.7.2 Quartz PDFContext) endobj 113 0 obj (Robert B. Gramacy) endobj 114 0 obj (Preview) endobj 115 0 obj (D:20120127173531Z00'00') endobj 1 0 obj << /Title 111 0 R /Author 113 0 R /Producer 112 0 R /Creator 114 0 R /CreationDate 115 0 R /ModDate 115 0 R >> endobj xref 0 116 0000000000 65535 f 0000091124 00000 n 0000009580 00000 n 0000013061 00000 n 0000000022 00000 n 0000009560 00000 n 0000009823 00000 n 0000013025 00000 n 0000084188 00000 n 0000000000 00000 n 0000087989 00000 n 0000082720 00000 n 0000089150 00000 n 0000044266 00000 n 0000086782 00000 n 0000000000 00000 n 0000085214 00000 n 0000034516 00000 n 0000026665 00000 n 0000036167 00000 n 0000013194 00000 n 0000040021 00000 n 0000041169 00000 n 0000000000 00000 n 0000038057 00000 n 0000016729 00000 n 0000046069 00000 n 0000051636 00000 n 0000000000 00000 n 0000058505 00000 n 0000065608 00000 n 0000067195 00000 n 0000000000 00000 n 0000072963 00000 n 0000010243 00000 n 0000010289 00000 n 0000013004 00000 n 0000013144 00000 n 0000013408 00000 n 0000013636 00000 n 0000016708 00000 n 0000017424 00000 n 0000017654 00000 n 0000026644 00000 n 0000027070 00000 n 0000027299 00000 n 0000034495 00000 n 0000034771 00000 n 0000034999 00000 n 0000036146 00000 n 0000036439 00000 n 0000036667 00000 n 0000038036 00000 n 0000038626 00000 n 0000038323 00000 n 0000038606 00000 n 0000038853 00000 n 0000040000 00000 n 0000040195 00000 n 0000040420 00000 n 0000041149 00000 n 0000041506 00000 n 0000041734 00000 n 0000044245 00000 n 0000044576 00000 n 0000044803 00000 n 0000046048 00000 n 0000046337 00000 n 0000046569 00000 n 0000051615 00000 n 0000051922 00000 n 0000052153 00000 n 0000058484 00000 n 0000059026 00000 n 0000058723 00000 n 0000059006 00000 n 0000059256 00000 n 0000065587 00000 n 0000065783 00000 n 0000066008 00000 n 0000067174 00000 n 0000067531 00000 n 0000067763 00000 n 0000072942 00000 n 0000073480 00000 n 0000073177 00000 n 0000073460 00000 n 0000073709 00000 n 0000082699 00000 n 0000082985 00000 n 0000083212 00000 n 0000084168 00000 n 0000084362 00000 n 0000084589 00000 n 0000085194 00000 n 0000085758 00000 n 0000085455 00000 n 0000085738 00000 n 0000085985 00000 n 0000086762 00000 n 0000086959 00000 n 0000087189 00000 n 0000087968 00000 n 0000088514 00000 n 0000088208 00000 n 0000088493 00000 n 0000088739 00000 n 0000089129 00000 n 0000089478 00000 n 0000089709 00000 n 0000090919 00000 n 0000090941 00000 n 0000090964 00000 n 0000091017 00000 n 0000091054 00000 n 0000091081 00000 n trailer << /Size 116 /Root 37 0 R /Info 1 0 R /ID [ <57a2f7b827228b14bcb7e8a21cb2c914> <57a2f7b827228b14bcb7e8a21cb2c914> ] >> startxref 91250 %%EOF tgp/vignettes/tgp.Rnw0000644000176200001440000030570313724171531014352 0ustar liggesusers\documentclass{article} \usepackage{Sweave} %\SweaveOpts{eps=TRUE} %\documentclass[12pt]{article} %\usepackage{fullpage} %\usepackage{setspace} \usepackage[footnotesize]{caption} \usepackage{amsmath} \usepackage{amscd} \usepackage{epsfig} \newcommand{\bm}[1]{\mbox{\boldmath $#1$}} \newcommand{\mb}[1]{\mathbf{#1}} %\VignetteIndexEntry{a guide to the tgp package} %\VignetteKeywords{tgp} %\VignetteDepends{tgp,maptree,MASS} %\VignettePackage{tgp} \begin{document} %\doublespacing \setkeys{Gin}{width=0.85\textwidth} <>= library(tgp) options(width=65) @ \title{{\tt tgp}: an {\sf R} package for Bayesian nonstationary,\\ semiparametric nonlinear regression and design by treed Gaussian process models} \author{Robert B. Gramacy\\ Department of Statistics\\ Virginia Tech\\ rbg@vt.edu} \maketitle \begin{abstract} The {\tt tgp} package for {\sf R} \cite{cran:R} is a tool for fully Bayesian nonstationary, semiparametric nonlinear regression and design by treed Gaussian processes with jumps to the limiting linear model. Special cases also implemented include Bayesian linear models, linear CART, stationary separable and isotropic Gaussian processes. In addition to inference and posterior prediction, the package supports the (sequential) design of experiments under these models paired with several objective criteria. 1-d and 2-d plotting, with higher dimension projection and slice capabilities, and tree drawing functions (requiring {\tt maptree} and {\tt combinat} libraries), are also provided for visualization of {\tt tgp}-class output. \end{abstract} \subsection*{Intended audience} \label{sec:discaimer} This document is intended to familiarize a (potential) user of {\tt tgp} with the models and analyses available in the package. After a brief overview, the bulk of this document consists of examples on mainly synthetic and randomly generated data which illustrate the various functions and methodologies implemented by the package. This document has been authored in {\tt Sweave} (try {\tt help(Sweave)}). This means that the code quoted throughout is certified by {\tt R}, and the {\tt Stangle} command can be used to extract it. Note that this tutorial was not meant to serve as an instruction manual. For more detailed documentation of the functions contained in the package, see the package help-manuals. At an {\sf R} prompt, type {\tt help(package=tgp)}. PDF documentation is also available on the world-wide-web. \begin{center} \tt http://www.cran.r-project.org/doc/packages/tgp.pdf \end{center} The outline is as follows. Section \ref{sec:implement} introduces the functions and associated regression models implemented by the {\tt tgp} package, including plotting and visualization methods. The Bayesian mathematical specification of these models is contained in Section \ref{sec:model}. In Section \ref{sec:examples} the functions and methods implemented in the package are illustrated by example. The appendix covers miscellaneous topics such as how to link with the {\tt ATLAS} libraries for fast linear algebra routines, compile--time support for {\tt Pthreads} parallelization, the gathering of parameter traces, the verbosity of screen output, and some miscellaneous details of implementation. \subsection*{Motivation} Consider as motivation the Motorcycle Accident Dataset \cite{silv:1985}. It is a classic data set used in recent literature \cite{rasm:ghah:nips:2002} to demonstrate the success of nonstationary regression models. The data consists of measurements of the acceleration of the head of a motorcycle rider as a function of time in the first moments after an impact. Many authors have commented on the existence of two---perhaps three---regimes in the data over time where the characteristics of the mean process and noise level change (i.e., a nonstationarity and heteroskedasticity, respectively). It can be interesting to see how various candidate models handle this nuance. \begin{figure}[ht!] \centering \includegraphics[trim=0 25 0 0]{motovate_bgp} \includegraphics[trim=0 25 0 0]{motovate_btgp} \caption{Fit of the Motorcycle Accident Dataset using a GP ({\em top}) and treed GP model ({\em bottom}). The $x$-axis is time in milliseconds after an impact; the $y$--axis is acceleration of the helmet of a motorcycle rider measured in ``$g$'s'' in a simulated impact.} \label{f:motivate} \end{figure} Figure \ref{f:motivate} shows a fit of this data using a standard (stationary) Gaussian process (GP; {\em left}), and the treed GP model ({\em right}).\footnote{Note that these plots are {\em static}, i.e., they were not generated in--line with {\tt R} code. See Section \ref{sec:moto} for {\em dynamic} versions.} Notice how stationary GP model is unable to capture the smoothness in the linear section(s), nor the decreased noise level. We say that the standard GP model is stationary because it has a single fixed parameterization throughout the input space. An additive model would be inappropriate for similar reasons. In contrast, the treed GP model is able to model the first linear part, the noisy ``whiplash'' middle section, and the smooth (possibly linear) final part with higher noise level, thus exhibiting nonstationary modeling behavior and demonstrating an ability to cope with heteroskedasticity. The remainder of this paper describes the treed GP model in detail, and provides illustrations though example. There are many special cases of the treed GP model, e.g., the linear model (LM), treed LM, stationary GP, etc.. These are outlined and demonstrated as well. \section{What is implemented?} \label{sec:implement} The {\tt tgp} package contains implementations of seven Bayesian multivariate regression models and functions for visualizing posterior predictive surfaces. These models, and the functions which implement them, are outlined in Section \ref{sec:breg}. Also implemented in the package are functions which aid in the sequential design of experiments for {\tt tgp}-class models, which is what I call {\em adaptive sampling}. These functions are introduced at the end of Section \ref{sec:model} and a demonstration is given in Section \ref{sec:as}. \subsection{Bayesian regression models} \label{sec:breg} The seven regression models implemented in the package are summarized in Table \ref{t:reg}. They include combinations of treed partition models, (limiting) linear models, and Gaussian process models as indicated by T, LM/LLM, \& GP in the center column of the table. The details of model specification and inference are contained in Section \ref{sec:model}. Each is a fully Bayesian regression model, and in the table they are ordered by some notion of ``flexibility''. These {\tt b*} functions, as I call them, are wrappers around the master {\tt tgp} function which is an interface to the core {\tt C} code. \begin{table} \centering \begin{tabular}{l|l|l} {\sf R} function & Ingredients & Description \\ \hline blm & LM & Linear Model \\ btlm & T, LM & Treed Linear Model \\ bcart & T & Treed Constant Model \\ bgp & GP & GP Regression \\ bgpllm & GP, LLM & GP with jumps to the LLM \\ btgp & T, GP & treed GP Regression \\ btgpllm & T, GP, LLM & treed GP with jumps to the LLM \\ \hline tgp & & Master interface for the above methods \end{tabular} \caption{Bayesian regression models implemented by the {\tt tgp} package} \label{t:reg} \end{table} The {\tt b*} functions are intended as the main interface, so little further attention to the {\tt tgp} master function will be included here. The easiest way to see how the master {\tt tgp} function implements one of the {\tt b*} methods is to simply type the name of the function of interest into {\sf R}. For example, to see the implementation of {\tt bgp}, type: <>= bgp @ The output (return-value) of {\tt tgp} and the {\tt b*} functions is a {\tt list} object of class ``{\tt tgp}''. This is what is meant by a ``{\tt tgp}-class'' object. This object retains all of the relevant information necessary to summarize posterior predictive inference, maximum {\em a' posteriori} (MAP) trees, and statistics for adaptive sampling. Information about its actual contents is contained in the help files for the {\tt b*} functions. Generic {\tt print}, {\tt plot}, and {\tt predict} methods are defined for {\tt tgp}-class objects. The {\tt plot} and {\tt predict} functions are discussed below. The {\tt print} function simply provides a list of the names of the fields comprising a {\tt tgp}-class object. \subsubsection{Plotting and visualization} \label{sec:plot} The two main functions provided by the {\tt tgp} package for visualization are {\tt plot.tgp}, inheriting from the generic {\tt plot} method, and a function called {\tt tgp.trees} for graphical visualization of MAP trees. The {\tt plot.tgp} function can make plots in 1-d or 2-d. Of course, if the data are 1-d, the plot is in 1-d. If the data are 2-d, or higher, they are 2-d image or perspective plots unless a 1-d projection argument is supplied. Data which are 3-d, or higher, require projection down to 2-d or 1-d, or specification of a 2-d slice. The {\tt plot.tgp} default is to make a projection onto the first two input variables. Alternate projections are specified as an argument ({\tt proj}) to the function. Likewise, there is also an argument ({\tt slice}) which allows one to specify which slice of the posterior predictive data is desired. For models that use treed partitioning (those with a T in the center column of Table \ref{t:reg}), the {\tt plot.tgp} function will overlay the region boundaries of the MAP tree ($\hat{\mathcal{T}}$) found during MCMC. A few notes on 2-d plotting of {\tt tgp}-class objects: \begin{itemize} \item 2-d plotting requires interpolation of the data onto a uniform grid. This is supported by the {\tt tgp} package in two ways: (1) {\tt loess} smoothing, and (2) the {\tt akima} package, available from CRAN. The default is {\tt loess} because it is more stable and does not require installing any further packages. When {\tt akima} works it makes (in my opinion) smarter interpolations. However there are two bugs in the {\tt akima} package, one malign and the other benign, which preclude it from the default position in {\tt tgp}. The malign bug can cause a segmentation fault, and bring down the entire R session. The benign bug produces {\tt NA}'s when plotting data from a grid. For beautiful 2-d plots of gridded data I suggest exporting the {\tt tgp} predictive output to a text file and using {\tt gnuplot}'s 2-d plotting features. \item The current version of this package contains no examples---nor does this document---which demonstrate plotting of data with dimension larger than two. The example provided in Section \ref{sec:fried} uses 10-d data, however no plotting is required. {\tt tgp} methods have been used on data with input dimension as large as 15 \cite{gra:lee:2008}, and were used in a sequential design and detailed analysis of some proprietary 3-d input and 6-d output data sampled using a NASA supercomputer \cite{gra:lee:2009}. \item The {\tt plot.tgp} function has many more options than are illustrated in [Section \ref{sec:examples} of] this document. Please refer to the help files for more details. \end{itemize} The {\tt tgp.trees} function provides a diagrammatic representation of the MAP trees of each height encountered by the Markov chain during sampling. The function will not plot trees of height one, i.e., trees with no branching or partitioning. Plotting of trees requires the {\tt maptree} package, which in turn requires the {\tt combinat} package, both available from CRAN. \subsubsection{Prediction} \label{sec:predintro} Prediction, naturally, depends on fitted model parameters $\hat{\bm{\theta}}|\mbox{data}$, or Monte Carlo samples from the posterior distribution of $\bm{\theta}$ in a Bayesian analysis. Rather than saving samples from $\pi(\bm{\theta}|\mbox{data})$ for later prediction, usually requiring enormous amounts of storage, {\tt tgp} samples the posterior predictive distribution in-line, as samples of $\bm{\theta}$ become available. [Section \ref{sec:pred} and \ref{sec:llmpred} outlines the prediction equations.] A {\tt predict.tgp} function is provided should it be necessary to obtain predictions {\em after} the MCMC has finished. The {\tt b*} functions save the MAP parameterization $\hat{\bm{\theta}}$ maximizing $\pi(\bm{\theta}|\mbox{data})$. More specifically, the ``{\tt tgp}''--class object stores the MAP tree $\hat{{\mathcal T}}$ and corresponding GP (or LLM) parameters $\hat{\bm{\theta}}|\hat{\mathcal{T}}$ found while sampling from the joint posterior $\pi(\bm{\theta},\mathcal{T}|\mbox{data})$. These may be accessed and used, via {\tt predict.tgp}, to obtain posterior--predictive inference through the MAP parameterization. In this way {\tt predict.tgp} is similar to {\tt predict.lm}, for example. Samples can also be obtained from the MAP--parameterized predictive distributions via {\tt predict.tgp}, or a re--initialization of the joint sampling of the posterior and posterior predictive distribution can commence starting from the $(\hat{\bm{\theta}},\hat{\mathcal{T}})$. The output of {\tt predict.tgp} is also a {\tt tgp} class object. Appendix \ref{sec:apred} illustrates how this feature can be useful in the context of passing {\tt tgp} model fits between collaborators. There are other miscellaneous demonstrations in Section~\ref{sec:examples}. \subsubsection{Speed} \label{sec:speed} Fully Bayesian analyses with MCMC are not the super-speediest of all statistical models. Nor is inference for GP models, classical or Bayesian. When the underlying relationship between inputs and responses is non-linear, GPs represent a state of the art phenomenological model with high predictive power. The addition of axis--aligned treed partitioning provides a divide--and--conquer mechanism that can not only reduce the computational burden relative to the base GP model, but can also facilitate the efficient modeling of nonstationarity and heteroskedasticity in the data. This is in stark contrast to other recent approaches to nonstationary spatial models (e.g., via deformations \cite{dam:samp:gutt:2001,schmidt:2003}, or process convolutions \cite{higd:swal:kern:1999,fuentes:smith:2001,Paci:2003}) which can require orders of magnitude more effort relative to stationary GPs. Great care has been taken to make the implementation of Bayesian inference for GP models as efficient as possible [see Appendix \ref{sec:howimplement}]. However, inference for non-treed GPs can be computationally intense. Several features are implemented by the package which can help speed things up a bit. Direct support for {\tt ATLAS} \cite{atlas-hp} is provided for fast linear algebra. Details on linking this package with {\tt ATLAS} is contained in Appendix \ref{sec:atlas}. Parallelization of prediction and inference is supported by a producer/consumer model implemented with {\tt Pthreads}. Appendix \ref{sec:pthreads} shows how to activate this feature, as it is not turned on by default. An argument called {\tt linburn} is made available in tree class (T) {\tt b*} functions in Table \ref{t:reg}. When {\tt linburn = TRUE}, the Markov chain is initialized with a run of the Bayesian treed linear model \cite{chip:geor:mccu:2002} before burn-in in order to pre-partition the input space using linear models. Finally, thinning of the posterior predictive samples obtained by the Markov chain can also help speed things up. This is facilitated by the {\tt E}-part of the {\tt BTE} argument to {\tt b*} functions. \subsection{Sequential design of experiments} \label{sec:design} Sequential design of experiments, a.k.a. {\em adaptive sampling}, is not implemented by any {\em single} function in the {\tt tgp} package. Nevertheless, options and functions are provided in order to facilitate the automation of adaptive sampling with {\tt tgp}-class models. A detailed example is included in Section \ref{sec:as}. Arguments to {\tt b*} functions, and {\tt tgp}, which aid in adaptive sampling include {\tt Ds2x} and {\tt improv}. Both are booleans, i.e., should be set to {\tt TRUE} or {\tt FALSE} (the default for both is {\tt FALSE}). {\tt TRUE} booleans cause the {\tt tgp}-class output list to contain vectors of similar names with statistics that can be used toward adaptive sampling. When {\tt Ds2x = TRUE} then $\Delta \sigma^2(\mb{\tilde{x}})$ statistic is computed at each $\tilde{\mb{x}} \in \mbox{\tt XX}$, in accordance with the ALC (Active Learning--Cohn) algorithm \cite{cohn:1996}. Likewise, when {\tt improv = TRUE}, statistics are computed in order to asses the expected improvement (EI) for each $\tilde{\mb{x}} \in \mbox{\tt XX}$ about the global minimum \cite{jones:schonlau:welch:1998}. The ALM (Active Learning--Mackay) algorithm \cite{mackay:1992} is implemented by default in terms of difference in predictive quantiles for the inputs {\tt XX}, which can be accessed via the {\tt ZZ.q} output field. Details on the ALM, ALC, and EI algorithms are provided in Section \ref{sec:model}. Calculation of EI statistics was considered ``beta'' functionality while this document was being prepared. At that time it had not been adequately tested, and its implementation changed substantially in future versions of the package. For updates see the follow-on vignette \cite{gra:taddy:2010}, or \verb!vignette("tgp2")!. That document also discusses sensitivity analysis, handling of categorical inputs, and importance tempring. The functions included in the package which explicitly aid in the sequential design of experiments are {\tt tgp.design} and {\tt dopt.gp}. They are both intended to produce sequential $D$--optimal candidate designs {\tt XX} at which one or more of the adaptive sampling methods (ALM, ALC, EI) can gather statistics. The {\tt dopt.gp} function generates $D$--optimal candidates for a stationary GP. The {\tt tgp.design} function extracts the MAP tree from a {\tt tgp}-class object and uses {\tt dopt.gp} on each region of the MAP partition in order to get treed sequential $D$--optimal candidates. \section{Methods and Models} \label{sec:model} This section provides a quick overview of the statistical models and methods implemented by the {\tt tgp} package. Stationary Gaussian processes (GPs), GPs with jumps to the limiting linear model (LLM; a.k.a.~GP LLM), treed partitioning for nonstationary models, and sequential design of experiments (a.k.a.~{\em adaptive sampling}) concepts for these models are all briefly discussed. Appropriate references are provided for the details, including the original paper on Bayesian treed Gaussian process models \cite{gra:lee:2008}, and an application paper on adaptively designing supercomputer experiments \cite{gra:lee:2009}. As a first pass on this document, it might make sense to skip this section and go straight on to the examples in Section \ref{sec:examples}. \subsection{Stationary Gaussian processes} \label{sec:gp} Below is a hierarchical generative model for a stationary GP with linear tend for data $D=\{\mb{X}, \mb{Z}\}$ consisting of $n$ pairs of $m_X$ covariates and a single response variable $\{(x_{i1},\dots, x_{im_X}), z_i\}_{i=1}^n$. \begin{align} \mb{Z} | \bm{\beta}, \sigma^2, \mb{K} &\sim N_{n}(\mb{\mb{F}} \bm{\beta}, \sigma^2 \mb{K}) & \sigma^2 &\sim IG(\alpha_\sigma/2, q_\sigma/2) \nonumber \\ \bm{\beta} | \sigma^2, \tau^2, \mb{W}, \bm{\beta}_0 &\sim N_{m}(\bm{\beta}_0, \sigma^2 \tau^2 \mb{W}) & \tau^2 &\sim IG(\alpha_\tau/2, q_\tau/2) \label{eq:model} \\ \bm{\beta}_0 &\sim N_{m}(\bm{\mu}, \mb{B}) & \mb{W}^{-1} &\sim W((\rho \mb{V})^{-1}, \rho), \nonumber \end{align} $\mb{X}$ is a design matrix with $m_X$ columns. An intercept term is added with $\mb{F} = (\mb{1}, \mb{X})$ which has $m\equiv m_X+1$ columns, and $\mb{W}$ is a $m \times m$ matrix. $N$, $IG$, and $W$ are the (Multivariate) Normal, Inverse-Gamma, and Wishart distributions, respectively. Constants $\bm{\mu}, \mb{B},\mb{V},\rho, \alpha_\sigma, q_\sigma, \alpha_\tau, q_\tau.$ are treated as known. The GP correlation structure $\mb{K}$ is chosen either from the isotropic power family, or separable power family, with a fixed power $p_0$ (see below), but unknown (random) range and nugget parameters. Correlation functions used in the {\tt tgp} package take the form $K(\mb{x}_j, \mb{x}_k) = K^*(\mb{x}_j, \mb{x}_k) + {g} \delta_{j,k}$, where $\delta_{\cdot,\cdot}$ is the Kronecker delta function, $g$ is the {\em nugget}, and $K^*$ is a {\em true} correlation representative from a parametric family. The isotropic Mat\'{e}rn family is also implemented in the current version as ``beta'' functionality. All parameters in (\ref{eq:model}) can be sampled using Gibbs steps, except for the covariance structure and nugget parameters, and their hyperparameters, which can be sampled via Metropolis-Hastings \cite{gra:lee:2008}. \subsubsection{The nugget} \label{sec:intro:nug} The $g$ term in the correlation function $K(\cdot,\cdot)$ is referred to as the {\em nugget} in the geostatistics literature \cite{math:1963,cressie:1991} and sometimes as {\em jitter} in the Machine Learning literature \cite{neal:1997}. It must always be positive $(g>0)$, and serves two purposes. Primarily, it provides a mechanism for introducing measurement error into the stochastic process. It arises when considering a model of the form: \begin{equation} Z(\mb{X}) = m(\mb{X}, \bm{\beta}) + \varepsilon(\mb{X}) + \eta(\mb{X}), \label{eq:noisemodel} \end{equation} where $m(\cdot,\cdot)$ is underlying (usually linear) mean process, $\varepsilon(\cdot)$ is a process covariance whose underlying correlation is governed by $K^*$, and $\eta(\cdot)$ represents i.i.d.~Gaussian noise. Secondarily, though perhaps of equal practical importance, the nugget (or jitter) prevents $\mb{K}$ from becoming numerically singular. Notational convenience and conceptual congruence motivates referral to $\mb{K}$ as a correlation matrix, even though the nugget term ($g$) forces $K(\mb{x}_i,\mb{x}_i)>1$. \subsubsection{Exponential Power family} \label{sec:pow} Correlation functions in the {\em isotropic power} family are {\em stationary} which means that correlations are measured identically throughout the input domain, and {\em isotropic} in that correlations $K^*(\mb{x}_j, \mb{x}_k)$ depend only on a function of the Euclidean distance between $\mb{x}_j$ and $\mb{x}_k$: $||\mb{x}_j - \mb{x}_k||$. \begin{equation} K^*(\mb{x}_j, \mb{x}_k|d) = \exp\left\{-\frac{||\mb{x}_j - \mb{x}_k||^{p_0}}{d} \right\}, \label{eq:pow} \end{equation} where $d>0$ is referred to as the {\em width} or {\em range} parameter. The power $0>= hist(c(rgamma(100000,1,20), rgamma(100000,10,10)), breaks=50, xlim=c(0,2), freq=FALSE, ylim=c(0,3), main = "p(d) = G(1,20) + G(10,10)", xlab="d") d <- seq(0,2,length=1000) lines(d,0.2+0.7/(1+exp(-10*(d-0.5)))) abline(h=1, lty=2) legend(x=1.25, y=2.5, c("p(b) = 1", "p(b|d)"), lty=c(1,2)) @ <>= graphics.off() @ \includegraphics[trim=0 25 0 10]{tgp-gpllm} %\vspace{-0.5cm} \caption{\footnotesize Prior distribution for the boolean ($b$) superimposed on $p(d)$. There is truncation in the left--most bin, which rises to about 6.3. } \label{f:boolprior} \end{center} \end{figure} Probability mass functions which increase as a function of $d_i$, e.g., \begin{equation} p_{\gamma, \theta_1, \theta_2}(b_i=0|d_i) = \theta_1 + (\theta_2-\theta_1)/(1 + \exp\{-\gamma(d_i-0.5)\}) \label{eq:boolp} \end{equation} with $0<\gamma$ and $0\leq \theta_1 \leq \theta_2 < 1$, can encode such a preference by calling for the exclusion of dimensions $i$ with large $d_i$ when constructing $\mb{K}^*$. Thus $b_i$ determines whether the GP or the LLM is in charge of the marginal process in the $i^{\mbox{\tiny th}}$ dimension. Accordingly, $\theta_1$ and $\theta_2$ represent minimum and maximum probabilities of jumping to the LLM, while $\gamma$ governs the rate at which $p(b_i=0|d_i)$ grows to $\theta_2$ as $d_i$ increases. Figure \ref{f:boolprior} plots $p(b_i=0|d_i)$ %as in (\ref{eq:boolp}) for $(\gamma,\theta_1,\theta_2) =(10, 0.2, 0.95)$ superimposed on a convenient $p(d_i)$ which is taken to be a mixture of Gamma distributions, \begin{equation} p(d) = [G(d|\alpha=1,\beta=20) + G(d|\alpha=10,\beta=10)]/2, \label{eq:dprior} \end{equation} representing a population of GP parameterizations for wavy surfaces (small $d$) and a separate population of those which are quite smooth or approximately linear. The $\theta_2$ parameter is taken to be strictly less than one so as not to preclude a GP which models a genuinely nonlinear surface using an uncommonly large range setting. The implied prior probability of the full $m_X$-dimensional LLM is \begin{equation} p(\mbox{linear model}) = \prod_{i=1}^{m_X} p(b_i=0|d_i) = \prod_{i=1}^{m_X} \left[ \theta_1 + \frac{\theta_2-\theta_1} {1 + \exp\{-\gamma (d_i-0.5)\}}\right]. \label{e:linp} \end{equation} Notice that the resulting process is still a GP if any of the booleans $b_i$ are one. The primary computational advantage associated with the LLM is foregone unless all of the $b_i$'s are zero. However, the intermediate result offers increased numerical stability and represents a unique transitionary model lying somewhere between the GP and the LLM. It allows for the implementation of a semiparametric stochastic processes like $Z(\mb{x}) = \bm{\beta} f(\mb{x}) + \varepsilon(\tilde{\mb{x}})$ representing a piecemeal spatial extension of a simple linear model. The first part ($\bm{\beta}f(\mb{x})$) of the process is linear in some known function of the full set of covariates $\mb{x} = \{x_i\}_{i=1}^{m_X}$, and $\varepsilon(\cdot)$ is a spatial random process (e.g. a GP) which acts on a subset of the covariates $\mb{x}'$. Such models are commonplace in the statistics community~\cite{dey:1998}. Traditionally, $\mb{x}'$ is determined and fixed {\em a' priori}. The separable boolean prior (\ref{eq:boolp}) implements an adaptively semiparametric process where the subset $\mb{x}' = \{ x_i : b_i = 1, i=1,\dots,m_X \}$ is given a prior distribution, instead of being fixed. \subsubsection{Prediction and Adaptive Sampling under LLM} \label{sec:llmpred} Prediction under the limiting GP model is a simplification of (\ref{eq:pred}) when it is known that $\mb{K} = (1+g)\mb{I}$. It can be shown \cite{gra:lee:2008b} that the predicted value of $z$ at $\mb{x}$ is normally distributed with mean $\hat{z}(\mb{x}) = \mb{f}^\top(\mb{x}) \tilde{\bm{\beta}}$ and variance $\hat{\sigma}(\mb{x})^2 = \sigma^2 [1 + \mb{f}^\top(\mb{x})\mb{V}_{\tilde{\beta}} \mb{f}(\mb{x})]$, where $ \mb{V}_{\tilde{\beta}} = (\tau^{-2} + \mb{F}^\top \mb{F}(1+g))^{-1}$. This is preferred over (\ref{eq:pred}) with $\mb{K}=\mb{I}(1+g)$ because an $m \times m$ inversion is faster than an $n\times n$ one. Applying the ALC algorithm under the LLM also offers computational savings. Starting with the predictive variance given in (\ref{eq:pred}), the expected reduction in variance under the LM is \cite{gra:lee:2009} \begin{equation} \Delta \hat{\sigma}^2_\mb{y} (\mb{x}) = \frac{ \sigma^2 [\mb{f}^\top(\mb{y}) \mb{V}_{\tilde{\beta}_N} \mb{f}(\mb{x})]^2} {1+g + \mb{f}^\top(\mb{x}) \mb{V}_{\tilde{\beta}_N} \mb{f}(\mb{x})} \label{e:llmalc} \end{equation} which is similarly preferred over (\ref{e:gpalc}) with $\mb{K} = \mb{I}(1+g)$. The statistic for expected improvement (EI; about the minimum) is the same under the LLM as (\ref{eq:ego}) for the GP. Of course, it helps to use the linear predictive equations instead of the kriging ones for $\hat{z}(\mb{x})$ and $\hat{\sigma}^2(\mb{x})$. \subsection{Treed partitioning} \label{sec:treed} Nonstationary models are obtained by treed partitioning and inferring a separate model within each region of the partition. Treed partitioning is accomplished by making (recursive) binary splits on the value of a single variable so that region boundaries are parallel to coordinate axes. Partitioning is recursive, so each new partition is a sub-partition of a previous one. Since variables may be revisited, there is no loss of generality by using binary splits as multiple splits on the same variable are equivalent to a non-binary split. \begin{figure}%[ht!] \centering \includegraphics{tree} \caption{\footnotesize An example tree $\mathcal{T}$ with two splits, resulting in three regions, shown in a diagram ({\em left}) and pictorially ({\em right}). The notation $\mb{X}[:,u] < s$ represents a subsetting of the design matrix $\mb{X}$ by selecting the rows which have $u^{\mbox{\tiny th}}$ column less than $s$, i.e. columns $\{i: x_{iu} < s\}$, so that $\mb{X}_1$ has the rows $I_1$ of $\mb{X}$ where $I_1 = \{x_{iu_1} < s_1 \;\&\; x_{iu_2} < s_2\}$, etc. The responses are subsetted similarly so that $\mb{Z}_1$ contains the $I_1$ elements of $\mb{Z}$. We have that $\cup_j D_i = \{\mb{X},\mb{Z}\}$ and $D_i \cap D_j = \emptyset$ for $i\ne j$. } \label{f:tree} \end{figure} Figure \ref{f:tree} shows an example tree. In this example, region $D_1$ contains $\mb{x}$'s whose $u_1$ coordinate is less than $s_1$ and whose $u_2$ coordinate is less than $s_2$. Like $D_1$, $D_2$ has $\mb{x}$'s whose coordinate $u_1$ is less than $s_1$, but differs from $D_1$ in that the $u_2$ coordinate must be bigger than or equal to $s_2$. Finally, $D_3$ contains the rest of the $\mb{x}$'s differing from those in $D_1$ and $D_2$ because the $u_1$ coordinate of its $\mb{x}$'s is greater than or equal to $s_1$. The corresponding response values ($z$) accompany the $\mb{x}$'s of each region. These sorts of models are often referred to as Classification and Regression Trees (CART) \cite{brei:1984}. CART has become popular because of its ease of use, clear interpretation, and ability to provide a good fit in many cases. The Bayesian approach is straightforward to apply to tree models, provided that one can specify a meaningful prior for the size of the tree. The trees implemented in the {\tt tgp} package follow Chipman et al.~\cite{chip:geor:mccu:1998} who specify the prior through a tree-generating process. Starting with a null tree (all data in a single partition), the tree, ${\mathcal T}$, is probabilistically split recursively with each partition, $\eta$, being split with probability $p_{\mbox{\sc split}}(\eta, {\mathcal T}) = a (1 + q_\eta)^{-b}$ where $q_\eta$ is the depth of $\eta$ in $\mathcal{T}$ and $a$ and $b$ are parameters chosen to give an appropriate size and spread to the distribution of trees. Extending the work of Chipman et al.~\cite{chip:geor:mccu:2002}, the {\tt tgp} package implements a stationary GP with linear trend, or GP LLM, independently within each of the regions depicted by a tree $\mathcal{T}$ \cite{gra:lee:2008}. Integrating out dependence on $\mathcal{T}$ is accomplished by reversible-jump MCMC (RJ-MCMC) via tree operations {\em grow, prune, change}, and {\em swap}~\cite{chip:geor:mccu:1998}. %(2002)\nocite{chip:geor:mccu:2002}. %, however %Tree proposals can change the size of the parameter space ($\bm{\theta}$). To keep things simple, proposals for new parameters---via an increase in the number of partitions (through a {\em grow})---are drawn from their priors\footnote{Proposed {\em grows} are the {\em only} place where the priors (for $d$, $g$ and $\tau^2$ parameters; the others can be integrated out) are used for MH--style proposals. All other MH proposals are ``random--walk'' as described in Appendix \ref{sec:howimplement}.}, thus eliminating the Jacobian term usually present in RJ-MCMC. New splits are chosen uniformly from the set of marginalized input locations $\mb{X}$. The {\em swap} operation is augmented with a {\em rotate} option to improve mixing of the Markov chain \cite{gra:lee:2008}. There are many advantages to partitioning the input space into regions, and fitting separate GPs (or GP LLMs) within \index{each}each region. Partitioning allows for the modeling of non-stationary behavior, and can ameliorate some of the computational demands by fitting models to less data. Finally, fully Bayesian model averaging yields a uniquely efficient nonstationary, nonparametric, or semiparametric (in the case of the GP LLM) regression tool. The most general Bayesian treed GP LLM model can facilitate a model comparison between its special cases (LM, CART, treed LM, GP, treed GP, treed GP LLM) through the samples obtained from the posterior distribution. \subsection{(Treed) sequential D-optimal design} \label{sec:treedopt} In the statistics community, sequential data solicitation goes under the general heading of {\em design of experiments}. Depending on a choice of utility, different algorithms for obtaining optimal designs can be derived. Choose the Kullback-Leibler distance between the posterior and prior distributions as a utility leads to what are called $D$--optimal designs. For GPs with correlation matrix $\mb{K}$, this is equivalent to maximizing det$(\mb{K})$. Choosing quadratic loss leads to what are called $A-$optimal designs. An excellent review of Bayesian approaches to the design of experiments is provided by Chaloner \& Verdinelli~\cite{chaloner:1995}. Other approaches used by the statistics community include space-filling designs: e.g. max-min distance and Latin Hypercube (LH) designs \cite{sant:will:notz:2003}. The {\tt FIELDS} package \cite{fields:2004} implements space-filling designs along side kriging and thin plate spline models. A hybrid approach to designing experiments employs active learning techniques. The idea is to choose a set of candidate input configurations $\tilde{\mb{X}}$ (say, a $D-$optimal or LH design) and a rule for determining which $\tilde{\mb{x}}\in \tilde{\mb{X}}$ to add into the design next. The ALM algorithm has been shown to approximate maximum expected information designs by choosing $\tilde{\mathbf{x}}$ with the the largest predictive variance \cite{mackay:1992}. The ALC algorithm selects $\tilde{\mathbf{x}}$ minimizing the reduction in squared error averaged over the input space \cite{cohn:1996}. Seo et al.~\cite{seo00} provide a comparison between ALC and ALM using standard GPs. The EI \cite{jones:schonlau:welch:1998} algorithm can be used to find global minima. Choosing candidate configurations $\tilde{\mb{X}}$ ({\tt XX} in the {\tt tgp} package), at which to gather ALM, ALC, or EI statistics, is a significant component in the hybrid approach to experimental design. Candidates which are are well-spaced relative to themselves, and relative to already sampled configurations, are clearly preferred. Towards this end, a sequential $D$--optimal design is a good first choice, but has a number of drawbacks. $D$--optimal designs are based require a {\em known} parameterization, and are thus not well-suited to MCMC inference. They may not choose candidates in the ``interesting'' part of the input space, because sampling is high there already. They are ill-suited partition models wherein ``closeness'' may not measured homogeneously across the input space. Finally, they are computationally costly, requiring many repeated determinant calculations for (possibly) large covariance matrices. One possible solution to both computational and nonstationary modeling issues is to use treed sequential $D$--optimal design \cite{gra:lee:2009}, where separate sequential $D$--optimal designs are computed in each of the partitions depicted by the maximum {\em a posteriori} (MAP) tree $\hat{\mathcal{T}}$. The number of candidates selected from each region can be proportional to the volume of---or to the number of grid locations in---the region. MAP parameters $\hat{\bm{\theta}}_\nu|\hat{\mathcal{T}}$, or ``neutral'' or ``exploration encouraging'' ones, can be used to create the candidate design---a common practice \cite{sant:will:notz:2003}. Small range parameters, for learning about the wiggliness of the response, and a modest nugget parameter, for numerical stability, tend to work well together. Finding a local maxima is generally sufficient to get well-spaced candidates. The {\tt dopt.gp} function uses a stochastic ascent algorithm to find local maxima without calculating too many determinants. This works work well with ALM and ALC. However, it is less than ideal for EI as will be illustrated in Section \ref{sec:as}. Adaptive sampling from EI (with {\tt tgp}) is still an open area of research. \section{Examples using {\tt tgp}} \label{sec:examples} The following subsections take the reader through a series of examples based, mostly, on synthetic data. At least two different {\tt b*} models are fit for each set of data, offering comparisons and contrasts. Duplicating these examples in your own {\sf R} session is highly recommended. The {\tt Stangle} function can help extract executable {\sf R} code from this document. For example, the code for the exponential data of Section \ref{sec:exp} can be extracted with one command. \begin{verbatim} > Stangle(vignette("exp", package="tgp")$file) \end{verbatim} \noindent This will write a file called ``exp.R''. Additionally, each of the subsections that follow is available as an {\sf R} demo. Try {\tt demo(package="tgp")} for a listing of available demos. To invoke the demo for the exponential data of Section \ref{sec:exp} try {\tt demo(exp, package="tgp")}. This is equivalent to {\tt source("exp.R")} because the demos were created using {\tt Stangle} on the source files of this document. \footnote{Note that this vignette functionality is only supported in {\tt tgp} version $<2.x$. In 2.x and later the vignettes were coalesced in order to reduce clutter. The demos in 2.x, however, still correspond to their respective sections.} Each subsection (or subsection of the appendix) starts by seeding the random number generator with \verb!set.seed(0)!. This is done to make the results and analyses reproducible within this document, and in demo form. I recommend you try these examples with different seeds and see what happens. Usually the results will be similar, but sometimes (especially when the data ({\tt X, Z}) is generated randomly) they may be quite different. Other successful uses of the methods in this package include applications to the Boston housing data \cite{harrison:78, gra:lee:2008}, and designing an experiment for a reusable NASA launch vehicle \cite{glm:04,gra:lee:2009} called the Langely glide-back booster (LGBB). <>= seed <- 0; set.seed(seed) @ \subsection{1-d Linear data} \label{sec:ex:1dlinear} Consider data sampled from a linear model. \begin{equation} z_i = 1 + 2x_i + \epsilon_, \;\;\;\;\; \mbox{where} \;\;\; \epsilon_i \stackrel{\mbox{\tiny iid}}{\sim} N(0,0.25^2) \label{eq:linear:sim} \end{equation} The following {\sf R} code takes a sample $\{\mb{X}, \mb{Z}\}$ of size $N=50$ from (\ref{eq:linear:sim}). It also chooses $N'=99$ evenly spaced predictive locations $\tilde{\mb{X}} = \mbox{\tt XX}$. <<>>= # 1-d linear data input and predictive data X <- seq(0,1,length=50) # inputs XX <- seq(0,1,length=99) # predictive locations Z <- 1 + 2*X + rnorm(length(X),sd=0.25) # responses @ Using {\tt tgp} on this data with a Bayesian hierarchical linear model goes as follows: <<>>= lin.blm <- blm(X=X, XX=XX, Z=Z) @ \begin{figure}[ht!] \centering <>= plot(lin.blm, main='Linear Model,', layout='surf') abline(1,2,lty=3,col='blue') @ <>= graphics.off() @ \includegraphics[trim=0 25 0 25]{tgp-linear-blm} %\vspace{-0.5cm} \caption{Posterior predictive distribution using {\tt blm} on synthetic linear data: mean and 90\% credible interval. The actual generating lines are shown as blue-dotted.} \label{f:lin:blm} \end{figure} MCMC progress indicators are echoed every 1,000 rounds. The linear model is indicated by {\tt d=[0]}. For {\tt btlm} the MCMC progress indicators are boring, but we will see more interesting ones later. In terminal versions, e.g. {\tt Unix}, the progress indicators can give a sense of when the code will finish. GUI versions of {\tt R}---{\tt Windows} or {\tt MacOS X}---can buffer {\tt stdout}, rendering this feature essentially useless as a real--time indicator of progress. Progress indicators can be turned off by providing the argument {\tt verb=0}. Further explanation on the verbosity of screen output and interpretations is provided in Appendix \ref{sec:progress}. The generic {\tt plot} method can be used to visualize the fitted posterior predictive surface (with option {\tt layout = 'surf'}) in terms of means and credible intervals. Figure \ref{f:lin:blm} shows how to do it, and what you get. The default option {\tt layout = 'both'} shows both a predictive surface and error (or uncertainty) plot, side by side. The error plot can be obtained alone via {\tt layout = 'as'}. Examples of these layouts appear later. If, say, you were unsure about the dubious ``linearness'' of this data, you might try a GP LLM (using {\tt bgpllm}) and let a more flexible model speak as to the linearity of the process. <<>>= lin.gpllm <- bgpllm(X=X, XX=XX, Z=Z) @ \begin{figure}[ht!] \centering <>= plot(lin.gpllm, main='GP LLM,', layout='surf') abline(1,2,lty=4,col='blue') @ <>= graphics.off() @ \includegraphics[trim=0 25 0 25]{tgp-linear-gplm} %\vspace{-0.5cm} \caption{Posterior predictive distribution using {\tt bgpllm} on synthetic linear data: mean and 90\% credible interval. The actual generating lines are shown as blue-dotted.} \label{f:lin:gpllm} \end{figure} Whenever the progress indicators show {\tt d=[0]} the process is under the LLM in that round, and the GP otherwise. A plot of the resulting surface is shown in Figure \ref{f:lin:gpllm} for comparison. Since the data is linear, the resulting predictive surfaces should look strikingly similar to one another. On occasion, the GP LLM may find some ``bendyness'' in the surface. This happens rarely with samples as large as $N=50$, but is quite a bit more common for $N<20$. To see the proportion of time the Markov chain spent in the LLM requires the gathering of traces (Appendix \ref{sec:traces}). For example <<>>= lin.gpllm.tr <- bgpllm(X=X, XX=0.5, Z=Z, pred.n=FALSE, trace=TRUE, verb=0) mla <- mean(lin.gpllm.tr$trace$linarea$la) mla @ shows that the average area under the LLM is \Sexpr{signif(mla,3)}. Progress indicators are suppressed with \verb!verb=0!. Alternatively, the probability that input location {\tt xx} = \Sexpr{lin.gpllm.tr$XX[1,]} is under the LLM is given by <<>>= 1-mean(lin.gpllm.tr$trace$XX[[1]]$b1) @ This is the same value as the area under the LLM since the process is stationary (i.e., there is no treed partitioning). \subsection{1-d Synthetic Sine Data} \label{sec:sin} <>= seed <- 0; set.seed(seed) @ Consider 1-dimensional simulated data which is partly a mixture of sines and cosines, and partly linear. \begin{equation} z(x) = \left\{ \begin{array}{cl} \sin\left(\frac{\pi x}{5}\right) + \frac{1}{5}\cos\left(\frac{4\pi x}{5}\right) & x < 9.6 \\ x/10-1 & \mbox{otherwise} \end{array} \right. \label{e:sindata} \end{equation} The {\sf R} code below obtains $N=100$ evenly spaced samples from this data in the domain $[0,20]$, with noise added to keep things interesting. Some evenly spaced predictive locations {\tt XX} are also created. <<>>= X <- seq(0,20,length=100) XX <- seq(0,20,length=99) Ztrue <- (sin(pi*X/5) + 0.2*cos(4*pi*X/5)) * (X <= 9.6) lin <- X>9.6; Ztrue[lin] <- -1 + X[lin]/10 Z <- Ztrue + rnorm(length(Ztrue), sd=0.1) @ By design, the data is clearly nonstationary in its mean. Perhaps not knowing this, a good first model choice for this data might be a GP. <<>>= sin.bgp <- bgp(X=X, Z=Z, XX=XX, verb=0) @ \begin{figure}[ht!] \centering <>= plot(sin.bgp, main='GP,', layout='surf') lines(X, Ztrue, col=4, lty=2, lwd=2) @ <>= graphics.off() @ \includegraphics[trim=0 25 0 25]{tgp-sin-bgp} %\vspace{-0.25cm} \caption{Posterior predictive distribution using {\tt bgp} on synthetic sinusoidal data: mean and 90\% pointwise credible interval. The true mean is overlayed with a dashed line.} \label{f:sin:bgp} \end{figure} Figure \ref{f:sin:bgp} shows the resulting posterior predictive surface under the GP. Notice how the (stationary) GP gets the wiggliness of the sinusoidal region, but fails to capture the smoothness of the linear region. The true mean (\ref{e:sindata}) is overlayed with a dashed line. So one might consider a Bayesian treed linear model (LM) instead. <<>>= sin.btlm <- btlm(X=X, Z=Z, XX=XX) @ MCMC progress indicators show successful {\em grow} and {\em prune} operations as they happen, and region sizes $n$ every 1,000 rounds. Specifying {\tt verb=3}, or higher will show echo more successful tree operations, i.e., {\em change}, {\em swap}, and {\em rotate}. \begin{figure}[ht!] \centering <>= plot(sin.btlm, main='treed LM,', layout='surf') lines(X, Ztrue, col=4, lty=2, lwd=2) @ <>= graphics.off() @ \includegraphics[trim=0 25 0 25]{tgp-sin-btlm} %\vspace{-0.25cm} <>= tgp.trees(sin.btlm) @ <>= graphics.off() @ \vspace{-1cm} \caption{{\em Top:} Posterior predictive distribution using {\tt btlm} on synthetic sinusoidal data: mean and 90\% pointwise credible interval, and MAP partition ($\hat{\mathcal{T}}$). The true mean is overlayed with a dashed line. {\em Bottom:} MAP trees for each height encountered in the Markov chain showing $\hat{\sigma}^2$ and the number of observation $n$, at each leaf.} \label{f:sin:btlm} \end{figure} Figure \ref{f:sin:btlm} shows the resulting posterior predictive surface ({\em top}) and trees ({\em bottom}). The MAP partition ($\hat{\mathcal{T}}$) is also drawn onto the surface plot ({\em top}) in the form of vertical lines. The treed LM captures the smoothness of the linear region just fine, but comes up short in the sinusoidal region---doing the best it can with piecewise linear models. The ideal model for this data is the Bayesian treed GP because it can be both smooth and wiggly. <<>>= sin.btgp <- btgp(X=X, Z=Z, XX=XX, verb=0) @ \begin{figure}[ht!] \centering <>= plot(sin.btgp, main='treed GP,', layout='surf') lines(X, Ztrue, col=4, lty=2, lwd=2) @ <>= graphics.off() @ \includegraphics[trim=0 25 0 25]{tgp-sin-btgp} %\vspace{-1cm} \caption{Posterior predictive distribution using {\tt btgp} on synthetic sinusoidal data: mean and 90\% pointwise credible interval, and MAP partition ($\hat{\mathcal{T}}$) \label{f:sin:btgp}. The true mean is overlayed with a dashed line.} \end{figure} Figure \ref{f:sin:btgp} shows the resulting posterior predictive surface ({\em top}) and MAP $\hat{\mathcal{T}}$ with height=2. Finally, speedups can be obtained if the GP is allowed to jump to the LLM \cite{gra:lee:2008}, since half of the response surface is {\em very} smooth, or linear. This is not shown here since the results are very similar to those above, replacing {\tt btgp} with {\tt btgpllm}. Each of the models fit in this section is a special case of the treed GP LLM, so a model comparison is facilitated by fitting this more general model. The example in the next subsection offers such a comparison for 2-d data. A followup in Appendix \ref{sec:traces} shows how to use parameter traces to extract the posterior probability of linearity in regions of the input space. \subsection{Synthetic 2-d Exponential Data} \label{sec:exp} <>= seed <- 0; set.seed(seed) @ The next example involves a two-dimensional input space in $[-2,6] \times [-2,6]$. The true response is given by \begin{equation} z(\mb{x}) = x_1 \exp(-x_1^2 - x_2^2). \label{e:2dtoy} \end{equation} A small amount of Gaussian noise (with sd $=0.001$) is added. Besides its dimensionality, a key difference between this data set and the last one is that it is not defined using step functions; this smooth function does not have any artificial breaks between regions. The {\tt tgp} package provides a function for data subsampled from a grid of inputs and outputs described by (\ref{e:2dtoy}) which concentrates inputs ({\tt X}) more heavily in the first quadrant where the response is more interesting. Predictive locations ({\tt XX}) are the remaining grid locations. <<>>= exp2d.data <- exp2d.rand() X <- exp2d.data$X; Z <- exp2d.data$Z XX <- exp2d.data$XX @ The treed LM is clearly just as inappropriate for this data as it was for the sinusoidal data in the previous section. However, a stationary GP fits this data just fine. After all, the process is quite well behaved. In two dimensions one has a choice between the isotropic and separable correlation functions. Separable is the default in the {\tt tgp} package. For illustrative purposes here, I shall use the isotropic power family. <>= exp.bgp <- bgp(X=X, Z=Z, XX=XX, corr="exp", verb=0) @ \begin{figure}[ht!] \centering <>= plot(exp.bgp, main='GP,') @ <>= graphics.off() @ \includegraphics[trim=0 25 0 25]{tgp-exp-bgp} %\vspace{-0.5cm} \caption{{\em Left:} posterior predictive mean using {\tt bgp} on synthetic exponential data; {\em right} image plot of posterior predictive variance with data locations {\tt X} (dots) and predictive locations {\tt XX} (circles).} \label{f:exp:bgp} \end{figure} Progress indicators are suppressed. Figure \ref{f:exp:bgp} shows the resulting posterior predictive surface under the GP in terms of means ({\em left}) and variances ({\em right}) in the default layout. The sampled locations ({\tt X}) are shown as dots on the {\em right} image plot. Predictive locations ({\tt XX}) are circles. Predictive uncertainty for the stationary GP model is highest where sampling is lowest, despite that the process is very uninteresting there. A treed GP seems more appropriate for this data. It can separate out the large uninteresting part of the input space from the interesting part. The result is speedier inference and region-specific estimates of predictive uncertainty. <>= exp.btgp <- btgp(X=X, Z=Z, XX=XX, corr="exp", verb=0) @ \begin{figure}[ht!] \centering <>= plot(exp.btgp, main='treed GP,') @ <>= graphics.off() @ \includegraphics[trim=0 25 0 25]{tgp-exp-btgp} %\vspace{-0.25cm} <>= tgp.trees(exp.btgp) @ <>= graphics.off() @ \includegraphics[trim=50 65 50 10]{tgp-exp-btgptrees} \vspace{-0.5cm} \caption{{\em Top-Left:} posterior predictive mean using {\tt btgp} on synthetic exponential data; {\em top-right} image plot of posterior predictive variance with data locations {\tt X} (dots) and predictive locations {\tt XX} (circles). {\tt Bottom:} MAP trees of each height encountered in the Markov chain with $\hat{\sigma}^2$ and the number of observations $n$ at the leaves.} \label{f:exp:btgp} \end{figure} Figure \ref{f:exp:btgp} shows the resulting posterior predictive surface ({\em top}) and trees ({\em bottom}). Typical runs of the treed GP on this data find two, and if lucky three, partitions. As might be expected, jumping to the LLM for the uninteresting, zero-response, part of the input space can yield even further speedups \cite{gra:lee:2008}. Also, Chipman et al.~recommend restarting the Markov chain a few times in order to better explore the marginal posterior for $\mathcal{T}$ \cite{chip:geor:mccu:2002}. This can be important for higher dimensional inputs requiring deeper trees. The {\tt tgp} default is {\tt R = 1}, i.e., one chain with no restarts. Here two chains---one restart---are obtained using {\tt R = 2}. <<>>= exp.btgpllm <- btgpllm(X=X, Z=Z, XX=XX, corr="exp", R=2) @ \begin{figure}[ht!] \centering <>= plot(exp.btgpllm, main='treed GP LLM,') @ <>= graphics.off() @ \includegraphics[trim=0 25 0 25]{tgp-exp-btgpllm} %\vspace{-0.5cm} \caption{{\em Left:} posterior predictive mean using {\tt btgpllm} on synthetic exponential data; {\em right} image plot of posterior predictive variance with data locations {\tt X} (dots) and predictive locations {\tt XX} (circles).} \label{f:exp:btgpllm} \end{figure} Progress indicators show where the LLM ({\tt corr=0($d$)}) or the GP is active. Figure \ref{f:exp:btgpllm} shows how similar the resulting posterior predictive surfaces are compared to the treed GP (without LLM). Appendix \ref{sec:traces} shows how parameter traces can be used to calculate the posterior probabilities of regional and location--specific linearity in this example. \begin{figure}[ht!] \centering <>= plot(exp.btgpllm, main='treed GP LLM,', proj=c(1)) @ <>= graphics.off() @ \vspace{-0.65cm} <>= plot(exp.btgpllm, main='treed GP LLM,', proj=c(2)) @ <>= graphics.off() @ \includegraphics[trim=0 10 0 25]{tgp-exp-1dbtgpllm1} \includegraphics[trim=0 25 0 10]{tgp-exp-1dbtgpllm2} %\vspace{-0.5cm} \caption{1-d projections of the posterior predictive surface ({\em left}) and normed predictive intervals ({\em right}) of the 1-d tree GP LLM analysis of the synthetic exponential data. The {\em top} plots show projection onto the first input, and the {\em bottom} ones show the second.} \label{f:exp:1dbtgpllm} \end{figure} Finally, viewing 1-d projections of {\tt tgp}-class output is possible by supplying a scalar {\tt proj} argument to the {\tt plot.tgp}. Figure \ref{f:exp:1dbtgpllm} shows the two projections for {\tt exp.btgpllm}. In the {\em left} surface plots the open circles indicate the mean of posterior predictive distribution. Red lines show the 90\% intervals, the norm of which are shown on the {\em right}. \subsection{Motorcycle Accident Data} \label{sec:moto} <>= seed <- 0; set.seed(seed) @ %\iffalse The Motorcycle Accident Dataset \cite{silv:1985} is a classic nonstationary data set used in recent literature \cite{rasm:ghah:nips:2002} to demonstrate the success of nonstationary models. The data consists of measurements of the acceleration of the head of a motorcycle rider as a function of time in the first moments after an impact. In addition to being nonstationary, the data has input--dependent noise (heteroskedasticity) which makes it useful for illustrating how the treed GP model handles this nuance. There are at least two---perhaps three---three regions where the response exhibits different behavior both in terms of the correlation structure and noise level. The data is %\else %In this section we return to the motivating Motorcycle Accident %Dataset~\cite{silv:1985}, which is %\fi included as part of the {\tt MASS} library in {\sf R}. <<>>= library(MASS) X <- data.frame(times=mcycle[,1]) Z <- data.frame(accel=mcycle[,2]) @ Figure \ref{f:moto:bgp} shows how a stationary GP is able to capture the nonlinearity in the response but fails to capture the input dependent noise and increased smoothness (perhaps linearity) in parts of the input space. <>= moto.bgp <- bgp(X=X, Z=Z, verb=0) @ Progress indicators are suppressed. \begin{figure}[ht!] \centering <>= plot(moto.bgp, main='GP,', layout='surf') @ <>= graphics.off() @ \includegraphics[trim=0 25 0 25]{tgp-moto-bgp} %\vspace{-0.5cm} \caption{Posterior predictive distribution using {\tt bgp} on the motorcycle accident data: mean and 90\% credible interval} \label{f:moto:bgp} \end{figure} A Bayesian Linear CART model is able to capture the input dependent noise but fails to capture the waviness of the ``whiplash''---center--- segment of the response. <>= moto.btlm <- btlm(X=X, Z=Z, verb=0) @ Figure \ref{f:moto:btlm} shows the resulting piecewise linear predictive surface and MAP partition ($\hat{\mathcal{T}}$). \begin{figure}[ht!] \centering <>= plot(moto.btlm, main='Bayesian CART,', layout='surf') @ <>= graphics.off() @ \includegraphics[trim=0 25 0 25]{tgp-moto-btlm} %\vspace{-0.5cm} \caption{Posterior predictive distribution using {\tt btlm} on the motorcycle accident data: mean and 90\% credible interval} \label{f:moto:btlm} \end{figure} A treed GP model seems appropriate because it can model input dependent smoothness {\em and} noise. A treed GP LLM is probably most appropriate since the left-hand part of the input space is likely linear. One might further hypothesize that the right--hand region is also linear, perhaps with the same mean as the left--hand region, only with higher noise. The {\tt b*} functions can force an i.i.d.~hierarchical linear model by setting \verb!bprior="b0"!. <>= moto.btgpllm <- btgpllm(X=X, Z=Z, bprior="b0", verb=0) moto.btgpllm.p <- predict(moto.btgpllm) ## using MAP @ The {\tt predict.tgp} function obtains posterior predictive estimates from the MAP parameterization (a.k.a., {\em kriging}). \begin{figure}[ht!] \centering <>= par(mfrow=c(1,2)) plot(moto.btgpllm, main='treed GP LLM,', layout='surf') plot(moto.btgpllm.p, center='km', layout='surf') @ <>= graphics.off() @ \includegraphics[trim=50 25 50 20]{tgp-moto-btgp} <>= par(mfrow=c(1,2)) plot(moto.btgpllm, main='treed GP LLM,', layout='as') plot(moto.btgpllm.p, as='ks2', layout='as') @ <>= graphics.off() @ \includegraphics[trim=50 25 50 20]{tgp-moto-btgpq} %\vspace{-0.5cm} \caption{{\em Top}: Posterior predictive distribution using treed GP LLM on the motorcycle accident data. The {\em left}--hand panes how mean and 90\% credible interval; {\em bottom}: Quantile-norm (90\%-5\%) showing input-dependent noise. The {\em right}--hand panes show similar {\em kriging} surfaces for the MAP parameterization.} \label{f:moto:tgp} \end{figure} The resulting posterior predictive surface is shown in the {\em top--left} of Figure \ref{f:moto:tgp}. The {\em bottom--left} of the figure shows the norm (difference) in predictive quantiles, clearly illustrating the treed GP's ability to capture input-specific noise in the posterior predictive distribution. The {\em right}--hand side of the figure shows the MAP surfaces obtained from the output of the {\tt predict.tgp} function. The {\tt tgp}--default \verb!bprior="bflat"! implies an improper prior on the regression coefficients $\bm{\beta}$. It essentially forces $\mb{W}=\mb{\infty}$, thus eliminating the need to specify priors on $\bm{\beta}_0$ and $\mb{W}^{-1}$ in (\ref{eq:model}). This was chosen as the default because it works well in many examples, and leads to a simpler overall model and a faster implementation. However, the Motorcycle data is an exception. Moreover, when the response data is very noisy (i.e., low signal--to--noise ratio), {\tt tgp} can be expected to partition heavily under the \verb!bprior="bflat"! prior. In such cases, one of the other proper priors like the full hierarchical \verb!bprior="b0"! or \verb!bprior="bmzt"! might be preferred. An anonymous reviewer pointed out a shortcoming of the treed GP model on this data. The sharp spike in predictive variance near the first regime shift suggests that the symmetric Gaussian noise model may be inappropriate. A log Gaussian process might offer an improvement, at least locally. Running the treed GP MCMC for longer will eventually result in the finding of a partition near time=17, just after the first regime change. The variance is still poorly modeled in this region. Since it is isolated by the tree it could potentially be fit with a different noise model. \subsection{Friedman data} \label{sec:fried} <>= seed <- 0; set.seed(seed) @ This Friedman data set is the first one of a suite that was used to illustrate MARS (Multivariate Adaptive Regression Splines) \cite{freid:1991}. There are 10 covariates in the data ($\mb{x} = \{x_1,x_2,\dots,x_{10}\}$). The function that describes the responses ($Z$), observed with standard Normal noise, has mean \begin{equation} E(Z|\mb{x}) = \mu = 10 \sin(\pi x_1 x_2) + 20(x_3 - 0.5)^2 + 10x_4 + 5 x_5, \label{eq:f1} \end{equation} but depends only on $\{x_1,\dots,x_5\}$, thus combining nonlinear, linear, and irrelevant effects. Comparisons are made on this data to results provided for several other models in recent literature. Chipman et al.~\cite{chip:geor:mccu:2002} used this data to compare their treed LM algorithm to four other methods of varying parameterization: linear regression, greedy tree, MARS, and neural networks. The statistic they use for comparison is root mean-square error (RMSE) \begin{align*} \mbox{MSE} &= \textstyle \sum_{i=1}^n (\mu_i - \hat{z}_i)^2/n & \mbox{RMSE} &= \sqrt{\mbox{MSE}} \end{align*} where $\hat{z}_i$ is the model--predicted response for input $\mb{x}_i$. The $\mb{x}$'s are randomly distributed on the unit interval. Input data, responses, and predictive locations of size $N=200$ and $N'=1000$, respectively, can be obtained by a function included in the {\tt tgp} package. <<>>= f <- friedman.1.data(200) ff <- friedman.1.data(1000) X <- f[,1:10]; Z <- f$Y XX <- ff[,1:10] @ This example compares Bayesian treed LMs with Bayesian GP LLM (not treed), following the RMSE experiments of Chipman et al. It helps to scale the responses so that they have a mean of zero and a range of one. First, fit the Bayesian treed LM, and obtain the RMSE. <<>>= fr.btlm <- btlm(X=X, Z=Z, XX=XX, tree=c(0.95,2), pred.n=FALSE, verb=0) fr.btlm.mse <- sqrt(mean((fr.btlm$ZZ.mean - ff$Ytrue)^2)) fr.btlm.mse @ Next, fit the GP LLM, and obtain its RMSE. <<>>= fr.bgpllm <- bgpllm(X=X, Z=Z, XX=XX, pred.n=FALSE, verb=0) fr.bgpllm.mse <- sqrt(mean((fr.bgpllm$ZZ.mean - ff$Ytrue)^2)) fr.bgpllm.mse @ So, the GP LLM is \Sexpr{signif(fr.btlm.mse/fr.bgpllm.mse,4)} times better than Bayesian treed LM on this data, in terms of RMSE (in terms of MSE the GP LLM is \Sexpr{signif(sqrt(fr.btlm.mse)/sqrt(fr.bgpllm.mse),4)} times better). Parameter traces need to be gathered in order to judge the ability of the GP LLM model to identify linear and irrelevant effects. <<>>= XX1 <- matrix(rep(0,10), nrow=1) fr.bgpllm.tr <- bgpllm(X=X, Z=Z, XX=XX1, pred.n=FALSE, trace=TRUE, m0r1=FALSE, verb=0) @ Here, \verb!m0r1 = FALSE! has been specified instead so that the $\bm{\beta}$ estimates provided below will be on the original scale.\footnote{The default setting of {\tt m0r1 = TRUE} causes the {\tt Z}--values to undergo pre-processing so that they have a mean of zero and a range of one. The default prior specification has been tuned so as to work well this range.} A summary of the parameter traces show that the Markov chain had the following (average) configuration for the booleans. <<>>= trace <- fr.bgpllm.tr$trace$XX[[1]] apply(trace[,27:36], 2, mean) @ Therefore the GP LLM model correctly identified that only the first three input variables interact only linearly with the response. This agrees with dimension--wise estimate of the total area of the input domain under the LLM (out of a total of 10 input variables). <<>>= mean(fr.bgpllm.tr$trace$linarea$ba) @ A similar summary of the parameter traces for $\bm{\beta}$ shows that the GP LLM correctly identified the linear regression coefficients associated with the fourth and fifth input covariates (from (\ref{eq:f1})) <<>>= summary(trace[,9:10]) @ and that the rest are much closer to zero. <<>>= apply(trace[,11:15], 2, mean) @ \subsection{Adaptive Sampling} \label{sec:as} <>= seed <- 0; set.seed(seed) @ In this section, sequential design of experiments, a.k.a.~{\em adaptive sampling}, is demonstrated on the exponential data of Section \ref{sec:exp}. Gathering, again, the data: <<>>= exp2d.data <- exp2d.rand(lh=0, dopt=10) X <- exp2d.data$X Z <- exp2d.data$Z Xcand <- lhs(1000, rbind(c(-2,6),c(-2,6))) @ In contrast with the data from Section \ref{sec:exp}, which was based on a grid, the above code generates a randomly subsampled $D$--optimal design $\mb{X}$ from LH candidates, and random responses $\mb{Z}$. As before, design configurations are more densely packed in the interesting region. Candidates $\tilde{\mb{X}}$ are from a large LH--sample. Given some data $\{\mb{X},\mb{Z}\}$, the first step in sequential design using {\tt tgp} is to fit a treed GP LLM model to the data, without prediction, in order to infer the MAP tree $\hat{\mathcal{T}}$. <>= exp1 <- btgpllm(X=X, Z=Z, pred.n=FALSE, corr="exp", R=5, verb=0) @ \begin{figure}[ht!] \centering <>= tgp.trees(exp1) @ <>= graphics.off() @ \includegraphics[trim=50 50 50 20]{tgp-as-mapt} \vspace{-1cm} \caption{MAP trees of each height encountered in the Markov chain for the exponential data, showing $\hat{\sigma}^2$ and the number of observations $n$ at the leaves. $\hat{\mathcal{T}}$ is the one with the maximum $\log(p)$ above.} \label{f:mapt} \end{figure} The trees are shown in Figure \ref{f:mapt}. Then, use the {\tt tgp.design} function to create $D$--optimal candidate designs in each region of $\hat{\mathcal{T}}$. For the purposes of illustrating the {\tt improv} statistic, I have manually added the known (from calculus) global minimum to {\tt XX}. <<>>= XX <- tgp.design(200, Xcand, exp1) XX <- rbind(XX, c(-sqrt(1/2),0)) @ Figure \ref{f:cands} shows the sampled {\tt XX} locations (circles) amongst the input locations {\tt X} (dots) and MAP partition $(\hat{\mathcal{T}})$. Notice how the candidates {\tt XX} are spaced out relative to themselves, and relative to the inputs {\tt X}, unless they are near partition boundaries. The placing of configurations near region boundaries is a symptom particular to $D$--optimal designs. This is desirable for experiments with {\tt tgp} models, as model uncertainty is usually high there \cite{chaloner:1995}. \begin{figure}[ht!] \centering <>= plot(exp1$X, pch=19, cex=0.5) points(XX) mapT(exp1, add=TRUE) @ <>= graphics.off() @ \includegraphics[trim=0 0 0 45]{tgp-as-cands} \vspace{-0.5cm} \caption{Treed $D$--optimal candidate locations {\tt XX} (circles), input locations {\tt X} (dots), and MAP tree $\hat{\mathcal{T}}$} \label{f:cands} \end{figure} Now, the idea is to fit the treed GP LLM model, again, in order to assess uncertainty in the predictive surface at those new candidate design points. The following code gathers all three adaptive sampling statistics: ALM, ALC, \& EI. <>= exp.as <- btgpllm(X=X, Z=Z, XX=XX, corr="exp", improv=TRUE, Ds2x=TRUE, R=5, verb=0) @ Figure \ref{f:as} shows the posterior predictive estimates of the adaptive sampling statistics. The error surface, on the {\em left}, summarizes posterior predictive uncertainty by a norm of quantiles. %%Since the combined data and predictive locations are not densely %%packed in the input space, the {\tt loess} smoother may have trouble %%with the interpolation. One option is increase the {\tt tgp}-default %%kernel span supplied to {\tt loess}, e.g., {\tt span = 0.5}. \begin{figure}[ht!] \centering <>= par(mfrow=c(1,3), bty="n") plot(exp.as, main="tgpllm,", layout="as", as="alm") plot(exp.as, main="tgpllm,", layout='as', as='alc') plot(exp.as, main="tgpllm,", layout='as', as='improv') @ <>= graphics.off() @ % do the including over here instead \includegraphics[trim=75 0 75 20]{tgp-as-expas} \vspace{-0.5cm} \caption{{\em Left}: Image plots of adaptive sampling statistics and MAP trees $\hat{\mathcal{T}}$; {\em Left}; ALM adaptive sampling image for (only) candidate locations {\tt XX} (circles); {\em center}: ALC; and {\em right:} EI.} \label{f:as} \end{figure} In accordance with the ALM algorithm, candidate locations {\tt XX} with largest predictive error would be sampled (added into the design) next. These are most likely to be in the interesting region, i.e., the first quadrant. However, these results depend heavily on the clumping of the original design in the un-interesting areas, and on the estimate of $\hat{\mathcal{T}}$. Adaptive sampling via the ALC, or EI (or both) algorithms proceeds similarly, following the surfaces shown in {\em center} and {\em right} panels of Figure \ref{f:as}. \subsection*{Acknowledgments} This work was partially supported by research subaward 08008-002-011-000 from the Universities Space Research Association and NASA, NASA/University Affiliated Research Center grant SC 2003028 NAS2-03144, Sandia National Laboratories grant 496420, and National Science Foundation grants DMS 0233710 and 0504851. I would like to thank Matt Taddy for his contributions to recent releases of the package. I am especially grateful to my thesis advisor, Herbie Lee, whose contributions and guidance in this project have been invaluable throughout. Finally, I would like to thank an anonymous referee whose many helpful comments improved the paper. \appendix \section{Implementation notes} \label{sec:howimplement} The treed GP model is coded in a mixture of {\tt C} and {\tt C++}: {\tt C++} for the tree data structure ($\mathcal{T}$) and {\tt C} for the GP at each leaf of $\mathcal{T}$. The code has been tested on Unix ({\tt Solaris, Linux, FreeBSD, OSX}) and Windows (2000, XP) platforms. It is useful to first translate and re-scale the input data ($\mb{X}$) so that it lies in an $\Re^{m_X}$ dimensional unit cube. This makes it easier to construct prior distributions for the width parameters to the correlation function $K(\cdot,\cdot)$. Proposals for all parameters which require MH sampling are taken from a uniform ``sliding window'' centered around the location of the last accepted setting. For example, a proposed a new nugget parameter $g_\nu$ to the correlation function $K(\cdot, \cdot)$ in region $r_\nu$ would go as \[ g_\nu^* \sim \mbox{Unif}\left(\frac{3}{4}g_\nu, \frac{4}{3}g_\nu \right). \] Calculating the corresponding forward and backwards proposal probabilities for the MH acceptance ratio is straightforward. For more details about the MCMC algorithm and proposals, etc., please see the original technical report on {\em Bayesian treed Gaussian process models} \cite{gra:lee:2008}. \section{Interfaces and features} The following subsections describe some of the ancillary features of the {\tt tgp} package such as the gathering and summarizing of MCMC parameter traces, the progress meter, and an example of how to use the {\tt predict.tgp} function in a collaborative setting. \subsection{Parameter traces} \label{sec:traces} <>= seed <- 0; set.seed(seed) @ Traces of (almost) all parameters to the {\tt tgp} model can be collected by supplying {\tt trace=TRUE} to the {\tt b*} functions. In the current version, traces for the linear prior correlation matrix ($\mb{W}$) are not provided. I shall illustrate the gathering and analyzing of traces through example. But first, a few notes and cautions. Models which involve treed partitioning may have more than one base model (GP or LM). The process governing a particular input $\mb{x}$ depends on the coordinates of $\mb{x}$. As such, {\tt tgp} records region--specific traces of parameters to GP (and linear) models at the locations enumerated in the {\tt XX} argument. Even traces of single--parameter Markov chains can require hefty amounts of storage, so recording traces at each of the {\tt XX} locations can be an enormous memory hog. A related warning will be given if the product of $|${\tt XX}$|$, \verb!(BTE[2]-BTE[1])/BTE[3]! and {\sf R} is beyond a threshold. The easiest way to keep the storage requirements for traces down is to control the size of {\tt XX} and the thinning level {\tt BTE[3]}. Finally, traces for most of the parameters are stored in output files. The contents of the trace files are read into {\sf R} and stored as {\tt data.frame} objects, and the files are removed. The existence of partially written trace files in the current working directory (CWD)---while the {\tt C} code is executing---means that not more than one {\tt tgp} run (with \verb!trace = TRUE!) should be active in the CWD at one time. Consider again the exponential data. For illustrative purposes I chose {\tt XX} locations (where traces are gathered) to be (1) in the interior of the interesting region, (2) on/near the plausible intersection of partition boundaries, and (3) in the interior of the flat region. The hierarchical prior \verb!bprior = "b0"! is used to leverage a (prior) belief the most of the input domain is uninteresting. <<>>= exp2d.data <- exp2d.rand(n2=150, lh=0, dopt=10) X <- exp2d.data$X Z <- exp2d.data$Z XX <- rbind(c(0,0),c(2,2),c(4,4)) @ We now fit a treed GP LLM and gather traces, and also gather EI and ALC statistics for the purposes of illustration. Prediction at the input locations {\tt X} is turned off to be thrifty. <<>>= out <- btgpllm(X=X, Z=Z, XX=XX, corr="exp", bprior="b0", pred.n=FALSE, Ds2x=TRUE, R=10, trace=TRUE, verb=0) @ \begin{figure}[hp] \centering <<>>= out$trace @ \caption{Listing the contents of {\tt "tgptraces"}--class objects.} \label{f:tgptraces} \end{figure} Figure \ref{f:tgptraces} shows a dump of \verb!out$trace! which is a \verb!"tgptraces"!--class object. It depicts the full set of parameter traces broken down into the elements of a \verb!list!: \verb!$XX! with GP/LLM parameter traces for each {\tt XX} location (the parameters are listed); \verb!$hier! with traces for (non--input--dependent) hierarchical parameters (listed); \verb!$linarea! recording proportions of the input space under the LLM; \verb!$parts! with the boundaries of all partitions visited; \verb!$post! containing (log) posterior probabilities; \verb!preds! containing traces of samples from the posterior predictive distribution and adaptive sampling statistics. \begin{figure}[ht!] \centering <>= trXX <- out$trace$XX; ltrXX <- length(trXX) y <- trXX[[1]]$d for(i in 2:ltrXX) y <- c(y, trXX[[i]]$d) plot(log(trXX[[1]]$d), type="l", ylim=range(log(y)), ylab="log(d)", main="range (d) parameter traces") names <- "XX[1,]" for(i in 2:ltrXX) { lines(log(trXX[[i]]$d), col=i, lty=i) names <- c(names, paste("XX[", i, ",]", sep="")) } legend("bottomleft", names, col=1:ltrXX, lty=1:ltrXX) @ <>= graphics.off() @ \includegraphics[trim=55 25 65 20]{tgp-traces-XXd} \caption{Traces of the (log of the) first range parameter for each of the three {\tt XX} locations} \label{f:XXd} \end{figure} Plots of traces are useful for assessing the mixing of the Markov chain. For example, Figure \ref{f:XXd} plots traces of the range parameter ($d$) %in the first input dimension ($d_1$) for each of the \Sexpr{length(out$trace$XX)} predictive locations {\tt XX}. It is easy to see which of the locations is in the same partition with others, and which have smaller range parameters than others. The mean area under the LLM can be calculated as <<>>= linarea <- mean(out$trace$linarea$la) linarea @ \begin{figure}[ht!] \centering <>= hist(out$trace$linarea$la) @ <>= graphics.off() @ \includegraphics[trim=0 0 0 20]{tgp-traces-la} \vspace{-0.5cm} \caption{Histogram of proportions of the area of the input domain under the LLM} \label{f:la} \end{figure} This means that the expected proportion of the input domain under the full LLM is \Sexpr{signif(linarea[1], 3)}. Figure \ref{f:la} shows a histogram of areas under the LLM. The clumps near 0, 0.25, 0.5, and 0.75 can be thought of as representing quadrants (none, one, two, and tree) under the LLM. Similarly, we can calculate the probability that each of the {\tt XX} locations is governed by the LLM. % (in total, and by dimension) <<>>= m <- matrix(0, nrow=length(trXX), ncol=3)#ncol=5) for(i in 1:length(trXX)) m[i,] <- as.double(c(out$XX[i,], mean(trXX[[i]]$b))) m <- data.frame(cbind(m, 1-m[,3])) names(m)=c("XX1","XX2","b","pllm") m @ The final column above represents the probability that the corresponding {\tt XX} location is under the LLM (which is equal to {\tt 1-b}). \begin{figure}[ht!] \centering <>= trALC <- out$trace$preds$Ds2x y <- trALC[,1] for(i in 2:ncol(trALC)) y <- c(y, trALC[,i]) plot(log(trALC[,1]), type="l", ylim=range(log(y)), ylab="Ds2x", main="ALC: samples from Ds2x") names <- "XX[1,]" for(i in 2:ncol(trALC)) { lines(log(trALC[,i]), col=i, lty=i) names <- c(names, paste("XX[", i, ",]", sep="")) } legend("bottomright", names, col=1:ltrXX, lty=1:ltrXX) @ <>= graphics.off() @ \includegraphics[trim=55 25 65 20]{tgp-traces-alc} \caption{Traces of the (log of the) samples for the ALC statistic $\Delta \sigma^2(\tilde{\mb{x}})$ at for each of the three {\tt XX} locations} \label{f:preds} \end{figure} Traces of posterior predictive and adaptive sampling statistics are contained in the \verb!$preds! field. For example, Figure \ref{f:preds} shows samples of the ALC statistic $\Delta \sigma^2(\tilde{\mb{x}})$. We can see from the trace that statistic is generally lowest for {\tt XX[3,]} which is in the uninteresting region, and that there is some competition between {\tt XX[2,]} which lies on the boundary between the regions, and {\tt XX[1,]} which is in the interior of the interesting region. Similar plots can be made for the other adaptive sampling statistics (i.e., ALM \& EI). \subsection{Explaining the progress meter} \label{sec:progress} The progress meter shows the state of the MCMC as it iterates through the desired number of rounds of burn--in ({\tt BTE[1]}), and sampling ({\tt BTE[2]-BTE[1]}), for the requested number of repeats ({\sf R-1}). The verbosity of progress meter print statements is controlled by the {\tt verb} arguments to the {\tt b*} functions. Providing {\tt verb=0} silences all non--warning (or error) statements. To suppress warnings, try enclosing commands within {\tt suppressWarnings(...)}, or globally set {\tt options(warn=0)}. See the help file ({\tt ?options}) for more global warning settings. The default verbosity setting ({\tt verb=1}) shows all {\em grows} and {\em prunes}, and a summary of $d$--(range) parameters for each partition every 1000 rounds. Higher verbosity arguments will show more tree operations, e.g., {\em change} and {\em swap}, etc. Setting {\tt verb=2} will cause an echo of the {\tt tgp} model parameters and their starting values; but is otherwise the same as {\tt verb=1}. The max is {\tt verb=4} shows all successful tree operations. Here is an example {\em grow} statement. \begin{verbatim} **GROW** @depth 2: [0,0.05], n=(10,29) \end{verbatim} The {\tt *GROW*} statements indicate the depth of the split leaf node; the splitting dimension $u$ and location $v$ is shown between square brackets {\tt [u,v]}, followed by the size of the two new children {\tt n=(n1,n2)}. {\tt *PRUNE*} is about the same, without printing {\tt n=(n1,n2)}. Every 1000 rounds a progress indicator is printed. Its format depends on a number of things: (1) whether parallelization is turned on or not, (2) the correlation model [isotropic or separable], (3) whether jumps to the LLM are allowed. Here is an example with the 2-d exp data with parallel prediction under the separable correlation function: \begin{verbatim} (r,l)=(5000,104) d=[0.0144 0.0236] [1.047 0/0.626]; mh=2 n=(59,21) \end{verbatim} The first part {\tt (r,l)=(5000,104)} is indicating the MCMC round number r=5000 and the number of leaves waiting to be "consumed" for prediction by the parallel prediction thread. When parallelization is turned off (default), the print will simply be {\tt "r=5000"}. The second part is a printing of the $d$--(range) parameter to a separable correlation function. For 2 partitions there are two sets of square brackets. Inside the square brackets is the $m_X$ (2 in this case) range parameters for the separable correlation function. Whenever the LLM governs one of the input dimensions a zero will appear. I.e., the placement of {\tt 0/0.626} indicates the LLM is active in the 2nd dimension of the 2nd partition. 0.626 is the $d$--(range) parameter that would have been used if the LLM were inactive. Whenever all dimensions are under the LLM, the d-parameter print is simply {\tt [0]}. This also happens when forcing the LLM (i.e., for {\tt blm} and {\tt btlm}), where {\tt [0]} appears for each partition. These prints will look slightly different if the isotropic instead of separable correlation is used, since there are not as many range parameters. \subsection{Collaboration with {\tt predict.tgp}} \label{sec:apred} <>= seed <- 0; set.seed(seed) @ In this section I revisit the motorcycle accident data in order to demonstrate how the {\tt predict.tgp} function can be helpful in collaborative uses of {\tt tgp}. Consider a fit of the motorcycle data, and suppose that infer the model parameters only (obtaining no samples from the posterior predictive distribution). The \verb!"tgp"!-class output object can be saved to a file using the {\tt R}--internal {\tt save} function. <<>>= library(MASS) out <- btgpllm(X=mcycle[,1], Z=mcycle[,2], bprior="b0", pred.n=FALSE, verb=0) save(out, file="out.Rsave") out <- NULL @ Note that there is nothing to plot here because there is no predictive data. (\verb!out <- NULL! is set for illustrative purposes.) Now imagine e--mailing the ``out.Rsave'' file to a collaborator who wishes to use your fitted {\tt tgp} model. S/he could first load in the \verb!"tgp"!--class object we just saved, design a new set of predictive locations {\tt XX} and obtain kriging estimates from the MAP model. <<>>= load("out.Rsave") XX <- seq(2.4, 56.7, length=200) out.kp <- predict(out, XX=XX, pred.n=FALSE) @ Another option would be to sample from the posterior predictive distribution of the MAP model. <<>>= out.p <- predict(out, XX=XX, pred.n=FALSE, BTE=c(0,1000,1)) @ This holds the parameterization of the {\tt tgp} model {\em fixed} at the MAP, and samples from the GP or LM posterior predictive distributions at the leaves of the tree. Finally, the MAP parameterization can be used as a jumping-off point for more sampling from the joint posterior and posterior predictive distribution. <<>>= out2 <- predict(out, XX, pred.n=FALSE, BTE=c(0,2000,2), MAP=FALSE) @ Since the return--value of a {\tt predict.tgp} call is also a \verb!"tgp"!--class object the process can be applied iteratively. That is, {\tt out2} can also be passed to {\tt predict.tgp}. \begin{figure}[hp] \centering <>= plot(out.kp, center="km", as="ks2") @ <>= graphics.off() @ \vspace{-0.1cm} \includegraphics[trim=50 30 50 25]{tgp-pred-kp} <>= plot(out.p) @ <>= graphics.off() @ \vspace{-0.1cm} \includegraphics[trim=50 30 50 25]{tgp-pred-p} <>= plot(out2) @ <>= graphics.off() @ \includegraphics[trim=50 30 50 25]{tgp-pred-2} \caption{Predictive surfaces ({\em left}) and error/variance plots ({\em right}) resulting from three different uses of the {\tt predict.tgp} function: MAP kriging ({\em top}), sampling from the MAP ({\em middle}), sampling from the joint posterior and posterior predictive starting from the MAP ({\em bottom}).} \label{f:pred} \end{figure} Figure \ref{f:pred} plots the posterior predictive surfaces for each of the three calls to {\tt predict.tgp} above. The kriging surfaces are smooth within regions of the partition, but the process is discontinuous across partition boundaries. The middle surface is simply a Monte Carlo--sample summarization of the kriging one above it. The final surface summarizes samples from the posterior predictive distribution when obtained jointly with samples from $\mathcal{T}|\bm{\theta}$ and $\bm{\theta}|\mathcal{T}$. Though these summaries are still ``noisy'' they depict a process with smoother transitions across partition boundaries than ones conditioned only on the MAP parameterization. <>= unlink("out.Rsave") @ Finally, the {\tt predict.tgp} function can also sample from the ALC statistic and calculate expected improvements (EI) at the {\tt XX} locations. While the function was designed with prediction in mind, it is actually far more general. It allows a continuation of MCMC sampling where the {\tt b*} function left off (when {\tt MAP=FALSE}) with a possibly new set of predictive locations {\tt XX}. The intended use of this function is to obtain quick kriging--style predictions for a previously-fit MAP estimate (contained in a \verb!"tgp"!-class object) on a new set of predictive locations {\tt XX}. However, it can also be used simply to extend the search for an MAP model when {\tt MAP=FALSE}, {\tt pred.n=FALSE}, and {\tt XX=NULL}. \section{Configuration and performance optimization} In what follows I describe customizations and enhancements that can be made to {\tt tgp} at compile time in order to take advantage of custom computing architectures. The compilation of {\tt tgp} with a linear algebra library different from the one used to compile {\sf R} (e.g., ATLAS), and the configuration and compilation of {\tt tgp} with parallelization is described in detail. \subsection{Linking to ATLAS} \label{sec:atlas} {\tt ATLAS} \cite{atlas-hp} is supported as an alternative to standard {\tt BLAS} and {\tt LAPACK} for fast, automatically tuned, linear algebra routines. %Compared to standard {\tt BLAS} and {\tt Lapack}, %those automatically tuned by {\tt ATLAS} are significantly faster. If you know that {\sf R} has already been linked to tuned linear algebra libraries (e.g., on {\tt OSX}), then compiling with {\tt ATLAS} as described below, is unnecessary---just install {\tt tgp} as usual. As an alternative to linking {\tt tgp} to {\tt ATLAS} directly, one could re-compile all of {\sf R} linking it to {\tt ATLAS}, or some other platform--specific {\tt BLAS}/{\tt Lapack}, i.e., {\tt Intel}'s Math Kernel Library, or {\tt AMD}'s Core Math Library, as described in: \begin{center} \verb!http://cran.r-project.org/doc/manuals/R-admin.html! \end{center} Look for the section titled ``Linear Algebra''. While this is arguably best solution since all of {\sf R} benefits, the task can prove challenging to accomplish and may require administrator (root) privileges. Linking {\tt tgp} with {\tt ATLAS} directly is described here. GP models implemented in {\tt tgp} can get a huge benefit from tuned linear algebra libraries, since the MCMC requires many large matrix multiplications and inversions (particularly of $\mb{K}$). In some cases the improvement can be as large as tenfold with {\tt ATLAS} as compared to the default {\sf R} linear algebra routines. Comparisons between {\tt ATLAS} and architecture specific libraries like {\tt MKL} for {\tt Intel} or {\tt veclib} for {\tt OSX} usually show the latter favorably, though the difference is less impressive. For example, see \begin{center} \verb!http://www.intel.com/cd/software/products/asmo-na/eng/266858.htm! \end{center} for a comparison to {\tt MKL} on several typical benchmarks. Three easy steps (assuming, of course, you have already compiled and installed {\tt ATLAS} -- {\tt http://math-atlas.sourceforge.net}) need to be performed before you install the {\tt tgp} package from source. \begin{enumerate} \item Edit src/Makevars. Comment out the existing \verb!PKG_LIBS! line, and replace it with: \begin{verbatim} PKG_LIBS = -L/path/to/ATLAS/lib -llapack -lcblas -latlas \end{verbatim} You may need replace \verb!-llapack -lcblas -latlas! with whatever {\tt ATLAS} recommends for your OS. (See {\tt ATLAS} README.) For example, if your {\tt ATLAS} compilation included {\tt F77} support, you may need to add \verb!"-lF77blas"!, if you compiled with {\tt Pthreads}, you would might use \begin{verbatim} -llapack -lptcblas -lptf77blas -latlas \end{verbatim} \item Continue editing src/Makevars. Add: \begin{verbatim} PKG_CFLAGS = -I/path/to/ATLAS/include \end{verbatim} \item Edit src/linalg.h and comment out lines 40 \& 41: \begin{verbatim} /*#define FORTPACK #define FORTBLAS*/ \end{verbatim} \end{enumerate} Now simply install the {\tt tgp} package as usual. Reverse the above instructions to disable {\tt ATLAS}. Don't forget to re-install the package when you're done. Similar steps can be taken for platform specific libraries like {\tt MKL}, leaving off step 3. \subsection{Parallelization with {\tt Pthreads}} \label{sec:pthreads} After conditioning on the tree and parameters ($\{\mathcal{T}, \bm{\theta}\}$), prediction can be parallelized by using a producer/consumer model. This allows the use of {\tt PThreads} in order to take advantage of multiple processors, and get speed-ups of at least a factor of two. This is particularly relevant since dual processor workstations and multi-processor servers are becoming commonplace in modern research labs. However, multi--processors are not yet ubiquitous, so parallel--{\tt tgp} is not yet the default. Using the parallel version will be slower than the non--parallel (serial) version on a single processor machine. Enabling parallelization requires two simple steps, and then a re--install. \begin{enumerate} \item Add \verb!-DPARALLEL! to \verb!PKG_CXXFLAGS! of src/Makevars \item You may need to add \verb!-pthread! to \verb!PKG_LIBS! of src/Makevars, or whatever is needed by your compiler in order to correctly link code with {\tt PThreads}. \end{enumerate} The biggest improvement in the parallel version, over the serial, is observed when calculating ALC statistics, which require $O(n_2^2)$ time for $n_2$ predictive locations, or when calculating ALM (default) or EI statistics on predictive locations whose number ($n_2$) is at least an order of magnitude larger ($n_2\gg n_1)$ than the number of input locations ($n_1$). Parallel sampling of the posterior of $\bm{\theta}|\mathcal{T}$ for each of the $\{\theta_\nu\}_{\nu=1}^R$ is also possible. However, the speed-up in this second case is less impressive, and so is not supported by the current version of the {\tt tgp} package. \bibliography{tgp} \bibliographystyle{plain} \end{document} tgp/vignettes/tgp2.Rnw0000644000176200001440000032706413724172614014443 0ustar liggesusers\documentclass[12pt]{article} \usepackage{Sweave} %\SweaveOpts{eps=TRUE} %\usepackage[footnotesize]{caption} \usepackage{caption} \usepackage{amsmath} \usepackage{amsfonts} \usepackage{amscd} \usepackage{epsfig} \usepackage{fullpage} %\renewcommand{\baselinestretch}{1.5} \newcommand{\bm}[1]{\mbox{\boldmath $#1$}} \newcommand{\mb}[1]{\mathbf{#1}} \newcommand{\mc}[1]{\mathcal{#1}} \newcommand{\mr}[1]{\mathrm{#1}} \newcommand{\mbb}[1]{\mathbb{#1}} %\VignetteIndexEntry{new features in tgp version 2.x} %\VignetteKeywords{tgp2} %\VignetteDepends{tgp,maptree,MASS} %\VignettePackage{tgp} \begin{document} \setkeys{Gin}{width=0.85\textwidth} <>= library(tgp) options(width=65) @ \title{Categorical inputs, sensitivity analysis,\\ optimization and importance tempering\\ with {\tt tgp} version 2, an {\sf R} package for\\ treed Gaussian process models} \author{ Robert B. Gramacy\\ Department of Statistics\\ Virginia Tech\\ rbg@vt.edu \and Matt Taddy\\ Amazon\\ mataddy@amazon.com } \maketitle \begin{abstract} This document describes the new features in version 2.x of the {\tt tgp} package for {\sf R}, implementing treed Gaussian process (GP) models. The topics covered include methods for dealing with categorical inputs and excluding inputs from the tree or GP part of the model; fully Bayesian sensitivity analysis for inputs/covariates; %multiresolution (treed) Gaussian process modeling; sequential optimization of black-box functions; and a new Monte Carlo method for inference in multi-modal posterior distributions that combines simulated tempering and importance sampling. These additions extend the functionality of {\tt tgp} across all models in the hierarchy: from Bayesian linear models, to CART, to treed Gaussian processes with jumps to the limiting linear model. %, except in the case of multiresolution models which apply only %to the (treed) GP. It is assumed that the reader is familiar with the baseline functionality of the package, outlined in the first vignette \cite{gramacy:2007}. \end{abstract} \subsection*{Intended audience} \label{sec:discaimer} The {\tt tgp} package contains implementations of seven related Bayesian regression frameworks which combine treed partition models, linear models (LM), and stationary Gaussian process (GP) models. GPs are flexible (phenomenological) priors over functions which, when used for regression, are usually relegated to smaller applications for reasons of computational expense. Trees, by contrast, are a crude but efficient divide-and-conquer approach to non-stationary regression. When combined they are quite powerful, and provide a highly flexible nonparametric and non-stationary family of regression tools. These treed GP models have been successfully used in a variety of contexts, in particular in the sequential design and analysis of computer experiments. The models, and the (base) features of the package, are described the vignette for version 1.x of the package \cite{gramacy:2007}. This document is intended as a follow-on, describing four new features that have been added to the package in version 2.x. As such, it is divided into four essentially disjoint sections: on categorical inputs (Section \ref{sec:cat}), sensitivity analysis (Section \ref{sec:sens}), statistical optimization (Section \ref{sec:optim}), and importance tempering (Section \ref{sec:it}). The ability to deal with categorical inputs greatly expands the sorts of regression problems which {\tt tgp} can handle. It also enables the partition component of the model to more parsimoniously describe relationships that were previously left to the GP part of the model, at a great computational expense and interpretational disadvantage. The analysis of sensitivity to inputs via the predictive variance enables the user to inspect, and understand, the first-order and total effects of each of the inputs on the response. The section on statistical optimization expands the sequential design feature set described in the first vignette. We now provide a skeleton which automates the optimization of black-box functions by expected improvement, along with tools and suggestions for assessing convergence. Finally, the addition of tempering-based MCMC methods leads to more reliable inference via a more thorough exploration of the highly multi-modal posterior distributions that typically result from tree based models, which previously could only be addressed by random restarts. Taken all together, these four features have greatly expanded the capabilities of the package, and thus the variety of statistical problems which can be addressed with the {\tt tgp} family of methods. Each of the four sections to follow will begin with a short mathematical introduction to the new feature or methodology and commence with extensive examples in {\sf R} on synthetic and real data. This document has been authored in {\tt Sweave} (try {\tt help(Sweave)}). This means that the code quoted throughout is certified by {\sf R}, and the {\tt Stangle} command can be used to extract it. As with the first vignette, the {\sf R} code in each of the sections to follow is also available as a demo in the package. Note that this tutorial was not meant to serve as an instruction manual. For more detailed documentation of the functions contained in the package, see the package help--manuals. At an {\sf R} prompt, type {\tt help(package=tgp)}. PDF documentation is also available on the world-wide-web. \begin{center} \tt http://www.cran.r-project.org/doc/packages/tgp.pdf \end{center} Each section starts by seeding the random number generator with \verb!set.seed(0)!. This is done to make the results and analyses reproducible within this document (assuming identical architecture [64-bit Linux] and version of {\sf R} [2.10.1]), and in demo form. We recommend you try these examples with different seeds and see what happens. Usually the results will be similar, but sometimes (especially when the data ({\tt X},{\tt Z}) is generated randomly) they may be quite different. \section{Non--real--valued, categorical and other inputs} \label{sec:cat} <>= seed <- 1; set.seed(seed) ## seed zero problematic with null btlm map tree below @ Early versions of {\tt tgp} worked best with real--valued inputs $\mb{X}$. While it was possible to specify ordinal, integer--valued, or even binary inputs, {\tt tgp} would treat them the same as any other real--valued input. Two new arguments to {\tt tgp.default.params}, and thus the ellipses ({\tt ...}) argument to the {\tt b*} functions, provide a more natural way to model with non--real valued inputs. In this section we shall introduce these extensions, and thereby illustrate how the current version of the package can more gracefully handle categorical inputs. We argue that the careful application of this new feature can lead to reductions in computational demands, improved exploration of the posterior, increased predictive accuracy, and more transparent interpretation of the effects of categorical inputs. Classical treed methods, such as CART \cite{brei:1984}, can cope quite naturally with categorical, binary, and ordinal, inputs. Categorical inputs can be encoded in binary, and splits can be proposed with rules such as $x_i < 1$. Once a split is made on a binary input, no further process is needed, marginally, in that dimension. Ordinal inputs can also be coded in binary, and thus treated as categorical, or treated as real--valued and handled in a default way. GP regression, however, handles such non--real--valued inputs less naturally, unless (perhaps) a custom and non--standard form of the covariance function is used \cite{qian:wu:wu:2009}. When inputs are scaled to lie in $[0,1]$, binary--valued inputs $x_i$ are always a constant distance apart---at the largest possible distance in the range. A separable correlation function width parameter $d_i$ will tend to infinity (in the posterior) if the output does not vary with $x_i$, and will tend to zero if it does. Clearly, this functionality is more parsimoniously achieved by partitioning, e.g., using a tree. However, trees with fancy regression models at the leaves pose other problems, as discussed below. Consider as motivation, the following modification of the Friedman data \cite{freid:1991} (see also Section 3.5 of \cite{gramacy:2007}). Augment 10 real--valued covariates in the data ($\mb{x} = \{x_1,x_2,\dots,x_{10}\}$) with one categorical indicator $I\in\{1,2,3,4\}$ that can be encoded in binary as \begin{align*} 1& \equiv (0,0,0) & 2 &\equiv (0,0,1) & 3 &\equiv (0,1,0) & 4 &\equiv (1,0,0). \end{align*} Now let the function that describes the responses ($Z$), observed with standard Normal noise, have a mean \begin{equation} E(Z|\mb{x}, I) = \left\{ \begin{array}{cl} 10 \sin(\pi x_1 x_2) & \mbox{if } I = 1 \\ 20(x_3 - 0.5)^2 &\mbox{if } I = 2 \\ 10x_4 + 5 x_5 &\mbox{if } I = 3 \\ 5 x_1 + 10 x_2 + 20(x_3 - 0.5)^2 + 10 \sin(\pi x_4 x_5) &\mbox{if } I = 4 \label{eq:f1b} \end{array} \right. \end{equation} that depends on the indicator $I$. Notice that when $I=4$ the original Friedman data is recovered, but with the first five inputs in reverse order. Irrespective of $I$, the response depends only on $\{x_1,\dots,x_5\}$, thus combining nonlinear, linear, and irrelevant effects. When $I=3$ the response is linear $\mb{x}$. A new function has been included in the {\tt tgp} package which facilitates generating random realizations from (\ref{eq:f1b}). Below we obtain 500 such random realizations for training purposes, and a further 1000 for testing. <<>>= fb.train <- fried.bool(500) X <- fb.train[,1:13]; Z <- fb.train$Y fb.test <- fried.bool(1000) XX <- fb.test[,1:13]; ZZ <- fb.test$Ytrue @ A separation into training and testing sets will be useful for later comparisons by RMSE. The names of the data frame show that the first ten columns encode $\mb{x}$ and columns 11--13 encode the boolean representation of $I$. <<>>= names(X) @ One, na\"ive approach to fitting this data would be to fit a treed GP LLM model ignoring the categorical inputs. But this model can only account for the noise, giving high RMSE, and so is not illustrated here. Clearly, the indicators must be included. One simple way to do so would be to posit a Bayesian CART model. <<>>= fit1 <- bcart(X=X, Z=Z, XX=XX, verb=0) rmse1 <- sqrt(mean((fit1$ZZ.mean - ZZ)^2)) rmse1 @ In this case the indicators are treated appropriately (as indicators), but in some sense so are the real--valued inputs as only constant models are fit at the leaves of the tree. \begin{figure}[ht!] <>= tgp.trees(fit1, "map") @ <>= graphics.off() @ \centering \includegraphics[trim=0 100 0 25]{tgp2-cat-fbcart-mapt} \caption{Diagrammatic depiction of the maximum {\em a' posteriori} (MAP) tree for the boolean indicator version of the Friedman data in Eq.~(\ref{eq:f1b}) using Bayesian CART.} \label{f:fb:cart} \end{figure} Figure \ref{f:fb:cart} shows that the tree does indeed partition on the indicators, and the other inputs, as expected. One might expect a much better fit from a treed linear model to this data, since the response is linear in some of its inputs. <<>>= fit2 <- btlm(X=X, Z=Z, XX=XX, verb=0) rmse2 <- sqrt(mean((fit2$ZZ.mean - ZZ)^2)) rmse2 @ Unfortunately, this is not the case---the RMSE obtained is similar to the one for the CART model. \begin{figure}[ht!] <>= tgp.trees(fit2, "map") @ <>= graphics.off() @ \centering \includegraphics[trim=0 100 0 25]{tgp2-cat-fbtlm-mapt} \caption{Diagrammatic depiction of the maximum {\em a' posteriori} (MAP) tree for the boolean indicator version of the Friedman data in Eq.~(\ref{eq:f1b}) using a Bayesian treed linear model.} \label{f:fb:btlm:trees} \end{figure} Figure \ref{f:fb:btlm:trees} shows that the tree does indeed partition, but not on the indicator variables. When a linear model is used at the leaves of the tree the boolean indicators cannot be partitioned upon because doing so would cause the design matrix to become rank--deficient at the leaves of the tree (there would be a column of all zeros or all ones). A treed GP would have the same problem. A new feature in {\tt tgp} makes dealing with indicators such as these more natural, by including them as candidates for treed partitioning, but ignoring them when it comes to fitting the models at the leaves of the tree. The argument {\tt basemax} to {\tt tgp.default.params}, and thus the ellipses ({\tt ...}) argument to the {\tt b*} functions, allows for the specification of the last columns of {\tt X} to be considered under the base (LM or GP) model. In the context of our example, specifying {\tt basemax = 10} ensures that only the first 10 inputs, i.e., $\mb{X}$ only (excluding $I$), are used to predict the response under the GPs at the leaves. Both the columns of $\mb{X}$ and the columns of the boolean representation of the (categorical) indicators $I$ are (still) candidates for partitioning. This way, whenever the boolean indicators are partitioned upon, the design matrix (for the GP or LM) will not contain the corresponding column of zeros or ones, and therefore will be of full rank. Let us revisit the treed LM model with {\tt basemax = 10}. <<>>= fit3 <- btlm(X=X, Z=Z, XX=XX, basemax=10, verb=0) rmse3 <- sqrt(mean((fit3$ZZ.mean - ZZ)^2)) rmse3 @ \begin{figure}[ht!] <>= tgp.trees(fit3, "map") @ <>= graphics.off() @ \centering \includegraphics[trim=0 90 0 25,scale=0.75]{tgp2-cat-fbtlm-mapt} \caption{Diagrammatic depiction of the maximum {\em a' posteriori} (MAP) tree for the boolean indicator version of the Friedman data in Eq.~(\ref{eq:f1b}) using a Bayesian treed linear model with the setting {\tt basemax = 10}.} \label{f:fb:btlm:mapt} \end{figure} Figure \ref{f:fb:btlm:mapt} shows that the MAP tree does indeed partition on the indicators in an appropriate way---as well as on some other real--valued inputs---and the result is the lower RMSE we would expect. A more high--powered approach would clearly be to treat all inputs as real--valued by fitting a GP at the leaves of the tree. Binary partitions are allowed on all inputs, $\mb{X}$ and $I$, but treating the boolean indicators as real--valued in the GP is clearly inappropriate since it is known that the process does not vary smoothly over the $0$ and $1$ settings of the three boolean indicators representing the categorical input $I$. <<>>= fit4 <- btgpllm(X=X, Z=Z, XX=XX, verb=0) rmse4 <- sqrt(mean((fit4$ZZ.mean - ZZ)^2)) rmse4 @ Since the design matrices would become rank--deficient if the boolean indicators are partitioned upon, there was no partitioning in this example. <<>>= fit4$gpcs @ Since there are large covariance matrices to invert, the MCMC inference is {\em very} slow. Still, the resulting fit (obtained with much patience) is better that the Bayesian CART and treed LM (with {\tt basemax = 10}) ones, as indicated by the RMSE. We would expect to get the best of both worlds if the setting {\tt basemax = 10} were used when fitting the treed GP model, thus allowing partitioning on the indicators by guarding against rank deficient design matrices. <<>>= fit5 <- btgpllm(X=X, Z=Z, XX=XX, basemax=10, verb=0) rmse5 <- sqrt(mean((fit5$ZZ.mean - ZZ)^2)) rmse5 @ And indeed this is the case. The benefits go beyond producing full rank design matrices at the leaves of the tree. Loosely speaking, removing the boolean indicators from the GP part of the treed GP gives a more parsimonious model, without sacrificing any flexibility. The tree is able to capture all of the dependence in the response as a function of the indicator input, and the GP is the appropriate non--linear model for accounting for the remaining relationship between the real--valued inputs and outputs. \begin{figure}[ht!] <>= h <- fit1$post$height[which.max(fit1$posts$lpost)] tgp.trees(fit5, "map") @ <>= graphics.off() @ \centering \includegraphics[trim=0 100 0 25]{tgp2-cat-fb-mapt} \caption{Diagrammatic depiction of the maximum {\em a' posteriori} (MAP) tree for the boolean indicator version of the Friedman data in Eq.~(\ref{eq:f1b}) using {\tt basemax=10}.} \label{f:fb:mapt} \end{figure} We can look at the maximum {\em a' posteriori} (MAP) tree, to see that only (and all of) the indicators were partitioned upon in Figure \ref{f:fb:mapt}. Further advantages to this approach include speed (a partitioned model gives smaller covariance matrices to invert) and improved mixing in the Markov chain when a separable covariance function is used. Note that using a non--separable covariance function in the presence of indicators would result in a poor fit. Good range ($d$) settings for the indicators would not necessarily coincide with good range settings for the real--valued inputs. A complimentary setting, {\tt splitmin}, allows the user to specify the first column of the inputs {\tt X} upon which treed partitioning is allowed. From Section 3.5 of the first {\tt tgp} vignette \cite{gramacy:2007}, it was concluded that the original formulation of Friedman data was stationary, and thus treed partitioning is not required to obtain a good fit. The same would be true of the response in (\ref{eq:f1b}) after conditioning on the indicators. Therefore, the most parsimonious model would use {\tt splitmin = 11}, in addition to {\tt basemax = 10}, so that only $\mb{X}$ are under the GP, and only $I$ under the tree. Fewer viable candidate inputs for treed partitioning should yield improved mixing in the Markov chain, and thus lower RMSE. <<>>= fit6 <- btgpllm(X=X, Z=Z, XX=XX, basemax=10, splitmin=11, verb=0) rmse6 <- sqrt(mean((fit6$ZZ.mean - ZZ)^2)) rmse6 @ Needless to say, it is important that the input {\tt X} have columns which are ordered appropriately before the {\tt basemax} and {\tt splitmin} arguments can be properly applied. Future versions of {\tt tgp} will have a formula--based interface to handle categorical ({\tt factors}) and other inputs more like other {\sf R} regression routines, e.g., {\tt lm} and {\tt glm}. The tree and binary encodings represent a particularly thrifty way to handle categorical inputs in a GP regression framework, however it is by no means the only or best approach to doing so. A disadvantage to the binary coding is that it causes the introduction of several new variables for each categorical input. Although they only enter the tree part of the model, and not the GP (where the introduction of many new variables could cause serious problems), this may still be prohibitive if the number of categories is large. Another approach that may be worth considering in this case involves designing a GP correlation function which can explicitly handle a mixture of qualitative (categorical) and quantitative (real-valued) factors \cite{qian:wu:wu:2009}. An advantage of our treed approach is that it is straightforward to inspect the effect of the categorical inputs by, e.g., counting the number of trees (in the posterior) which contain a particular binary encoding. It is also easy to see how the categorical inputs interact with the real-valued ones by inspecting the (posterior) parameterizations of the correlation parameters in each partition on a binary encoding. Both of these are naturally facilitated by gathering traces ({\tt trace = TRUE}), as described in the 1.x vignette \cite{gramacy:2007}. In Section \ref{sec:sens} we discuss a third way of determining the sensitivity of the response to categorical and other inputs. \section{Analysis of sensitivity to inputs} \label{sec:sens} <>= seed <- 0; set.seed(seed) @ Methods for understanding how inputs, or explanatory variables, contribute to the outputs, or response, of simple statistical models are by now classic in the literature and frequently used in practical application. For example, in linear regression one can perform $F$--tests to ascertain the relevance of a predictor, or inspect the leverage of a particular input setting, or use Cooks' distance, to name a few. Unfortunately, such convenient statistics/methods are not available for more complicated models, such as those in the {\tt tgp} family of nonparametric models. A more advanced tool is needed. Sensitivity Analysis (SA) is a resolving of the sources of output variability by apportioning elements of this variation to different sets of input variables. It is applicable in wide generality. The edited volume by Saltelli et al.~\cite{SaltChanScot2000} provides an overview of the field. Valuable recent work on smoothing methods is found in \cite{StorHelt2008,VeigWahlGamb2009}, and Storlie, et al.~\cite{StorSwilHeltSall2009}, provide a nice overview of nonparametric regression methods for inference about sensitivity. The analysis of response variability is useful in a variety of different settings. For example, when there is a large number of input variables over which an objective function is to be optimized, typically only a small subset will be influential within the confines of their uncertainty distribution. SA can be used to reduce the input space of such optimizations \cite{TaddLeeGrayGrif2009}. Other authors have used SA to assess the risk associated with dynamic factors affecting the storage of nuclear waste \cite{HommSalt1996}, and to investigate the uncertainty characteristics of a remote sensing model for the reflection of light by surface vegetation \cite{MorrKottTaddFurfGana2008}. The {\tt sens} function adds to {\tt tgp} a suite of tools for global sensitivity analysis, and enables ``out-of-the-box'' estimation of valuable sensitivity indices for any regression relationship that may be modeled by a member of the {\tt tgp} family. The type of sensitivity analysis provided by {\tt tgp} falls within the paradigm of global sensitivity analysis, wherein the variability of the response is investigated with respect to a probability distribution over the entire input space. The recent book by Saltelli et al. \cite{SaltEtAl2008} serves as a primer on this field. Global SA is inherently a problem of statistical inference, as evidenced by the interpolation and estimation required in a study of the full range of inputs. This is in contrast with the analytical nature of local SA, which involves derivative--based investigation of the stability of the response over a small region of inputs. We will ignore local SA for the remainder of this document. The sensitivity of a response $z$ to a changing input $\mb{x}$ is always considered in relation to a specified {\it uncertainty distribution}, defined by the density $u(\mb{x})$, and the appropriate marginal densities $u_i(x_i)$. What is represented by the uncertainty distribution changes depending upon the context. The canonical setup has that $z$ is the response from a complicated physics or engineering simulation model, with tuning parameters $\mb{x}$, that is used to predict physical phenomena. In this situation, $u(\mb{x})$ represents the experimentalist's uncertainty about real--world values of $\mb{x}$. In optimization problems, the uncertainty distribution can be used to express prior information from experimentalists or modelers on where to look for solutions. Finally, in the case of observational systems (such as air-quality or smog levels), $u(\mb{x})$ may be an estimate of the density governing the natural occurrence of the $\mb{x}$ factors (e.g., air-pressure, temperature, wind, and cloud cover). In this setup, SA attempts to resolve the natural variability of $z$. The most common notion of sensitivity is tied to the relationship between conditional and marginal variance for $z$. Specifically, variance--based methods decompose the variance of the objective function, with respect to the uncertainty distribution on the inputs, into variances of conditional expectations. These are a natural measure of the output association with specific sets of variables and provide a basis upon which the importance of individual inputs may be judged. The other common component of global SA is an accounting of the main effects for each input variable, $\mathbb{E}_{u_j}[z|x_j]$, which can be obtained as a by-product of the variance analysis. Our variance--based approach to SA is a version of the method of Sobol', wherein a deterministic objective function is decomposed into summands of functions on lower dimensional subsets of the input space. Consider the function decomposition $ f(x_1, \ldots ,x_d) = f_0 + \sum_{j=1}^df_j(x_j) +\sum_{1 \leq i < j \leq d} f_{ij}(x_j,x_i) + \ldots + f_{1,\ldots,d}(x_1, \ldots ,x_d). $ When the response $f$ is modeled as a stochastic process $z$ conditional on inputs $\mb{x}$, we can develop a similar decomposition into the response distributions which arise when $z$ has been marginalized over one subset of covariates and the complement of this subset is allowed to vary according to a marginalized uncertainty distribution. In particular, we can obtain the marginal conditional expectation $\mbb{E}[z|\mb{x}_J=\{x_j:j\in J\}]$ $=$ $\int_{\mathbb{R}^{d-d_J}} \mbb{E}[z|\mb{x}]u(\mb{x}) d\mb{x}_{-J}$, where $J=\{j_1, \ldots, j_{d_J}\}$ indicates a subset of input variables, $\mb{x}_{-j} =\{x_j:j\notin J\}$, and the marginal uncertainty density is given by $u_J(\mb{x}_J) = \int_{\mathbb{R}^{d-d_J}} u(\mb{x}) d\{x_i:i \notin J \}$. SA concerns the variability of $\mbb{E}[z|\mb{x}_J]$ with respect to changes in $\mb{x}_J$ according to $u_J(\mb{x}_J)$ and, if $u$ is such that the inputs are uncorrelated, the variance decomposition is available as \begin{equation} \label{eqn:var_decomp} \mr{var}(\mbb{E}[z|\mb{x}]) = \sum_{j=1}^dV_j + \sum_{1 \leq i < j \leq d} V_{ij} + \ldots + V_{1,\ldots,d}, \end{equation} where $V_j = \mr{var}(\mbb{E}[z|x_j])$, $V_{ij}=\mr{var}(\mbb{E}[z|x_i, x_j]) - V_i - V_j$, and so on. Clearly, when the inputs are correlated this identity no longer holds (although a ``less-than-or-equal-to'' inequality is always true). But it is useful to retain an intuitive interpretation of the $V_J$'s as a portion of the overall marginal variance. Our global SA will focus on the related sensitivity indices $S_J = V_J/\mr{var}(z)$ which, as can be seen in the above equation, will sum to one over all possible $J$ and are bounded to $[0,1]$. These $S_J$'s provide a natural measure of the {\it importance} of a set $J$ of inputs and serve as the basis for an elegant analysis of sensitivity. The {\tt sens} function allows for easy calculation of two very important sensitivity indices associated with each input: the 1$^{\rm st}$ order for the $j$th input variable, \begin{equation} S_j = \frac{\mr{var}\left(\mbb{E}\left[z|x_j\right]\right)}{\mr{var}(z)}, \label{eq:S} \end{equation} and the total sensitivity for input $j$, \begin{equation} T_j = \label{eq:T} \frac{\mbb{E}\left[\mr{var}\left(z|\mb{x}_{-j}\right)\right]}{\mr{var}(z)}. \end{equation} The 1$^{\rm st}$ order indices measure the portion of variability that is due to variation in the main effects for each input variable, while the total effect indices measure the portion of variability that is due to total variation in each input. From the identity $\mbb{E}\left[\mr{var}\left(z|\mb{x}_{-j}\right)\right] = \mr{var}(z) - \mr{var}\left(\mbb{E}\left[z|\mb{x}_{-j}\right]\right)$, it can be seen that $T_j$ measures the {\it residual} variability remaining after variability in all other inputs has been apportioned and that, for a deterministic response and uncorrelated input variables, $T_j = \sum_{J:j \in J} S_J$. This implies that the difference between $T_j$ and $S_j$ provides a measure of the variability in $z$ due to interaction between input $j$ and the other input variables. A large difference may lead the investigator to consider other sensitivity indices to determine where this interaction is most influential, and this is often a key aspect of the dimension--reduction that SA provides for optimization problems. \subsection{Monte Carlo integration for sensitivity indices} Due to the many integrals involved, estimation of the sensitivity indices is not straightforward. The influential paper by Oakley \& O'Hagan \cite{OaklOhag2004} describes an empirical Bayes estimation procedure for the sensitivity indices, however some variability in the indices is lost due to plug-in estimation of GP model parameters and, more worryingly, the variance ratios are only possible in the form of a ratio of expected values. Marrel, et al.~\cite{MarrIoosLaurRous2009}, provide a more complete analysis of the GP approach to this problem, but their methods remain restricted to estimation of the first order Sobol indices. Likelihood based approaches have also been proposed \cite{WelcBuckSackWynnMitcMorr1992,MorrKottTaddFurfGana2008}. The technique implemented in {\tt tgp} is, in contrast, fully Bayesian and provides a complete accounting of the uncertainty involved. Briefly, at each iteration of an MCMC chain sampling from the treed GP posterior, output is predicted over a large (carefully chosen) set of input locations. Conditional on this predicted output, the sensitivity indices can be calculated via Monte Carlo integration. By conditioning on the predicted response (and working as though it were the observed response), we obtain a posterior sample of the indices, incorporating variability from both the integral estimation and uncertainty about the function output. In particular, the {\tt sens} function includes a {\tt model} argument which allows for SA based on any of the prediction models (the {\tt b*} functions) in {\tt tgp}. Our Monte Carlo integration is based upon Saltelli's \cite{Salt2002} efficient Latin hypercube sampling (LHS) scheme for estimation of both 1$^{\rm st}$ order and total effect indices. We note that the estimation is only valid for uncorrelated inputs, such that $u(\mb{x}) = \prod_{j=1}^d u_j(x_j)$. The {\tt sens} function only allows for uncertainty distributions of this type (in fact, the marginal distributions also need to be bounded), but this is a feature of nearly every ``out-of-the-box'' approach to SA. Studies which concern correlated inputs will inevitably require modeling for this correlation, whereas most regression models (including those in {\tt tgp}) condition on the inputs and ignore the joint density for $\mb{x}$. Refer to the work of Saltelli \& Tarantola \cite{SaltTara2002} for an example of SA with correlated inputs. We now briefly describe the integration scheme. The 2nd moment is a useful intermediate quantity in variance estimation, and we define \[ D_J = \mbb{E}\left[\mbb{E}^2\left[z|\mb{x}_{J}\right]\right] = \int_{\mbb{R}^{d_J}} \mbb{E}^2\left[z| {\mb{x}_J}\right]u_J(\mb{x}_J)d(\mb{x}_J). \] Making use of an auxiliary variable, \begin{eqnarray*} D_J &=& \int_{\mbb{R}^{d_J}} \left[\int_{\mbb{R}^{d_{-J}}} \!\!\!\mbb{E}\left[ z | \mb{x}_J, \mb{x}_{-J} \right]u_{-J}(\mb{x}_{-J})d\mb{x}_{-J} \int_{\mbb{R}^{d_{-J}}} \!\!\!\mbb{E}\left[ z | \mb{x}_J, \mb{x}'_{-J} \right] u_{-J}(\mb{x}'_{-J})d\mb{x}'_{-J}\right]u_J(\mb{x}_J)\mb{x}_{J}\\ &=& \int_{\mbb{R}^{d + d_{-J}}} \!\!\mbb{E}\left[ z | \mb{x}_J, \mb{x}_{-J} \right]\mbb{E}\left[ z | \mb{x}_J, \mb{x}'_{-J} \right] u_{-J}(\mb{x}_{-J})u_{-J}(\mb{x}'_{-J})u_{J}(\mb{x}_{J})d\mb{x}d\mb{x}'_{J}. \end{eqnarray*} Thus, in the case of independent inputs, \[ D_J = \int_{\mbb{R}^{d+d_{-J}}} \mbb{E}\left[ z |\mb{x} \right]\mbb{E}\left[ z | \mb{x}_J, \mb{x}'_{-J} \right] u_{-J}(\mb{x}'_{-J})u({\bf x})d\mb{x}'_{-J}d\mb{x}. \] Note that at this point, if the inputs had been correlated, the integral would have been instead with respect to the joint density $u(\mb{x})u(\mb{x}_{-J}' | \mb{x}_J)$, leading to a more difficult integral estimation problem. Recognizing that $S_j = (D_j-\mbb{E}^2[z])/\mr{var}(z)$ and $T_j = 1- \left( \left(D_{-j} - \mbb{E}^2[z]\right)\right)/\mr{var}(z)$, we need estimates of $\mr{var}(z)$, $\mbb{E}^2[z]$, and $\{ (D_j, D_{-j}) : j=1,\ldots,d \}$ to calculate the sensitivity indices. Given a LHS $M$ proportional to $u(\mb{x})$, \begin{equation*} M = \left[ \begin{array}{c} s_{1_1} ~ \cdots ~ s_{1_d}\\ \vdots \\ s_{m_1} ~ \cdots ~ s_{m_d}\\ \end{array} \right], \end{equation*} it is possible to estimate $\widehat{\mbb{E}[z]} = \frac{1}{m} \sum_{k=1}^m\mbb{E}[z|{\bf s}_k]$ and $\widehat{\mr{var}[z]} = \frac{1}{m} \mbb{E}^T[z|M]\mbb{E}[z|M] - \widehat{\mbb{E}[z]}\widehat{\mbb{E}[z]}$, where the convenient notation $\mbb{E}[z|M]$ is taken to mean $\left[\mbb{E}[z|\mb{s}_1] \cdots \mbb{E}[z|\mb{s}_m]\right]^T$. All that remains is to estimate the $D$'s. Define a second LHS $M'$ proportional to $u$ of the same size as $M$ and say that $N_J$ is $M'$ with the $J$ columns replaced by the corresponding columns of $M$. Hence, \begin{equation*} N_j = \left[ \begin{array}{c} s'_{1_1} \cdots s_{1_j} \cdots s'_{1_d}\\ \vdots \\ s'_{m_1} \cdots s_{m_j} \cdots s'_{m_d} \end{array}\right]~~~\mr{and}~~~ N_{-j} = \left[ \begin{array}{c} s_{1_1} \cdots s'_{1_j} \cdots s_{1_d}\\ \vdots \\ s_{m_1} \cdots s'_{m_j} \cdots s_{m_d} \end{array}\right]. \end{equation*} The estimates are then $\hat D_j = \mbb{E}^T[z|M]\mbb{E}[z|N_{j}]/(m-1)$ and $\hat D_{-j}$ $=$ $\mbb{E}^T[z|M']\mbb{E}[z|N_{j}]/(m-1)$ $\approx$ $ \mbb{E}^T[z|M]\mbb{E}[z|N_{-j}]/(m-1)$. Along with the variance and expectation estimates, these can be plugged into equations for $S_j$ and $T_j$ in (\ref{eq:S}--\ref{eq:T}) to obtain $\hat S_j$ and $\hat T_j$. Note that Saltelli recommends the use of the alternative estimate $\widehat{\mbb{E}^2[z]} = \frac{1}{n-1}\mbb{E}^T[z|M]\mbb{E}[z|M']$ in calculating 1$^{\rm st}$ order indices, as this brings the index closer to zero for non-influential variables. However, it has been our experience that these biased estimates can be unstable, and so {\tt tgp} uses the standard $\widehat{\mbb{E}^2[z]} = \widehat{\mbb{E}[z]}\widehat{\mbb{E}[z]}$ throughout. As a final point, we note that identical MCMC sampling-based integration schemes can be used to estimate other Sobol indices (e.g., second order, etc) for particular combinations of inputs, but that this would require customization of the {\tt tgp} software. The set of input locations which need to be evaluated for each calculation of the indices is $\{ M, M', N_1,\ldots,N_d \}$, and if $m$ is the sample size for the Monte Carlo estimate this scheme requires $m(d+2)$ function evaluations. Hence, at each MCMC iteration of the model fitting, the $m(d+2)$ locations are drawn randomly according the LHS scheme, creating a random prediction matrix, {\tt XX}. By allowing random draws of the input locations, the Monte Carlo error of the integral estimates will be included in the posterior variability of the indices and the posterior moments will not be dependent upon any single estimation input set. Using predicted output over this input set, a single realization of the sensitivity indices is calculated through Saltelli's scheme. At the conclusion of the MCMC, we have a representative sample from the posterior for ${\bf S}$ and ${\bf T}$. The averages for these samples are unbiased estimates of the posterior mean, and the variability of the sample is representative of the complete uncertainty about model sensitivity. Since a subset of the predictive locations ($M$ and $M'$) are actually a LHS proportional to the uncertainty distribution, we can also estimate the main effects at little extra computational cost. At each MCMC iteration, a one--dimensional nonparametric regression is fit through the scatterplot of $[s_{1_j}, \ldots, s_{m_j},s'_{1_j}, \ldots, s'_{m_j}]$ vs. $[\mbb{E}[z|M],\mbb{E}[z|M']]$ for each of the $j=1,\ldots,d$ input variables. The resultant regression estimate provides a realization of $\mbb{E}[z|x_j]$ over a grid of $x_j$ values, and therefore a posterior draw of the main effect curve. Thus, at the end of the MCMC, we have not only unbiased estimates of the main effects through posterior expectation, but also a full accounting of our uncertainty about the main effect curve. This technique is not very sensitive to the method of non-parametric regression, since $2m$ will typically represent a very large sample in one--dimension. The estimation in {\tt tgp} uses a moving average with squared distance weights and a window containing the {\tt span}$*2m$ nearest points (the {\tt span} argument defaults to 0.3). \subsection{Examples} We illustrate the capabilities of the {\tt sens} function by looking at the Friedman function considered earlier in this vignette. The function that describes the responses ($Z$), observed with standard Normal noise, has mean \begin{equation} E(Z|\mb{x}) = 10 \sin(\pi x_1 x_2) + 20(x_3 - 0.5)^2 + 10x_4 + 5 x_5. \label{eq:f1} \end{equation} A sensitivity analysis can be based upon any of the available regression models (e.g., {\tt btlm}, {\tt bgp}, or {\tt btgp}); we choose to specify {\tt model=btgpllm} for this example. The size of each LHS used in the integration scheme is specified through {\tt nn.lhs}, such that this is equivalent to $m$ in the above algorithm description. Thus the number of locations used for prediction---the size of the random {\tt XX} prediction matrix---is {\tt nn.lhs*(ncol(X)+2)}. In addition, the window for moving average estimation of the main effects is {\tt span*2*nn.lhs} (independent of this, an {\tt ngrid} argument with a default setting of {\tt ngrid=100} dictates the number of grid points in each input dimension upon which main effects will be estimated). <<>>= f <- friedman.1.data(250) @ This function actually generates 10 covariates, the last five of which are completely un-influential. We'll include one of these ($x_6$) to show what the sensitivity analysis looks like for unrelated variables. <<>>= Xf <- f[, 1:6] Zf <- f$Y sf <- sens(X=Xf, Z=Zf, nn.lhs=600, model=bgpllm, verb=0) @ The progress indicators printed to the screen (for {\tt verb > 0}) are the same as would be obtained under the specified regression {\tt model}---{\tt bgpllm} in this case---so we suppress them here. All of the same options (e.g., {\tt BTE}, {\tt R}, etc.) apply, although if using the {\tt trace} capabilities one should be aware that the {\tt XX} matrix is changing throughout the MCMC. The {\tt sens} function returns a \verb!"tgp"!-class object, and all of the SA related material is included in the {\tt sens} list within this object. <<>>= names(sf$sens) @ The object provides the SA parameters ({\tt par}), the grid of locations for main effect prediction ({\tt Xgrid}), the mean and interval estimates for these main effects ({\tt ZZ.mean}, {\tt ZZ.q1}, and {\tt ZZ.q2}), and full posterior via samples of the sensitivity indices ({\tt S} and {\tt T}). The plot function for \verb!"tgp"!-class objects now provides a variety of ways to visualize the results of a sensitivity analysis. This capability is accessed by specifying {\tt layout="sens"} in the standard {\tt plot} command. By default, the mean posterior main effects are plotted next to boxplot summaries of the posterior sample for each $S_j$ and $T_j$ index, as in Figure \ref{full}. \begin{figure}[ht!] <>= plot(sf, layout="sens", legendloc="topleft") @ <>= graphics.off() @ \includegraphics[width=6.5in,trim=0 10 0 10]{tgp2-sens-full} \caption{Full sensitivity analysis results for the Friedman function.} \label{full} \end{figure} A further note on the role played by {\tt nn.lhs}: As always, the quality of the regression model estimate depends on the length of the MCMC. But now, the quality of sensitivity analysis is directly influenced by the size of the LHS used for integral approximation; as with any Monte Carlo integration scheme, the sample size (i.e., {\tt nn.lhs}) must increase with the dimensionality of the problem. In particular, it can be seen in the estimation procedure described above that the total sensitivity indices (the $T_j$'s) are not forced to be non-negative. If negative values occur it is necessary to increase {\tt nn.lhs}. In any case, the {\tt plot.tgp} function changes any of the negative values to zero for purposes of illustration. The {\tt maineff} argument can be used to plot either selected main effects (Figure \ref{mains}), \begin{figure}[ht!] <>= par(mar=c(4,2,4,2), mfrow=c(2,3)) plot(sf, layout="sens", maineff=t(1:6)) @ <>= graphics.off() @ \centering \includegraphics[width=6.6in]{tgp2-sens-mains} \caption{Friedman function main effects, with posterior 90\% intervals.} \label{mains} \end{figure} or just the sensitivity indices (Figure \ref{indices}). \begin{figure}[ht!] <>= plot(sf, layout="sens", maineff=FALSE) @ <>= graphics.off() @ \centering \includegraphics[width=6.5in,trim=0 15 0 15]{tgp2-sens-indices} \caption{Sensitivity indices for the Friedman function.} \label{indices} \end{figure} Note that the posterior intervals shown in these plots represent uncertainty about both the function response and the integration estimates; this full quantification of uncertainty is not presently available in any alternative SA procedures. These plots may be compared to what we know about the Friedman function (refer to Eq.~(\ref{eq:f1})) to evaluate the analysis. The main effects correspond to what we would expect: sine waves for $x_1$ and $x_2$, a parabola for $x_3$, and linear effects for $x_4$ and $x_5$. The sensitivity indices show $x_1$ and $x_2$ contributing roughly equivalent amounts of variation, while $x_4$ is relatively more influential than $x_5$. Full effect sensitivity indices for $x_3$, $x_4$, and $x_5$ are roughly the same as the first order indices, but (due to the interaction in the Friedman function) the sensitivity indices for the total effect of $x_1$ and $x_2$ are significantly larger than the corresponding first order indices. Finally, our SA is able to determine that $x_6$ is unrelated to the response. This analysis assumes the default uncertainty distribution, which is uniform over the range of input data. In other scenarios, it is useful to specify an informative $u(\mb{x})$. In the {\tt sens} function, properties of $u$ are defined through the {\tt rect}, {\tt shape}, and {\tt mode} arguments. To guarantee integrability of our indices, we have restricted ourselves to bounded uncertainty distributions. Hence, {\tt rect} defines these bounds. In particular, this defines the domain from which the LHSs are to be taken. We then use independent scaled beta distributions, parameterized by the {\tt shape} parameter and distribution {\tt mode}, to define an informative uncertainty distribution over this domain. As an example of sensitivity analysis under an informative uncertainty distribution, consider the {\tt airquality} data available with the base distribution of {\sf R}. This data set contains daily readings of mean ozone in parts per billion ({\it Ozone}), solar radiation ({\it Solar.R}), wind speed ({\it Wind}), and maximum temperature ({\it Temp}) for New York City, between May 1 and September 30, 1973. Suppose that we are interested in the sensitivity of air quality to natural changes in {\it Solar.R},{\it Wind}, and {\it Temp}. For convenience, we will build our uncertainty distribution while assuming independence between these inputs. Hence, for each variable, the input uncertainty distribution will be a scaled beta with {\tt shape=2}, and {\tt mode} equal to the data mean. <<>>= X <- airquality[,2:4] Z <- airquality$Ozone rect <- t(apply(X, 2, range, na.rm=TRUE)) mode <- apply(X , 2, mean, na.rm=TRUE) shape <- rep(2,3) @ LHS samples from the uncertainty distribution are shown in Figure (\ref{udraw}) \begin{figure}[ht!] <>= Udraw <- lhs(300, rect=rect, mode=mode, shape=shape) par(mfrow=c(1,3), mar=c(4,2,4,2)) for(i in 1:3){ hist(Udraw[,i], breaks=10,xlab=names(X)[i], main="",ylab="", border=grey(.9), col=8) } @ <>= graphics.off() @ \centering \includegraphics[width=6in,trim=0 0 0 30]{tgp2-sens-udraw} \caption{A sample from the marginal uncertainty distribution for the airquality data.} \label{udraw} \end{figure} Due to missing data (discarded in the current version of {\tt tgp}), we suppress warnings for the sensitivity analysis. We shall use the default {\tt model=btgp}. <<>>= s.air <- suppressWarnings(sens(X=X, Z=Z, nn.lhs=300, rect=rect, shape=shape, mode=mode, verb=0)) @ Figure (\ref{air1}) shows the results from this analysis. \begin{figure}[ht!] <>= plot(s.air, layout="sens") @ <>= graphics.off() @ \centering \includegraphics[width=6.5in,trim=0 15 0 15]{tgp2-sens-air1} \caption{Sensitivity of NYC airquality to natural variation in wind, sun, and temperature.} \label{air1} \end{figure} Through use of {\tt predict.tgp}, it is possible to quickly re-analyze with respect to a new uncertainty distribution without running new MCMC. We can, for example, look at sensitivity for air quality on only low--wind days. We thus alter the uncertainty distribution (assuming that things remain the same for the other variables) <<>>= rect[2,] <- c(0,5) mode[2] <- 2 shape[2] <- 2 @ and build a set of parameters {\tt sens.p} with the {\tt sens} function by setting {\tt model=NULL}. <<>>= sens.p <- suppressWarnings(sens(X=X,Z=Z,nn.lhs=300, model=NULL, rect=rect, shape=shape, mode=mode)) @ \begin{figure}[ht!] <>= s.air2 <- predict(s.air, BTE=c(1,1000,1), sens.p=sens.p, verb=0) plot(s.air2, layout="sens") @ <>= graphics.off() @ \includegraphics[width=6.5in,trim=0 15 0 15]{tgp2-sens-air2} \caption{Air quality sensitivity on low-wind days.} \label{air2} \end{figure} Figures (\ref{air1}) and (\ref{air2}) both show total effect indices which are much larger than the respective first order sensitivities. As one would expect, the effect on airquality is manifest largely through an interaction between variables. Finally, it is also possible to perform SA with binary covariates, included in the regression model as described in Section 1. In this case, the uncertainty distribution is naturally characterized by a Bernoulli density. Setting {\tt shape[i]=0} informs {\tt sens} that the relevant variable is binary (perhaps encoding a categorical input as in Section \ref{sec:cat}), and that the Bernoulli uncertainty distribution should be used. In this case, the {\tt mode[i]} parameter dictates the probability parameter for the Bernoulli, and we must have {\tt rect[i,] = c(0,1)}. As an example, we re-analyze the original air quality data with temperature included as an indicator variable (set to one if temperature > 79, the median, and zero otherwise). <<>>= X$Temp[X$Temp >70] <- 1 X$Temp[X$Temp >1] <- 0 rect <- t(apply(X, 2, range, na.rm=TRUE)) mode <- apply(X , 2, mean, na.rm=TRUE) shape <- c(2,2,0) s.air <- suppressWarnings(sens(X=X, Z=Z, nn.lhs=300, rect=rect, shape=shape, mode=mode, verb=0, basemax=2)) @ \begin{figure}[ht!] <>= plot(s.air, layout="sens") @ <>= graphics.off() @ \centering \includegraphics[width=6.5in,trim=0 15 0 15]{tgp2-sens-air3} \caption{Sensitivity of NYC airquality to natural variation in wind, sun, and a binary temperature variable (for a threshold of 79 degrees).} \label{air3} \end{figure} Figure (\ref{air3}) shows the results from this analysis. \section{Statistical search for optimization} \label{sec:optim} <>= seed <- 0; set.seed(seed) @ There has been considerable recent interest in the use of statistically generated search patterns (i.e., locations of relatively likely optima) for optimization. A popular approach is to estimate a statistical (surrogate) model, and use it to design a set of well-chosen candidates for further evaluation by a direct optimization routine. Such statistically designed search patterns can be used either to direct the optimization completely (e.g., \cite{JoneSchoWelc1998} or \cite{RommShoe2007}) or to work in hybrid with local pattern search optimization (as in \cite{TaddLeeGrayGrif2009}). An bonus feature of the statistical surrogate approach is that it may be used to tackle problems of optimization under uncertainty, wherein the function being optimized is observed with noise. In this case the search is for input configurations which optimize the response with high probability. Direct-search methods would not apply in this scenario without modification. However, a sensible hybrid could involve inverting the relationship between the two approaches so that direct-search is used on deterministic predictive surfaces from the statistical surrogate model. This search can be used to find promising candidates to compliment space-filling ones at which some statistical improvement criterion is evaluated. Towards situating {\tt tgp} as a promising statistical surrogate model for optimization (in both contexts) the approach developed by Taddy, et al.~\cite{TaddLeeGrayGrif2009}, has been implemented to produce a list of input locations that is ordered by a measure of the potential for new optima. The procedure uses samples from the posterior predictive distribution of treed GP regression models to estimate improvement statistics and build an ordered list of search locations which maximize expected improvement. The single location improvement is defined $I(\mb{x}) = \mathrm{max}\{f_{min}-f(\mb{x}),0\}$, where $f_{min}$ is the minimum evaluated response in the search (refer to \cite{SchoWelcJone1998} for extensive discussion on general improvement statistics and initial vignette~\cite{gramacy:2007} for details of a base implementation in {\tt tgp}). Thus, a high improvement corresponds to an input location that is expected to be much lower than the current minimum. The criterion is easily changed to a search for maximum values through negation of the response. The improvement is always non-negative, as points which do not turn out to be new minimum points still provide valuable information about the output surface. Thus, in the expectation, candidate locations will be rewarded for high response uncertainty (indicating a poorly explored region of the input space), as well as for low mean predicted response. Our {\tt tgp} generated search pattern will consist of $m$ locations that recursively maximize (over a discrete candidate set) a sequential version of the expected multi-location improvement developed by Schonlau, et al.~\cite{SchoWelcJone1998}, defined as $\mbb{E}\left[I^g(\mb{x}_1, \ldots, \mb{x}_m)\right]$ where \begin{equation} \label{eqn:imult} I^g(\mb{x}_1, \ldots, \mb{x}_m) = \left(\mathrm{max}\{(f_{min}-f(\mb{x}_1)), \ldots, (f_{min}-f(\mb{x}_m)), 0 \}\right)^g. \end{equation} Increasing $g \in \{0,1,2,3,\ldots\}$ increases the global scope of the criteria by rewarding in the expectation extra variability at $\mb{x}$. For example, $g=0$ leads to $\mbb{E}[I^0(\mb{x})] = \Pr(I(\mb{x})>0)$ (assuming the convention $0^0=0$), $g=1$ yields the standard statistic, and $g=2$ explicitly rewards the improvement variance since $\mbb{E}[I^2(\mb{x})] = \mr{var}[I(\mb{x})] + \mbb{E}[I(\mb{x})]^2$. For further discussion on the role of $g$, see \cite{SchoWelcJone1998} . Finding the maximum expectation of (\ref{eqn:imult}) is practically impossible for the full posterior distribution of $I^g(\mb{x}_1, \ldots, \mb{x}_m)$, and would require conditioning on a single fit for the model parameters (for example, static imputation of predictive GP means can be used to recursively build the improvement set \cite{GinsLe-RCarr2009}). However, {\tt tgp} just seeks to maximize over a discrete list of predictive locations. In fact, the default is to return an ordering for the entire {\tt XX} matrix, thus defining a ranking of predictive locations by order of decreasing expected improvement. There is no restriction on the form for {\tt XX}.\footnote{A full optimization routine would require that the search pattern is placed within an algorithm iterating towards convergence, as in \cite{TaddLeeGrayGrif2009}. However, we concentrate here on the statistical problem of choosing the next samples optimally. We shall touch on issues of convergence in Section \ref{sec:optimskel} where we describe a skeleton scheme for optimization extending {\sf R}'s internal {\tt optim} functionality.} The structure of this scheme will dictate the form for {\tt XX}. If it is the case that we seek simply to explore the input space and map a list of potential locations for improvement, using LHS to choose {\tt XX} will suffice. The discretization of decision space allows for a fast iterative solution to the optimization of $\mbb{E}\left[I^g(\mb{x}_1, \ldots, \mb{x}_m)\right]$. This begins with evaluation of the simple improvement $I^g(\tilde{\mb{x}}_i)$ over $\tilde{\mb{x}}_i \in {\bf \tilde X}$ at each of $T=$ {\tt BTE[2]-BTE[1]} MCMC iterations (each corresponding to a single posterior realization of {\tt tgp} parameters and predicted response after burn-in) to obtain the posterior sample \begin{equation*} \mathcal{I} = \left\{ \begin{array}{rcl} I^g( \tilde{\mb{x}}_1)_1& \ldots& I^g(\tilde{\mb{x}}_m)_1\\ &\vdots& \\ I^g( \tilde{\mb{x}}_1)_T& \ldots& I^g(\tilde{\mb{x}}_m)_T \end{array}\right\}. \end{equation*} Recall that in {\tt tgp} parlance, and as input to the {\tt b*} functions: $\tilde{\mb{X}}\equiv $ {\tt XX}. We then proceed iteratively to build an {\it ordered} collection of $m$ locations according to an iteratively refined improvement: Designate $\mb{x}_1 = \mathrm{argmax}_{\tilde{\mb{x}} \in {\bf \tilde X}} \mbb{E}\left[I^g( \tilde{\mb{x}})\right]$, and for $j=2,\ldots,m$, given that $\mb{x}_1, \ldots, \mb{x}_{j-1}$ are already included in the collection, the next member is \begin{eqnarray*} \mb{x}_j &=& \mathrm{argmax}_{\tilde{\mb{x}} \in {\bf \tilde X}} \mbb{E}\left[ \mathrm{max}\{I^g( \mb{x}_1, \ldots, \mb{x}_{j-1}), I^g(\tilde{\mb{x}}) \} \right]\\ &=& \mathrm{argmax}_{\tilde{\mb{x}} \in {\bf \tilde X}} \mbb{E}[\left(\mathrm{max}\{(f_{min}-f(\mb{x}_1)), \ldots, (f_{min}-f(\mb{x}_{j-1})), (f_{min}-f(\tilde{\mb{x}})), 0\}\right)^g ] \\ &=& \mathrm{argmax}_{\tilde{\mb{x}} \in {\bf \tilde X}} \mbb{E}\left[I^g(\mb{x}_1, \ldots, \mb{x}_{j-1},\tilde{\mb{x}})\right]. \end{eqnarray*} Thus, after each $j^{\rm th}$ additional point is added to the set, we have the maximum expected $j$--location improvement conditional on the first $j-1$ locations. This is not necessarily the unconditionally maximal expected $j$--location improvement; instead, point $\mb{x}_j$ is the location which will cause the greatest increase in expected improvement over the given $(j-1)$--location expected improvement. The posterior sample $\mathcal{I}$ acts as a discrete approximation to the true posterior distribution for improvement at locations within the candidate set {\tt XX}. Based upon this approximation, iterative selection of the point set is possible without any re-fitting of the {\tt tgp} model. Conditional on the inclusion of $\tilde{\mb{x}}_{i_1},\ldots,\tilde{\mb{x}}_{i_{l-1}}$ in the collection, a posterior sample of the $l$--location improvement statistics is calculated as \begin{equation*} \mathcal{I}_l = \left\{ \begin{array}{rcl} I^g( \tilde{\mb{x}}_{i_1},\ldots,\tilde{\mb{x}}_{i_{l-1}}, \tilde{\mb{x}}_1)_1 & \ldots& I^g( \tilde{\mb{x}}_{i_1},\ldots,\tilde{\mb{x}}_{i_{l-1}}, \tilde{\mb{x}}_m)_1\\ &\vdots& \\ I^g(\tilde{\mb{x}}_{i_1},\ldots,\tilde{\mb{x}}_{i_{l-1}}, {\tilde x}_1)_T& \ldots& I^g(\tilde{\mb{x}}_{i_1},\ldots,\tilde{\mb{x}}_{i_{l-1}},\tilde{\mb{x}}_m)_T \end{array}\right\}, \end{equation*} where the element in the $t^{\rm th}$ row and $j^{\rm th}$ column of this matrix is calculated as max$\{I^g(\tilde{\mb{x}}_{i_1}$, $\ldots,$ $\tilde{\mb{x}}_{i_{l-1}})_t$, $I^g(\tilde{\mb{x}}_j)_t\}$ and the $l^{\rm th}$ location included in the collection corresponds to the column of this matrix with maximum average. Since the multi-location improvement is always at least as high as the improvement at any subset of those locations, the same points will not be chosen twice for inclusion. In practice, very few iterations (about 10\% of the total candidate size under the default inference and regression model(s)) through this ordering process can be performed before the iteratively updated improvement statistics become essentially zero. Increasing the number of MCMC iterations ({\tt BTE[2]-BTE[1]}) can mitigate this to a large extent.\footnote{Once a zero (maximal) iterative improvement is attained the rest of the ranking is essentially arbitrary, at which point {\tt tgp} cuts off the process prematurely.} We refer the reader to \cite{TaddLeeGrayGrif2009} for further details on this approach to multi-location improvement search. \subsection{A simple example} We shall use the Rosenbrock function to illustrate the production of an ordered collection of (possible) adaptive samples to maximize the expected improvement within {\tt tgp}. Specifically, the two dimensional Rosenbrock function is defined as <<>>= rosenbrock <- function(x){ x <- matrix(x, ncol=2) 100*(x[,1]^2 - x[,2])^2 + (x[,1] - 1)^2 } @ and we shall bound the search space for adaptive samples to the rectangle: $-1\le x_i \le 5$ for $i=1,2$. The single global minimum of the Rosenbrock function is at $(1,1)$. <<>>= rosenbrock(c(1,1)) @ This function involves a long steep valley with a gradually sloping floor, and is considered to be a difficult problem for local optimization routines. We begin by drawing an LHS of 40 input locations within the bounding rectangle, and evaluating the function at these locations. <<>>= rect <- cbind(c(-1,-1),c(5,5)) X <- lhs(40, rect) Z <- rosenbrock(X) @ We will fit a {\tt bgp} model to this data to predict the Rosenbrock response at unobserved (candidate) input locations in {\tt XX}. The {\tt improv} argument may be used to obtain an ordered list of places where we should be looking for new minima. In particular, specifying {\tt improv=c(1,10)} will return the 10 locations which maximize the iterative multi-location expected improvement function, with $g=1$ (i.e., Eq.~(\ref{eqn:imult})). Note that {\tt improv=TRUE} is also possible, in which case {\tt g} defaults to one and the entire list of locations is ranked. Our candidate set is just a space filling LHS design. In other situations, it may be useful to build an informative LHS design (i.e., to specify {\tt shape} and {\tt mode} arguments for the {\tt lhs} function) to reflect what is already known about the location of optima. <<>>= XX <- lhs(200, rect) rfit <- bgp(X,Z,XX,improv=c(1,10), verb=0) @ Upon return, the \verb!"tgp"!-class object {\tt rfit} includes the matrix {\tt improv}, which is a list of the expected single location improvement for the 200 {\tt XX} locations, and the top 10 ranks. Note that the {\tt rank}s for those points which are not included in the top 10 are set to {\tt nrow(XX)=}\Sexpr{nrow(XX)}. Here are the top 10: <<>>= cbind(rfit$improv,XX)[rfit$improv$rank <= 10,] @ This iterative algorithm may produce ranks that differ significantly from a straightforward ordering of expected improvement. This leads to a list that better explores the input space, since the expected improvement is naturally balanced against a desire to search the domain. We plot the results with the usual function, by setting {\tt as="improv"}, in Figure \ref{optim-fit1}. \begin{figure}[htb!] <>= plot(rfit, as="improv") @ <>= graphics.off() @ \centering \includegraphics[width=6.5in,trim=0 25 0 25]{tgp2-optim-fit1} \caption{The {\em left} panel shows the mean predicted Rosenbrock function response, and on the {\em right} we have expected single location improvement with the top 10 points (labelled by rank) plotted on top.} \label{optim-fit1} \end{figure} The banana--shaped region of higher expected improvement corresponds to the true valley floor for the Rosenbrock function, indicating the that {\tt bgp} model is doing a good job of prediction. Also, we note that the ordered input points are well dispersed throughout the valley---a very desirable property for adaptive sampling candidates. It is straightforward, with {\tt predict.tgp}, to obtain a new ordering for the more global {\tt g=5} (or any new {\tt g}). Figure \ref{optim-fit2} shows a more diffuse expected improvement surface and a substantially different point ordering. In practice, we have found that {\tt g=2} provides a good compromise between local and global search. \begin{figure}[htb!] <>= rfit2 <- predict(rfit, XX=XX, BTE=c(1,1000,1), improv=c(5,20), verb=0) plot(rfit2, layout="as", as="improv") @ <>= graphics.off() @ \centering \includegraphics[width=3.25in,trim=0 25 0 25]{tgp2-optim-fit2} \caption{The expected improvement surface and top 20 ordered locations, for {\tt g=5}.} \label{optim-fit2} \end{figure} \subsection{A skeleton optimization scheme} \label{sec:optimskel} %% The nature of global optimization demands that a fine balance be %% struck between global and local search. Therefore, designing a %% one--size--fits--all approach would be a daunting task. For one %% thing, assessing convergence in any formal sense would be quite %% difficult, although in practice it would be straightforward to %% ``force'' convergence by (eventually) focusing the method on finding a %% local solution. In the case where the function evaluations are %% deterministic, final convergence to a the local solution is always %% possible through the use of {\tt R}'s {\tt optim} function, for %% example. A method using {\tt tgp} based on a similar, but more %% formalized approach, using a direct/pattern search (in place of {\tt %% optim}) has been recently demonstrated in the context of %% sequentially designing computer experiments to solve an optimization %% problem \cite{TaddLeeGrayGrif2009}. Generally speaking, the result is %% a sensible compromise between local and global search. When the %% function evaluations are noisy one can always create a deterministic %% approximation, i.e., via the MAP predictive distribution (i.e., a %% kriging surrogate), for use with {\tt optim} in order to obtain %% convergence to a local optima. %% %% It may be possible to base assessments of convergence on the %% improvement statistic, which would naturally tend to zero as more %% points are added into the design. But any such assessments would hinge %% upon being able to drive the (Monte Carlo) method used to infer the %% model parameters---on which the improvement statistic is based---to a %% fixed point. In the context of MCMC this is only guaranteed as the %% number of samples gathered tends to infinity. Even if obtaining %% asymptotic convergence in this way is clearly a pipe dream, the %% practical application of this idea, and those based on local %% optimization mentioned above, can still bear fruit. Insight into %% convergence in practice is still a very tangible concept. Moreover, %% for many applications the considerations of convergence may even take %% a back seat to other budgetary constraints where the efficient %% allocation of an available resource (say computer cycles) is more %% important than a bottom--line based upon convergence which may only be %% achieved at all costs in the best of scenarios. The capabilities outlined above are useful in their own right, as a search list or candidate set ranked by expected improvement gain provides concrete information about potential optima. However, a full optimization framework requires that the production of these sets of search locations are nested within an iterative search scheme. The approach taken by Taddy, et al.~\cite{TaddLeeGrayGrif2009}, achieves this by taking the {\tt tgp} generated sets of locations and using them to augment a local optimization search algorithm. In this way, the authors are able to achieve robust solutions which balance the convergence properties of the local methods with the global scope provided by {\tt tgp}. Indeed, any optimization routine capable of evaluating points provided by an outside source could benefit from a {\tt tgp} generated list of search locations. In the absence of this sort of formal hybrid search algorithm, it is still possible to devise robust optimization algorithms based around {\tt tgp}. A basic algorithm is as follows: first, use a LHS to explore the input space (see the {\tt lhs} function included in {\tt tgp}). Repeatedly fit one of the {\tt b*} models with {\tt improv!=FALSE} to the evaluated iterates to produce a search set, then evaluate the objective function over this search set, as described earlier. Then evaluate the objective function over the highest ranked locations in the search set. Continue until you are confident that the search has narrowed to a neighborhood around the true optimum (a good indicator of this is when all of the top-ranked points are in the same area). At this point, the optimization may be completed by {\tt optim}, {\sf R}'s general purpose local optimization algorithm in order to guarentee convergence. The {\tt optim} routine may be initialized to the best input location (i.e. corresponding the most optimal function evaluation) found thus far by {\tt tgp}. Note that this approach is actually an extreme version of a template proposed by Taddy, et al.~\cite{TaddLeeGrayGrif2009}, where the influence of global (i.e. {\tt tgp}) search is downweighted over time rather than cut off. In either case, a drawback to such approaches is that they do not apply when the function being optimized is deterministic. An alternative scheme is to employ both {\tt tgp} search and a local optimization at each iteration. The idea is that a mix of local and global information is provided throughout the entire optimization, but with an added twist. Rather than apply {\tt optim} on the stochastic function directly, which would not converge due to the noise, it can be applied on a deterministic (MAP) kriging surface provided by {\tt tgp}. The local optima obtained can be used to augment the candidate set of locations where the improvement statistic is gathered---which would otherwise be simple LHS. That way the search pattern produced on output is likely to have a candidate with high improvement. To fix ideas, and for the sake of demonstration, the {\tt tgp} package includes a skeleton function for performing a single iteration in the derivative--free optimization of noisy black--box functions. The function is called {\tt optim.step.tgp}, and the name is intended to emphasize that it performs a single step in an optimization by trading off local {\tt optim}--based search of {\tt tgp} predictive (kriging surrogate) surfaces, with the expected posterior improvement. In other words, it is loosely based on some the techniques alluded to above, but is designed to be augmented/adjusted as needed. Given $N$ pairs of inputs and responses $(\mb{X}, \mb{Z})$, {\tt optim.step.tgp} suggests new points at which the function being optimized should be evaluated. It also returns information that can be used to assess convergence. An outline follows. The {\tt optim.step.tgp} function begins by constructing a set of candidate locations, either as a space filling LHS over the input space (the default) or from a treed $D$--optimal design, based on a previously obtained \verb!"tgp"!-class model. {\sf R}'s {\tt optim} command is used on the MAP predictive surface contained within the object to obtain an estimate of the current best guess $\mb{x}$-location of the optimal solution. A standalone subroutine called {\tt optim.ptgpf} is provided for this specific task, to be used within {\tt optim.step.tgp} or otherwise. Within {\tt optim.step.tgp}, {\tt optim.ptgpf} is initialized with the data location currently predicted to be the best guess of the minimum. The optimal $x$-location found is then added into the set of candidates as it is likely that the expected improvement would be high there. Then, a new \verb!"tgp"!-class object is obtained by applying a {\tt b*} function to $(\mb{X}, \mb{Z})$ whilst sampling from the posterior distribution of the improvement statistic. The best one, two, or several locations with highest improvement ranks are suggested for addition into the design. The values of the maximum improvement statistic are also returned in order to track progress in future iterations. The \verb!"tgp"!-class object returned is used to construct candidates and initialize the {\tt optim.ptgpf} function in future rounds. To illustrate, consider the 2-d exponential data from the initial vignette \cite{gramacy:2007} as our noisy function $f$. <<>>= f <- function(x) { exp2d.Z(x)$Z } @ Recall that this data is characterized by a mean value of \[ f(\mb{x}) = x_1 \exp(-x_1^2 - x_2^2) \] which is observed with a small amount of Gaussian noise (with sd $=0.001$). Elementary calculus gives that the minimum of $f$ is obtained at $\mb{x} = (-\sqrt{1/2},0)$. The {\tt optim.step.tgp} function requires that the search domain be defined by a bounding rectangle, and we require an initial design to start things off. Here we shall use $[-2,6]^2$ with an LHS design therein. <<>>= rect <- rbind(c(-2,6), c(-2,6)) X <- lhs(20, rect) Z <- f(X) @ The following code proceeds with several rounds of sequential design towards finding the minimum of {\tt f}. <>= out <- progress <- NULL for(i in 1:20) { ## get recommendations for the next point to sample out <- optim.step.tgp(f, X=X, Z=Z, rect=rect, prev=out, verb=0) ## add in the inputs, and newly sampled outputs X <- rbind(X, out$X) Z <- c(Z, f(out$X)) ## keep track of progress and best optimum progress <- rbind(progress, out$progress) } @ The {\tt progress} can be tracked through the rows of a {\tt data.frame}, as constructed above, containing a listing of the input location of the current best guess of the minimum for each round, together with the value of the objective at that point, as well as the maximum of the improvement statistic. \begin{figure}[ht!] \centering <>= par(mfrow=c(1,2)) matplot(progress[,1:2], main="x progress", xlab="rounds", ylab="x[,1:2]", type="l", lwd=2) legend("topright", c("x1", "x2"), lwd=2, col=1:2, lty=1:2) plot(log(progress$improv), type="l", main="max log improv", xlab="rounds", ylab="max log(improv)") @ <>= graphics.off() @ \includegraphics[trim=40 20 0 0]{tgp2-optim-progress} %\vspace{-0.5cm} \caption{Progress in iterations of {\tt optim.step.tgp} shown by tracking the $\mb{x}$--locations of the best guess of the minimum ({\em left}) and the logarithm of the maximum of the improvement statistics at the candidate locations ({\em right})} \label{f:optim:progress} \end{figure} In addition to printing this data to the screen, plots such as the ones in Figure \ref{f:optim:progress} can be valuable for assessing convergence. As can be seen in the figure, the final iteration gives an $\mb{x}$-value that is very close to the correct result, and is (in some loose sense) close to convergence. <<>>= out$progress[1:2] @ As mentioned above, if it is known that the function evaluations are deterministic then, at any time, {\sf R}'s {\tt optim} routine can be invoked---perhaps initialized by the $\bm{x}$-location in \verb!out$progress!---and convergence to a local optimum thus guaranteed. Otherwise, the quantities in \verb!out$progress! will converge, in some sense, as long as the number of MCMC rounds used in each round, above, ($T=$ {\tt BTE[2]-BTE[1]}) tends to infinity. Such arguments to the {\tt b*} functions can be set via the ellipses ({\tt ...}) arguments to {\tt optim.step.tgp}.\footnote{This runs contrary to how the ellipses are used by {\tt optim} in order to specify static arguments to {\tt f}. If setting static arguments to {\tt f} is required within {\tt optim.step.tgp}, then they must be set in advance by adjusting the default arguments via {\tt formals}.} A heuristic stopping criterion can be based on the maximum improvement statistic obtained in each round as long as the candidate locations become dense in the region as $T\rightarrow \infty$. This can be adjusted by increasing the {\tt NN} argument to {\tt optim.step.tgp}. The internal use of {\tt optim} within {\tt optim.step.tgp} on the posterior predictive (kriging surrogate) surface via {\tt optim.ptgpf} may proceed with any of the usual method arguments. I.e., <<>>= formals(optim)$method @ however the default ordering is switched in {\tt optim.ptgpf} and includes one extra method. <<>>= formals(optim.ptgpf)$method @ Placing \verb!"L-BFGS-B"! in the default position is sensible since this method enforces a rectangle of constraints as specified by {\tt rect}. This guarentees that the additional candidate found by {\tt optim.ptfpf} will be valid. However, the other {\tt optim} methods generally work well despite that they do not enforce this constraint. The final method, \verb!"optimize"!, applies only when the inputs to {\tt f} are 1-d. In this case, the documentation for {\tt optim} suggests using the {\tt optimize} function instead. \section{Importance tempering} \label{sec:it} <>= seed <- 0; set.seed(seed) @ It is well--known that MCMC inference in Bayesian treed methods suffers from poor mixing. For example, Chipman et al.~\cite{chip:geor:mccu:1998,chip:geor:mccu:2002} recommend periodically restarting the MCMC to avoid chains becoming stuck in local modes of the posterior distribution (particularly in tree space). The treed GP models are or no exception, although it is worth remarking that using flexible GP models at the leaves of the tree typically results in shallower trees, and thus less pathalogical mixing in tree space. Version 1.x provided some crude tools to help mitigate the effects of poor mixing in tree space. For example, the {\tt R} argument to the {\tt b*} functions facilitates the restarts suggested by Chipman et al. A modern Monte Carlo technique for dealing with poor mixing in Markov chain methods is to employ {\em tempering} to flatten the peaks and raise the troughs in the posterior distribution so that movements between modes is more fluid. One such method, called {\em simulated tempering} (ST) \cite{geyer:1995}, is essentially the MCMC analogue of the popular simulated annealing algorithm for optimization. The ST algorithm helps obtain samples from a multimodal density $\pi(\theta)$ where standard methods, such as Metropolis--Hastings (MH) \cite{met:1953,hast:1970} and Gibbs Sampling (GS) \cite{geman:1984}, fail. As will be shown in our examples, ST can guard against becoming stuck in local modes of the {\tt tgp} posterior by encouraging better mixing {\em between modes} via in increase in the acceptance rate of tree modification proposals, particularly {\em prunes}. However, as we will see, ST suffers from inefficiency because it discards the lions share of the samples it collects. The discarded samples can be recycled if they are given appropriate importance sampling (IS) \cite{liu:2001} weights. These weights, if combined carefully, can be used to construct meta-estimators of expectations under the {\tt tgp} posterior that have much lower variance compared to ST alone. This combined application of ST and IT is dubbed {\em importance tempering} \cite{gra:samw:king:2009}. \subsection{Simulated Tempering and related methods} \label{sec:st} ST is an application of the MH algorithm on the product space of parameters and inverse temperatures $k\in [0,1]$. That is, ST uses MH to sample from the joint chain $\pi(\theta,k) \propto \pi(\theta)^k p(k)$. The inverse temperature is allowed to take on a discrete set of values $k \in \{k_1,\dots,k_m: k_1 = 1, \; k_i > k_{i+1} \geq 0\}$, called the {\em temperature ladder}. Typically, ST calls for sampling $(\theta,k)^{(t+1)}$ by first updating $\theta^{(t+1)}$ conditional on $k^{(t)}$ and (possibly) on $\theta^{(t)}$, using MH or GS. Then, for a proposed $k' \sim q(k^{(t)} \rightarrow k')$, usually giving equal probability to the nearest inverse temperatures greater and less than $k^{(t)}$, an acceptance ratio is calculated: \[ A^{(t+1)} = \frac{\pi(\theta^{(t+1)})^{k'} p(k') q(k' \rightarrow k^{(t)})}{\pi(\theta^{(t+1)})^{k^{(t)}} p(k^{(t)}) q(k^{(t)}\rightarrow k')}. \] Finally, $k^{(t+1)}$ is determined according to the MH accept/reject rule: set $k^{(t+1)} = k'$ with probability $\alpha^{(t+1)} = \min\{1,A^{(t+1)}\}$, or $k^{(t+1)} = k^{(t)}$ otherwise. Standard theory for MH and GS gives that samples from the marginals $\pi_{k_i}$ can be obtained by collecting samples $\theta^{(t)}$ where $k^{(t)} = k_i$. Samples from $\pi(\theta)$ are obtained when $k^{(t)} = 1$. The success of ST depends crucially on the ability of the Markov chain frequently to: (a) visit high temperatures (low $k$) where the probability of escaping local modes is increased; (b) visit $k=1$ to obtain samples from $\pi$. The algorithm can be tuned by: (i.)~adjusting the number and location of the rungs of the temperature ladder; or (ii.)~setting the pseudo-prior $p(k)$ for the inverse temperature. Geyer \& Thompson \cite{geyer:1995} give ways of adjusting the spacing of the rungs of the ladder so that the ST algorithm achieves between--temperature acceptance rates of 20--40\%. More recently, authors have preferred to rely on defaults, e.g., \begin{equation} \;\;\;\;\; k_i = \left\{ \begin{array}{cl} (1+\Delta_k)^{1-i} & \mbox{geometric spacing}\\ \{1+\Delta_k (i-1)\}^{-1} & \mbox{harmonic spacing} \end{array} \right. \;\;\;\;\ i=1,\dots,m. \label{eq:ladder} \end{equation} Motivation for such default spacings is outlined by Liu \cite{liu:2001}. Geometric spacing, or uniform spacing of $\log(k_i)$, is also advocated by Neal \cite{neal:1996,neal:2001} to encourage the Markov chain to rapidly traverse the breadth of the temperature ladder. Harmonic spacing is more often used by a related method called Metropolis coupled Markov chain Monte Carlo (MC$^3$) \cite{geyer:1991}. Both defaults are implemented in the {\tt tgp} package, through the provided {\tt default.itemps} function. A new ``sigmoidal'' option is also implemented, as discussed below. The rate parameter $\Delta_k>0$ can be problem specific. Rather than work with $\Delta_k$ the {\tt default.itemps} function allows the ladder to be specified via $m$ and the hottest temperature $k_m$, thus fixing $\Delta_k$ implicitly. I.e., for the geometric ladder $\Delta_k = (k_m)^{1/(1-m)}-1$, and for the harmonic ladder $\Delta_k = \frac{(k_m)^{-1}-1}{m-1}$. A sigmoidal ladder can provide a higher concentration of temperatures near $k=1$ without sacrificing the other nice properties of the geometric and harmonic ladders. It is specified by first situating $m$ indices $j_i\in \mathbb{R}$ so that $k_1 = k(j_1) = 1$ and $k_m = k(j_m) = k_{\mbox{\tiny m}}$ under \[ k(j_i) = 1.01 - \frac{1}{1+e^{j_i}}. \] The remaining $j_i, i=2,\dots,(m-1)$ are spaced evenly between $j_1$ and $j_m$ to fill out the ladder $k_i = k(j_i), i=1,\dots,(m-1)$. By way of comparison, consider generating the three different types of ladder with identical minimum inverse temperature $k_{\mbox{\tiny m}} = 0.1$, the default setting in {\tt tgp}. <<>>= geo <- default.itemps(type="geometric") har <- default.itemps(type="harmonic") sig <- default.itemps(type="sigmoidal") @ The plots in Figure \ref{f:itemps} show the resulting inverse temperature ladders, and their logarithms. \begin{figure}[ht!] <>= par(mfrow=c(2,1)) all <- cbind(geo$k, har$k, sig$k) matplot(all, pch=21:23, main="inv-temp ladders", xlab="indx", ylab="itemp") legend("topright", pch=21:23, c("geometric","harmonic","sigmoidal"), col=1:3) matplot(log(all), pch=21:23, main="log(inv-temp) ladders", xlab="indx", ylab="itemp") @ <>= graphics.off() @ \centering \includegraphics[height=5.9in,width=4.5in,trim=0 20 0 20]{tgp2-it-itemps} \caption{Three different inverse temperature ladders, each with $m=40$ temperatures starting at $k_1=1$ and ending at $k_m=0.1$} \label{f:itemps} \end{figure} Observe how, relative to the geometric ladder, the harmonic ladder has a higher concentration of inverse temperatures near zero, whereas the sigmoidal ladder has a higher concentration near one. Once a suitable ladder has been chosen, the {\tt tgp} package implementation of ST follows the suggestions of Geyer \& Thompson \cite{geyer:1995} in setting the pseudo--prior, starting from a uniform $p_0$. First, $p_0$ is adjusted by {\em stochastic approximation}: add $c_0/[m(t+n_0)]$ to $\log p_0(k)$ for each $k_i \ne k^{(t)}$ and subtract $c_0/(t+n_0)$ from $\log p_0(k^{(t)})$ over $t=1,\dots,B$ {\em burn--in} MCMC rounds sampling from the joint posterior of $(\theta, k)$. Then, $p_0$ is normalized to obtain $p_1$. Before subsequent runs, specified via an {\tt R >= 2} argument, {\em occupation numbers} $o(k_i) = \sum_{t=1}^B 1_{\{k^{(t)} = k_i\}}$, are used update $p(k_i) \propto p_1(k_i)/o(k_i)$. Note that, in this setting, the {\tt R} argument is used to update the pseudo--prior only, not to restart the Markov chain. \subsection{Importance sampling from tempered distributions} \label{sec:temp} ST provides us with $\{(\theta^{(t)},k^{(t)}): t = 1,\ldots,T\}$, where $\theta^{(t)}$ is an observation from $\pi_{k^{(t)}}$. It is convenient to write $\mathcal{T}_i = \{t: k^{(t)} = k_i\}$ for the index set of observations at the $i^{\mbox{\tiny th}}$ temperature, and let $T_i = |\mathcal{T}_i|$. Let the vector of observations at the $i^{\mbox{\tiny th}}$ temperature collect in $\bm{\theta}_i = (\theta_{i1},\dots,\theta_{iT_i})$, so that $\{\theta_{ij}\}_{j=1}^{T_i}\sim \pi_{k_i}$. Each vector $\bm{\theta}_i$ can be used to construct an IS estimator of $E_{\pi}\{h(\theta)\}$ by setting \[ \hat{h}_i = \frac{\sum_{j=1}^{T_i} w_i(\theta_{ij}) h(\theta_{ij})} {\sum_{j=1}^{T_i} w_i(\theta_{ij})} \equiv \frac{\sum_{j=1}^{T_i} w_{ij}h(\theta_{ij})}{W_i}, \] say. That is, rather than obtain one estimator from ST (at the cold temperature), we can obtain $m$ estimators (one at each temperature) via IS. The efficiency of each estimator, $i=1,\dots,m$ can be measured through its variance, but unfortunately this can be difficult to calculate in general. As a result, the notion of {\em effective sample size} \cite{liu:2001} (ESS) plays an important role in the study of IS estimators. Denote the vector of IS weights at the $i^{\mbox{\tiny th}}$ temperature as $\mathbf{w}_i = \mathbf{w}_i(\bm{\theta}_i) = (w_i(\theta_{i1}),\ldots,w_i(\theta_{iT_i}))$, where $w_i(\theta) = \pi(\theta)/\pi_{k_i}(\theta)$. The ESS of $\hat{h}_i$ is defined by \begin{equation} \mathrm{ESS}(\mb{w}_i) = \frac{T}{1 + \mathrm{cv^2}(\mathbf{w}_i)}, \label{eq:essw} \end{equation} where $\mathrm{cv}(\mathbf{w}_i)$ is the \emph{coefficient of variation} of the weights (in the $i^{\mbox{\tiny th}}$ temperature), given by \begin{align*} \mathrm{cv^2}(\mathbf{w}_i) &= \frac{\sum_{t=1}^T(w(\theta^{(t)}) - \bar{w})^2}{(T-1) \bar{w}^2}, &\mbox{where} && \bar{w} &= T^{-1} \sum_{t=1}^T w(\theta^{(t)}). \end{align*} In {\sf R}: <<>>= ESS <- function(w) { mw <- mean(w) cv2 <- sum((w-mw)^2)/((length(w)-1)*mw^2) ess <- length(w)/(1+cv2) return(ess) } @ This should not be confused with the concept of \emph{effective sample size due to autocorrelation} \cite{kass:1998} (due to serially correlated samples coming from a Markov chain as in MCMC) as implemented by the {\tt effectiveSize} function in the {\tt coda} package \cite{coda:R} for {\sf R}. Before attempting to combine $m$ IS estimators it is fruitful backtrack briefly to obtain some perspective on the topic of applying IS with a {\em single} tempered proposal distribution. Jennison \cite{jennison:1993} put this idea forward more than a decade ago, although the question of how to choose the best temperature was neither posed or resolved. It is clear that larger $k$ leads to lower variance estimators (and larger ESS), but at the expense of poorer mixing in the Markov chain. It can be shown that the optimal inverse temperature $k^*$ for IS, in the sense of constructing a minimum variance estimator, may be significantly lower than one \cite{gra:samw:king:2009}. However, the variance of such an estimator will indeed become unbounded as $k\rightarrow 0$, just as ESS~$\rightarrow 0$. Needless to say, the choice of how to best pick the best temperatures (for ST or IS) is still an open problem. But in the context of the family of tempered distributions used by ST for mixing considerations, this means that the discarded samples obtained when $k^{(t)} < 1$ may actually lead to more efficient estimators than the ones saved from the cold distribution. So ST is wastefull indeed. However, when combining IS estimators from the multiple temperatures used in ST, the deleterious effect of the high variance ones obtained at high temperature must be mitigated. The possible strategies involved in developing such a meta-estimator comprise the {\em importance tempering} (IT) family of methods. The idea is that small ESS will indicate high variance IS estimators which should be relegated to having only a small influence on the overall estimator. \subsection{An optimal way to combine IS estimators} \label{sec:lambdas} It is natural to consider an overall meta-estimator of $E_{\pi}\{h(\theta)\}$ defined by a convex combination: \begin{align} \label{eq:hhatlambda} \hat{h}_{\lambda} &= \sum_{i=1}^m \lambda_i \hat{h}_i,& \mbox{where} && 0 \leq \lambda_i \leq \sum_{i=1}^m \lambda_i = 1. \end{align} Unfortunately, if $\lambda_1,\dots,\lambda_m$ are not chosen carefully, $\mbox{Var}(\hat{h}_\lambda)$, can be nearly as large as the largest $\mbox{Var}(\hat{h}_i)$ \cite{owen:2000}, due to the considerations alluded to in Section \ref{sec:temp}. Notice that ST is recovered as a special case when $\lambda_1=1$ and $\lambda_2,\dots,\lambda_m = 0$. It may be tempting to choose $\lambda_i = W_i/W$, where $W = \sum_{i=1}^m W_i$. The resulting estimator is equivalent to \begin{align} \label{Eq:hath} \hat{h} &= W^{-1} \sum_{t=1}^T w(\theta^{(t)},k^{(t)})h(\theta^{(t)}), & \mbox{where} && W = \sum_{t=1}^T w(\theta^{(t)},k^{(t)}), \end{align} and $w(\theta,k) = \pi(\theta)/\pi(\theta)^k = \pi(\theta)^{1-k}$. It can lead to a very poor estimator, even compared to ST, as will be demonstrated empirically in the examples to follow shortly. Observe that we can equivalently write \begin{align} \hat{h}_{\lambda} &= \sum_{i=1}^m \sum_{j=1}^{T_i} w_{ij}^{\lambda}h(\theta_{ij}), && \mbox{where} & w_{ij}^{\lambda} &= \lambda_iw_{ij}/W_i. \label{eq:wlambda} \end{align} Let $\mathbf{w}^{\lambda} = (w_{11}^\lambda,\ldots,w_{1T_1}^\lambda,w_{21}^\lambda,\ldots,w_{2T_2}^\lambda, \ldots,w_{m1}^\lambda,\ldots,w_{mT_m}^\lambda)$. Attempting to choose $\lambda_1,\dots,\lambda_m$ to minimize $\mbox{Var}(\hat{h}_\lambda)$ directly can be difficult. Moreover, for the applications that we have in mind, it is important that our estimator can be constructed without knowledge of the normalizing constants of $\pi_{k_1},\ldots,\pi_{k_m}$, and without evaluating the MH transition kernels $\mathcal{K}_{\pi_{k_i}}(\cdot,\cdot)$. It is for this reason that methods like the \emph{balance heuristic} \cite{veach:1995}, MCV \cite{owen:2000}, or population Monte Carlo (PMC) \cite{douc:etal:2007} cannot be applied. Instead, we seek maximize the effective sample size of $\hat{h}_\lambda$ in (\ref{eq:hhatlambda}), and look for an $O(T)$ operation to determine the optimal $\lambda^*$. %\begin{thm} %\label{thm:lambdastar} Among estimators of the form~(\ref{eq:hhatlambda}), it can be shown \cite{gra:samw:king:2009} that $\mathrm{ESS}(\mathbf{w}^{\lambda})$ is maximized by $\lambda = \lambda^*$, where, for $i=1,\ldots,m$, \begin{align*} \lambda_i^* &= \frac{\ell_i}{\sum_{i=1}^m \ell_i}, & \mbox{and} && \ell_i &= \frac{W_i^2}{\sum_{j=1}^{T_i} w_{ij}^2}. \end{align*} The efficiency of each IS estimator $\hat{h}_i$ can be measured through $\mathrm{ESS}(\mathbf{w}_i)$. Intuitively, we hope that with a good choice of $\lambda$, the ESS (\ref{eq:essw}) of $\hat{h}_{\lambda}$, would be close to the sum over $i$ of the effective sample sizes each of $\hat{h}_i$. This is indeed the case for $\hat{h}_{\lambda^*}$, because it can be shown \cite{gra:samw:king:2009} that \[ \mathrm{ESS}(\mathbf{w}^{\lambda^*}) \geq \sum_{i=1}^m \mathrm{ESS}(\mathbf{w}_i) - \frac{1}{4} - \frac{1}{T}. \] In practice we have found that this bound is conservative and that in fact $\mathrm{ESS}(\mathbf{w}^{\lambda^*}) \geq \sum_{i=1}^m \mathrm{ESS}(\mathbf{w}_i)$, as will be shown empirically in the examples that follow. Thus our optimally--combined IS estimator has a highly desirable and intuitive property in terms of its effective sample size: that the whole is greater than the sum of its parts. $\mathrm{ESS}(\mathbf{w}^{\lambda^*})$ depends on $\mathrm{ESS}(\mathbf{w}_i)$ which in turn depend on the $k_i$. Smaller $k_i$ will lead to better mixing in the Markov chain, but lower $\mathrm{ESS}(\mathbf{w}_i)$. Therefore, we can expect that the geometric and sigmoidal ladders will fare better than the harmonic ones, so long as the desired improvements in mixing are achieved. In the examples to follow, we shall see that the sigmoidal ladder does indeed leader to higher $\mathrm{ESS}(\mathbf{w}^{\lambda^*})$. \subsection{Examples} \label{sec:examples} Here the IT method is shown in action for {\tt tgp} models. IT is controlled in {\tt b*} functions via the {\tt itemps} argument: a {\tt data.frame} coinciding with the output of the {\tt default.itemps} function. The {\tt lambda} argument to {\tt default.itemps} can be used to base posterior predictive inference the other IT heuristics: ST and the na\"ive approach (\ref{Eq:hath}). Whenever the argument {\tt m = 1} is used with {\tt k.min != 1} the resulting estimator is constructed via tempered importance sampling at the single inverse temperature {\tt k.min}, in the style of Jennison~\cite{jennison:1993} as outlined in Section \ref{sec:temp}. The parameters $c_0$ and $n_0$ for stochastic approximation of the pseudo--prior can be specified as a 2--vector {\tt c0n0} argument to {\tt default.itemps}. In the examples which follow we simply use the default configuration of the IT method, adjusting only the minimum inverse temperature via the {\tt k.min} argument. Before delving into more involved examples, we illustrate the stages involved in a small run of importance tempering (IT) on the exponential data from Section 3.3 of \cite{gramacy:2007}. The data can be obtained as: <<>>= exp2d.data<-exp2d.rand() X<-exp2d.data$X Z<-exp2d.data$Z @ Now, consider applying IT to the Bayesian treed LM with a small geometric ladder. A warning will be given if the default setting of \verb!bprior="bflat"! is used, as this (numerically) improper prior can lead to improper posterior inference at high temperatures. <<>>= its <- default.itemps(m=10) exp.btlm <- btlm(X=X,Z=Z, bprior="b0", R=2, itemps=its, pred.n=FALSE, BTE=c(1000,3000,2)) @ Notice how the MCMC inference procedure starts with $B+T=\Sexpr{exp.btlm$BTE[1] + exp.btlm$BTE[2]}$ rounds of stochastic approximation (initial adjustment of the pseudo--prior) in place of typical (default) the $B=\Sexpr{exp.btlm$BTE[1]}$ burn--in rounds. Then, the first round of sampling from the posterior commences, over $T=\Sexpr{exp.btlm$BTE[2]-exp.btlm$BTE[1]}$ rounds, during which the observation counts in each temperature are tallied. The progress meter shows the current temperature the chain is in, say {\tt k=0.629961}, after each of 1000 sampling rounds. The first repeat starts with a pseudo--prior that has been adjusted by the observation counts, which continue to be accumulated throughout the entire procedure (i.e., they are never reset). Any subsequent repeats begin after a similar (re-)adjustment. Before finishing, the routine summarizes the sample size and effective sample sizes in each rung of the temperature ladder. The number of samples is given by {\tt len}, and the ESS by {\tt ess}. These quantities can also be recovered via {\tt traces}, as shown later. The ESS of the optimal combined IT sample is the last quantity printed. This, along with the ESS and total numbers of samples in each temperature, can also be obtained via the {\tt tgp}-class output object. <<>>= exp.btlm$ess @ \subsubsection{Motorcycle accident data} \label{sec:moto} Recall the motorcycle accident data of Section 3.4 of the first {\tt tgp} vignette \cite{gramacy:2007}. Consider using IT to sample from the posterior distribution of the treed GP LLM model using the geometric temperature ladder. <<>>= library(MASS) moto.it <- btgpllm(X=mcycle[,1], Z=mcycle[,2], BTE=c(2000,52000,10), bprior="b0", R=3, itemps=geo, trace=TRUE, pred.n=FALSE, verb=0) @ Out of a total of $\Sexpr{moto.it$R*moto.it$BTE[2]/moto.it$BTE[3]}$ samples from the joint chain, the resulting (optimally combined) ESS was: <<>>= moto.it$ess$combined @ Alternatively, $\mb{w}^{\lambda^*}$ can be extracted from the traces, and used to make the ESS calculation directly. <<>>= p <- moto.it$trace$post ESS(p$wlambda) @ The unadjusted weights $\mb{w}$ are also available from {\tt trace}. We can see that the na\"{i}ve choice of $\lambda_i = W_i/W$, leading to the estimator in (\ref{Eq:hath}), has a clearly inferior effective sample size. <<>>= ESS(p$w) @ To see the benefit of IT over ST we can simply count the number of samples obtained when $k^{(t)} = 1$. This can be accomplished in several ways: either via the traces or through the output object. <<>>= as.numeric(c(sum(p$itemp == 1), moto.it$ess$each[1,2:3])) @ That is, (optimal) IT gives effectively $\Sexpr{signif(moto.it$ess$combined/sum(p$itemp==1), 3)}$ times more samples. The na\"{i}ve combination, leading to the estimator in (\ref{Eq:hath}), yields an estimator with an effective sample size that is $\Sexpr{round(100*ESS(p$w)/sum(p$itemp==1))}$\% of the number of samples obtained under ST. Now, we should like to compare to the MCMC samples obtained under the same model, without IT. <<>>= moto.reg <- btgpllm(X=mcycle[,1], Z=mcycle[,2], BTE=c(2000,52000,10), R=3, bprior="b0", trace=TRUE, pred.n=FALSE, verb=0) @ The easiest comparison to make is to look at the heights explored under the three chains: the regular one, the chain of heights visited at all temperatures (combined), and those obtained after applying IT via re-weighting under the optimal combination $\lambda^*$. <<>>= L <- length(p$height) hw <- suppressWarnings(sample(p$height, L, prob=p$wlambda, replace=TRUE)) b <- hist2bar(cbind(moto.reg$trace$post$height, p$height, hw)) @ \begin{figure}[ht!] <>= barplot(b, beside=TRUE, col=1:3, xlab="tree height", ylab="counts", main="tree heights encountered") legend("topright", c("reg MCMC", "All Temps", "IT"), fill=1:3) @ <>= graphics.off() @ \centering \includegraphics[trim=0 25 0 25]{tgp2-it-moto-height} \caption{Barplots indicating the counts of the number of times the Markov chains (for regular MCMC, combining all temperatures in the inverse temperature ladder, and those re-weighted via IT) were in trees of various heights for the motorcycle data.} \label{f:moto:it:heights} \end{figure} Figure \ref{f:moto:it:heights} shows barplots indicating the count of the number of times the Markov chains were in trees of various heights after burn--in. Notice how the tempered chain (denoted ``All Temps'' in the figure) frequently visits trees of height one, whereas the non--tempered chain (denoted ``reg MCMC'') never does. The result is that the non--tempered chain underestimates the probability of height two trees and produces a corresponding overestimate of height four trees---which are clearly not supported by the data---even visiting trees of height five. The IT estimator appropriately down--weights height one trees and provides correspondingly more realistic estimates of the probability of height two and four trees. Whenever introducing another parameter into the model, like the inverse temperature $k$, it is important to check that the marginal posterior chain for that parameter is mixing well. For ST it is crucial that the chain makes rapid excursions between the cold temperature, the hottest temperatures, and visits each temperature roughly the same number of times. \begin{figure}[ht!] <>= plot(log(moto.it$trace$post$itemp), type="l", ylab="log(k)", xlab="samples", main="trace of log(k)") @ <>= graphics.off() @ \centering \includegraphics[trim=0 25 0 25]{tgp2-it-moto-ktrace} \caption{A trace of the MCMC samples from the marginal posterior distribution of the inverse temperature parameter, $k$, in the motorcycle experiment} \label{f:ktrace} \end{figure} Figure \ref{f:ktrace} shows a trace of the posterior samples for $k$ in the motorcycle experiment. Arguably, the mixing in $k$--space leaves something to be desired. Since it can be very difficult to tune the pseudo--prior and MH proposal mechanism to get good mixing in $k$--space, it is fortunate that the IT methodology does not rely on the same mixing properties as ST does. Since samples can be obtained from the posterior distribution of the parameters of interest by re-weighting samples obtained when $k < 1$ it is only important that the chain frequently visit low temperatures to obtain good sampling, and high temperatures to obtain good mixing. The actual time spent in specific temperatures, i.e., $k=1$ is less important. %%ylim <- c(0, 1.25*max(c(b[,1], moto.it$itemps$counts))) %, ylim=ylim) \begin{figure}[ht!] <>= b <- itemps.barplot(moto.it, plot.it=FALSE) barplot(t(cbind(moto.it$itemps$counts, b)), col=1:2, beside=TRUE, ylab="counts", xlab="itemps", main="inv-temp observation counts") legend("topleft", c("observation counts", "posterior samples"), fill=1:2) @ <>= graphics.off() @ \centering \includegraphics[trim=0 25 0 25]{tgp2-it-moto-khist} \caption{Comparing (thinned) samples from the posterior distribution for the inverse temperature parameter, $k$, (posterior samples), to the observation counts used to update the pseudo--prior, in the motorcycle experiment} \label{f:khist} \end{figure} Figure \ref{f:khist} shows the histogram of the inverse temperatures visited in the Markov chain for the motorcycle experiment. Also plotted is a histogram of the {\em observation counts} in each temperature. The two histograms should have similar shape but different totals. Observation counts are tallied during every MCMC sample after burn--in, whereas the posterior samples of $k$ are thinned (at a rate specified in {\tt BTE[3]}). When the default {\tt trace=FALSE} argument is used only the observation counts will be available in the {\tt tgp}--class object, and these can be used as a surrogate for a trace of $k$. The compromise IT approach obtained using the sigmoidal ladder can yield an increase in ESS. <<>>= moto.it.sig <- btgpllm(X=mcycle[,1], Z=mcycle[,2], BTE=c(2000,52000,10), R=3, bprior="b0", krige=FALSE, itemps=sig, verb=0) @ Compare the resulting ESS to the one given for the geometric ladder above. <<>>= moto.it.sig$ess$combined @ \begin{figure}[ht!] <>= plot(moto.it.sig) @ <>= graphics.off() @ \centering \includegraphics[trim=0 25 0 25]{tgp2-it-moto-pred} \caption{Posterior predictive surface for the motorcycle data, with 90\% quantile errorbars, obtained under IT with the sigmoidal ladder.} \label{f:moto:pred} \end{figure} Plots of the resulting predictive surface is shown in Figure \ref{f:moto:pred} for comparison with those in Section 1.1 of the first {\tt tgp} vignette \cite{gramacy:2007}. In particular, observe that the transition from the middle region to the right one is much less stark in this tempered version than than in the original---which very likely spent a disproportionate amount of time stuck in a posterior mode with trees of depth three or greater. \subsubsection{Synthetic 2--d Exponential Data} \label{sec:exp} Recall the synthetic 2--d exponential data of Section 3.4 of the tgp vignette \cite{gramacy:2007}, where the true response is given by \[ z(\mb{x}) = x_1 \exp(-x_1^2 - x_2^2). \] Here, we will take $\mb{x} \in [-6,6]\times [-6,6]$ with a $D$--optimal design <<>>= Xcand <- lhs(10000, rbind(c(-6,6),c(-6,6))) X <- dopt.gp(400, X=NULL, Xcand)$XX Z <- exp2d.Z(X)$Z @ Consider a treed GP LLM model fit to this data using the standard MCMC. <<>>= exp.reg <- btgpllm(X=X, Z=Z, BTE=c(2000,52000,10), bprior="b0", trace=TRUE, krige=FALSE, R=10, verb=0) @ \begin{figure}[ht!] <>= plot(exp.reg) @ <>= graphics.off() @ \centering \includegraphics[trim=0 25 0 25]{tgp2-it-exp-pred} \caption{Posterior predictive surface for the 2--d exponential data: mean surface {\em (left)} and 90\% quantile difference {\em (right)}} \label{f:exp:pred} \end{figure} Figure \ref{f:exp:pred} shows the resulting posterior predictive surface. The maximum {\em a' posteriori} (MAP) tree is drawn over the error surface in the {\em right--hand} plot. The height of this tree can be obtained from the {\tt tgp}-class object. <<>>= h <- exp.reg$post$height[which.max(exp.reg$posts$lpost)] h @ It is easy to see that many fewer partitions are actually necessary to separate the interesting, central, region from the surrounding flat region. \begin{figure}[ht!] <>= tgp.trees(exp.reg, "map") @ <>= graphics.off() @ \centering \includegraphics[trim=0 100 0 25]{tgp2-it-exp-mapt} \caption{Diagrammatic depiction of the maximum {\em a' posteriori} (MAP) tree for the 2--d exponential data under standard MCMC sampling } \label{f:exp:mapt} \end{figure} Figure \ref{f:exp:mapt} shows a diagrammatic representation of the MAP tree. Given the apparent over--partitioning in this height \Sexpr{h} tree it would be surprising to find much posterior support for trees of greater height. One might indeed suspect that there are trees with fewer partitions which would have higher posterior probability, and thus guess that the Markov chain for the trees plotted in these figures possibly became stuck in a local mode of tree space while on an excursion into deeper trees. Now consider using IT. It will be important in this case to have a $k_{\mbox{\tiny m}}$ small enough to ensure that the tree occasionally prunes back to the root. We shall therefore use a smaller $k_{\mbox{\tiny m}}$. % with an extra 10 rungs. Generally speaking, some pilot tuning may be necessary to choose an appropriate $k_{\mbox{\tiny m}}$ and number of rungs $m$, although the defaults should give adequate performance in most cases. <<>>= its <- default.itemps(k.min=0.02) exp.it <- btgpllm(X=X, Z=Z, BTE=c(2000,52000,10), bprior="b0", trace=TRUE, krige=FALSE, itemps=its, R=10, verb=0) @ As expected, the tempered chain moves more rapidly throughout tree space by accepting more tree proposals. The acceptance rates of tree operations can be accessed from the {\tt tgp}--class object. <<>>= exp.it$gpcs exp.reg$gpcs @ The increased rate of {\em prune} operations explains how the tempered distributions helped the chain escape the local modes of deep trees. We can quickly compare the effective sample sizes of the three possible estimators: ST, na\"{i}ve IT, and optimal IT. <<>>= p <- exp.it$trace$post data.frame(ST=sum(p$itemp == 1), nIT=ESS(p$w), oIT=exp.it$ess$combined) @ Due to the thinning in the Markov chain ({\tt BTE[3] = 10}) and the traversal between $m=10$ temperatures in the ladder, we can be reasonably certain that the \Sexpr{round(exp.it$ess$combined)} samples obtained via IT from the total of \Sexpr{round(exp.it$R*(exp.it$BTE[2]-exp.it$BTE[1])/exp.it$BTE[3])} samples obtained from the posterior are far less correlated than the ones obtained via standard MCMC. As with the motorcycle data, we can compare the tree heights visited by the two chains. <<>>= L <- length(p$height) hw <- suppressWarnings(sample(p$height, L, prob=p$wlambda, replace=TRUE)) b <- hist2bar(cbind(exp.reg$trace$post$height, p$height, hw)) @ \begin{figure}[ht!] <>= barplot(b, beside=TRUE, col=1:3, xlab="tree height", ylab="counts", main="tree heights encountered") legend("topright", c("reg MCMC", "All Temps", "IT"), fill=1:3) @ <>= graphics.off() @ \centering \includegraphics[trim=0 25 0 25]{tgp2-it-exp-height} \caption{Barplots indicating the counts of the number of times the Markov chains (for regular MCMC, combining all temperatures in the inverse temperature ladder, and those re-weighted via IT) were in trees of various heights for the 2--d exponential data.} \label{f:exp:it:heights} \end{figure} Figure \ref{f:exp:it:heights} shows a barplot of {\tt b}, which illustrates that the tempered chain frequently visited shallow trees. IT with the optimal weights shows that the standard MCMC chain missed many trees of height three and four with considerable posterior support. \begin{figure}[ht!] <>= ylim <- range(p$height, exp.reg$trace$post$height) plot(p$height, type="l", main="trace of tree heights", xlab="t", ylab="height", ylim=ylim) lines(exp.reg$trace$post$height, col=2) legend("topright", c("tempered", "reg MCMC"), lty=c(1,1), col=1:2) @ <>= graphics.off() @ \centering \includegraphics[trim=0 25 0 25]{tgp2-it-exp-trace-height} \caption{Traces of the tree heights obtained under the two Markov chains (for regular MCMC, combining all temperatures in the inverse temperature ladder) on the 2--d exponential data.} \label{f:exp:trace:height} \end{figure} To more directly compare the mixing in tree space between the ST and tempered chains, consider the trace plots of the heights of the trees explored by the chains shown in Figure \ref{f:exp:trace:height}. Despite being restarted \Sexpr{exp.reg$R} times, the regular MCMC chain (almost) never visits trees of height less than five after burn--in and instead makes rather lengthy excursions into deeper trees, exploring a local mode in the posterior. In contrast, the tempered chain frequently prunes back to the tree root, and consequently discovers posterior modes in tree heights three and four. \begin{figure}[ht!] <>= plot(exp.it) @ \vspace{-0.7cm} <>= tgp.trees(exp.it, "map") @ <>= graphics.off() @ \centering \includegraphics[trim=0 15 0 0]{tgp2-it-expit-pred} \includegraphics[trim=0 100 0 0]{tgp2-it-expit-trees} \caption{2--d exponential data fit with IT. {\em Top:} Posterior predictive mean surface for the 2d--exponential, with the MAP tree overlayed. {\em Bottom:} diagrammatic representation of the MAP tree. } \label{f:exp-it:pred} \end{figure} To conclude, a plot of the posterior predictive surface is given in Figure \ref{f:exp-it:pred}, where the MAP tree is shown both graphically and diagrammatically. %\iffalse \subsection*{Acknowledgments} This work was partially supported by research subaward 08008-002-011-000 from the Universities Space Research Association and NASA, NASA/University Affiliated Research Center grant SC 2003028 NAS2-03144, Sandia National Laboratories grant 496420, National Science Foundation grants DMS 0233710 and 0504851, and Engineering and Physical Sciences Research Council Grant EP/D065704/1. The authors would like to thank their Ph.D.~advisor, Herbie Lee, whose contributions and guidance in this project have been invaluable throughout. Finally, we would like to thank two anonymous referees whose many helpful comments improved the paper. %\fi \bibliography{tgp} \bibliographystyle{plain} \end{document} tgp/R/0000755000176200001440000000000013723731201011244 5ustar liggesuserstgp/R/tgp.postprocess.R0000644000176200001440000002133513531032535014551 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* "tgp.postprocess" <- function(ll, Xnames, response, pred.n, zcov, Ds2x, improv, sens.p, Zm0r1, params, rmfiles=TRUE) { ## deal with X, and names of X, as well as Xsplit ll$X <- framify.X(ll$X, Xnames, ll$d) ll$Xsplit <- framify.X(ll$Xsplit, Xnames, ll$d) ll$nsplit <- NULL ## deal with Z, and names of Z if(is.null(response)) ll$response <- "z" else ll$response <- response ## remove from the list if not requested if(Ds2x == FALSE) { ll$Ds2x <- NULL; } if(improv == FALSE || is.null(improv)) { ll$improv <- NULL; } ## deal with predictive data locations (ZZ) if(ll$nn == 0 || (ll$BTE[2]-ll$BTE[1])==0 || !is.null(sens.p)) { ll$XX <- ll$ZZ.mean <- ll$ZZ.s2 <- ll$ZZ.q <- ll$ZZ.km <- ll$ZZ.ks2 <- ll$ZZ.vark <- NULL ll$ZZ.q1 <- ll$ZZ.med <- ll$ZZ.q2 <- ll$ZpZZ.s2 <- ll$Ds2x <- ll$improv <- NULL } else { ## do predictive input/output processing ## replace NaN's in improv with zeros ## shouldn't happen because check have been moved to C code if((!is.null(ll$improv)) && sum(is.nan(ll$improv) > 0)) { warning(paste("encountered", sum(is.nan(ll$improv)), "NaN in Improv, replaced with zeros"), call.=FALSE) ll$improv[is.nan(ll$improv)] <- 0 } ## make sure XX has the correct output format ll$XX <- framify.X(ll$XX, Xnames, ll$d) } ## turn improv into a data.frame where the second column is the rankings if(!is.null(improv)){ ll$irank[ll$irank == 0] <- ll$nn ll$improv <- data.frame(improv=ll$improv, rank=ll$irank) } ll$irank <- NULL ## NULL-out data-predictive output if unused if(pred.n == FALSE || ll$BTE[2]-ll$BTE[1] == 0) { ll$Zp.mean <- ll$Zp.q <- ll$Zp.q1 <- ll$Zp.q2 <- NULL; ll$Zp.s2 <- ll$ZpZZ.s2 <- ll$Zp.km <- ll$Zp.vark <- ll$Zp.ks2 <- ll$Zp.med <- NULL } ## gather information about partitions if(file.exists(paste("./", "best_parts_1.out", sep=""))) { ll$parts <- as.matrix(read.table("best_parts_1.out")) if(rmfiles) unlink("best_parts_1.out") } else { ll$parts <- NULL } ## gather information about MAP trees as a function of height ll$trees <- tgp.get.trees(ll$Xsplit, rmfiles) ll$posts <- read.table("tree_m0_posts.out", header=TRUE) if(ll$BTE[2] - ll$BTE[1] == 0) ll$posts <- NULL if(rmfiles) unlink("tree_m0_posts.out") ## read the trace in the output files, and then delete them if(ll$trace) ll$trace <- tgp.read.traces(ll$n, ll$nn, ll$d, params$corr, ll$verb, rmfiles) else ll$trace <- NULL ## store params ll$params <- params ## clear the verb, state, tree and MAP fields for output ll$verb <- NULL; ll$state <- NULL; ll$tree <- NULL; ll$MAP <- NULL; ll$nt <- NULL ll$ncol <- NULL; ll$hier <- NULL; ## clear output dimensions ll$pred.n <- ll$nnprime <- ll$krige <- ll$bDs2x <- NULL ## consolidate itemps nt <- as.integer(ll$itemps[1]) lambda <- ll$itemps[length(ll$itemps)] if(lambda == 1) lambda <- "opt" else if(lambda == 2) lambda <- "naive" else if(lambda == 3) lambda <- "st" else stop(paste("bad lambda = ", lambda, sep="")) ll$itemps <- list(c0n0=as.integer(ll$itemps[2:3]), k=ll$itemps[4:(nt+3)], pk=ll$itemps[(nt+4):(2*nt+3)], counts=as.integer(ll$itemps[(2*nt+4):(3*nt+3)]), lambda=lambda) ## consolidate ess if(nt == 1) ll$ess <- ll$ess[1] else { ll$ess=list(combined=ll$ess[1], each=data.frame(k=ll$itemps$k, count=ll$ess[2:(nt+1)], ess=ll$ess[(nt+2):(2*nt+1)])) } ## change {0,1} to {TRUE,FALSE} if(ll$linburn) ll$linburn <- TRUE else ll$linburn <- FALSE ## pretty-up the grow, prune, change and swap stats ll$gpcs[is.nan(ll$gpcs)] <- NA ll$gpcs <- data.frame(t(ll$gpcs)) names(ll$gpcs) <- c("grow", "prune", "change", "swap") ## deal with sensitivity analysis outputs if(!is.null(sens.p)){ names(sens.p) <- NULL sens.par <- list(nn.lhs=sens.p[1], rect=matrix(sens.p[2:(ll$d*2+1)], nrow=2), shape=sens.p[(ll$d*2+2):(ll$d*3+1)], mode=sens.p[(ll$d*3+2):(ll$d*4+1)], ngrid=ll$sens.ngrid, span=ll$sens.span) sens <- list() sens$par <- sens.par sens$ngrid <- NULL sens$span <- NULL sens$Xgrid <- matrix(ll$sens.Xgrid, ncol=ll$d) sens$ZZ.mean <- matrix(ll$sens.ZZ.mean, ncol=ll$d) sens$ZZ.q1 <- matrix(ll$sens.ZZ.q1, ncol=ll$d) sens$ZZ.q2 <- matrix(ll$sens.ZZ.q2, ncol=ll$d) sens$S <- matrix(ll$sens.S, ncol=ll$d, byrow=TRUE) sens$T <- matrix(ll$sens.T, ncol=ll$d, byrow=TRUE) } else{ sens <- NULL } ## clear ll$sens.* and replace with single list ll$sens.Xgrid <- ll$sens.ZZ.mean <- ll$sens.ZZ.q1 <- ll$sens.ZZ.q2 <- NULL ll$sens.ngrid <- ll$sens.span <- ll$sens.S <- ll$sens.T <- NULL ll$sens <- sens ## undo mean0.range1 if(!is.null(Zm0r1)) { ll$Z <- undo.mean0.range1(ll$Z,Zm0r1$undo) ll$Zp.mean <- undo.mean0.range1(ll$Zp.mean,Zm0r1$undo) ll$ZZ.mean <- undo.mean0.range1(ll$ZZ.mean,Zm0r1$undo) ll$Zp.km <- undo.mean0.range1(ll$Zp.km,Zm0r1$undo) ll$ZZ.km <- undo.mean0.range1(ll$ZZ.km,Zm0r1$undo) ll$Zp.vark <- undo.mean0.range1(ll$Zp.vark,Zm0r1$undo, nomean=TRUE, s2=TRUE) ll$ZZ.vark <- undo.mean0.range1(ll$ZZ.vark,Zm0r1$undo, nomean=TRUE, s2=TRUE) ll$Zp.ks2 <- undo.mean0.range1(ll$Zp.ks2,Zm0r1$undo, nomean=TRUE, s2=TRUE) ll$ZZ.ks2 <- undo.mean0.range1(ll$ZZ.ks2,Zm0r1$undo, nomean=TRUE, s2=TRUE) ll$ZpZZ.ks2 <- undo.mean0.range1(ll$ZpZZ.ks2,Zm0r1$undo, nomean=TRUE, s2=TRUE) ll$Zp.q <- undo.mean0.range1(ll$Zp.q,Zm0r1$undo, nomean=TRUE) ll$ZZ.q <- undo.mean0.range1(ll$ZZ.q,Zm0r1$undo, nomean=TRUE) ll$Zp.s2 <- undo.mean0.range1(ll$Zp.s2,Zm0r1$undo, nomean=TRUE, s2=TRUE) ll$ZZ.s2 <- undo.mean0.range1(ll$ZZ.s2,Zm0r1$undo, nomean=TRUE, s2=TRUE) ll$Zp.q1 <- undo.mean0.range1(ll$Zp.q1,Zm0r1$undo) ll$Zp.med <- undo.mean0.range1(ll$Zp.med,Zm0r1$undo) ll$Zp.q2 <- undo.mean0.range1(ll$Zp.q2,Zm0r1$undo) ll$ZZ.q1 <- undo.mean0.range1(ll$ZZ.q1,Zm0r1$undo) ll$ZZ.med <- undo.mean0.range1(ll$ZZ.med,Zm0r1$undo) ll$ZZ.q2 <- undo.mean0.range1(ll$ZZ.q2,Zm0r1$undo) for(j in 1:ll$d){ ll$sens.ZZ.mean[,j] <- undo.mean0.range1(ll$sens.ZZ.mean[,j],Zm0r1$undo) ll$sens.ZZ.q1[,j] <- undo.mean0.range1(ll$sens.ZZ.q1[,j],Zm0r1$undo) ll$sens.ZZ.q2[,j] <- undo.mean0.range1(ll$sens.ZZ.q2[,j],Zm0r1$undo) } ll$m0r1 <- TRUE } else { ll$m0r1 <- FALSE } ## turn Z*.s2 into a matrix (covariance matrix) if(!is.null(ll$Zp.s2) && ll$zcov) ll$Zp.s2 <- matrix(ll$Zp.s2, ncol=ll$n) if(!is.null(ll$ZZ.s2) && ll$zcov) ll$ZZ.s2 <- matrix(ll$ZZ.s2, ncol=ll$nn) if(!is.null(ll$ZpZZ.s2) && ll$zcov) ll$ZpZZ.s2 <- t(matrix(ll$ZpZZ.s2, ncol=ll$n)) else ll$ZpZZ.s2 <- NULL ll$zcov <- NULL ## set class information and return class(ll) <- "tgp" return(ll) } "tgp.get.trees" <- function(X, rmfiles=TRUE) { trees <- list() ## get all of the names of the tree files tree.files <- list.files(pattern="tree_m0_[0-9]+.out") ## return no trees if the run was only burn-in if(length(tree.files) == 0) return(NULL) ## for each tree file for(i in 1:length(tree.files)) { ## grab the height from the filename h <- as.numeric(strsplit(tree.files[i], "[_.]")[[1]][3]) ## read it in, then remove it trees[[h]] <- read.table(tree.files[i], header=TRUE) if(rmfiles) unlink(tree.files[i]) ## correct the precision of the val (split) locations ## by replacing them with the closest X[,var] location if(nrow(trees[[h]]) == 1) next; nodes <- (1:length(trees[[h]]$var))[trees[[h]]$var != ""] for(j in 1:length(nodes)) { col <- as.numeric(as.character(trees[[h]]$var[nodes[j]])) + 1 m <- which.min(abs(X[,col] - trees[[h]]$val[nodes[j]])) trees[[h]]$val[nodes[j]] <- X[m,col] } } return(trees) } tgp/R/tgp.plot.slice.R0000644000176200001440000002451213531032535014241 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## tgp.plot.slice: ## ## plot the 2-d slice of the tgp-class object out specified by the slice ## argument, and other usual plotting arguments and specified center ## and as (error) specifications "tgp.plot.slice" <- function(out, pparts=TRUE, slice=NULL, map=NULL, as=NULL, center="mean", layout="both", main=NULL, xlab=NULL, ylab=NULL, zlab=NULL, pc="pc", gridlen=40, span=0.1, pXX=TRUE, ...) { ## choose center as median or mean (i.e., X & Z data) ## (this hasn't been tested since the addition of the tgp.choose.center() function center <- tgp.choose.center(out, center); Z.mean <- center$Z cname <- center$name; X <- center$X ## get X locations for calculating slice locs <- getlocs(X) ## will call stop() if something is wrong with the slice d <- check.slice(slice, out$d, locs) ## deal with axis labels if(is.null(xlab)) xlab <- names(out$X)[d[1]] if(is.null(ylab)) ylab <- names(out$X)[d[2]] if(is.null(zlab)) zlab <- out$response fixed <- names(out$X)[slice$x]; to <- slice$z slice.str <- paste("(", fixed, ") fixed to (", to, ")", sep="") smain <- paste(main, " ", zlab, " ", cname, ", with ", slice.str, sep="") ## for ALC and EGO plotting as <- tgp.choose.as(out, as); XX <- as$X ZZ.q <- as$criteria emain <- paste(main, " ", zlab, " ", as$name, ", with ", slice.str, sep="") ##emain <- paste(main, zlab, as$name) ## depict the slice in terms of index variables p* if(length(slice$x) > 1) { p <- seq(1,nrow(X))[apply(X[,slice$x] == slice$z, 1, prod) == 1] pp <- seq(1,nrow(XX))[apply(XX[,slice$x] == slice$z, 1, prod) == 1] pn <- seq(1,out$n)[apply(out$X[,slice$x] == slice$z, 1, prod) == 1] ppn <- seq(1,out$nn)[apply(out$XX[,slice$x] == slice$z, 1, prod) == 1] } else { ppn <- seq(1,out$nn)[(out$XX[,slice$x] == slice$z)] pn <- seq(1,out$n)[out$X[,slice$x] == slice$z] p <- seq(1,nrow(X))[X[,slice$x] == slice$z] pp <- seq(1,nrow(XX))[XX[,slice$x] == slice$z] } ## check to makes sure there is actually some data in the slice if(length(p) == 0) { print(slice) stop("no points in the specified slice\n") } ## prepare for plotting if(layout == "both") par(mfrow=c(1,2), bty="n") ## else par(mfrow=c(1,1), bty="n") Xd.1 <- X[,d[1]]; Xd.2 <- X[,d[2]] XXd.1 <- XX[,d[1]]; XXd.2 <- XX[,d[2]] if(pc == "c") { # double-image plot if(layout == "both" || layout == "surf") { slice.image(Xd.1,Xd.2,p,Z.mean,main=smain,xlab=xlab,ylab=ylab, gridlen=gridlen,span=span,...) if(pparts & !is.null(out$parts)) { tgp.plot.parts.2d(out$parts, d, slice); } if(length(pn) > 0) points(out$X[pn,d[1]], out$X[pn,d[2]], pch=20) if(pXX && length(ppn) > 0) points(out$XX[ppn,d[1]], out$XX[ppn,d[2]], pch=21) } if(layout == "both" || layout == "as") { slice.image(XXd.1,XXd.2,pp,ZZ.q,main=emain,xlab=xlab,ylab=ylab, gridlen=gridlen,span=span,...) if(pparts & !is.null(out$parts)) { tgp.plot.parts.2d(out$parts, d, slice); } if(length(pn) > 0) points(out$X[pn,d[1]], out$X[pn,d[2]], pch=20) if(pXX && length(ppn) > 0) points(out$XX[ppn,d[1]], out$XX[ppn,d[2]], pch=21) if(substr(as$name,1,1) == "I") text(out$XX[ppn,d[1]], out$XX[ppn,d[2]], labels=out$improv[ppn,2], ...) } } else if(pc == "pc") { # perspective and image plot if(layout == "both" || layout == "surf") slice.persp(Xd.1,Xd.2,p,Z.mean,main=smain,xlab=xlab,ylab=ylab,zlab=zlab, gridlen=gridlen,span=span,...) if(layout == "both" || layout == "as") { slice.image(XXd.1,XXd.2,pp,ZZ.q,main=emain,xlab=xlab,ylab=ylab, gridlen=gridlen,span=span,...) if(length(pn) > 0) points(out$X[pn,d[1]], out$X[pn,d[2]], pch=20) if(pXX && length(ppn) > 0) points(out$XX[ppn,d[1]], out$XX[ppn,d[2]], pch=21) if(pparts & !is.null(out$parts)) { tgp.plot.parts.2d(out$parts, d, slice); } if(substr(as$name,1,1) == "I") text(out$XX[,proj[1]], out$XX[,proj[2]], labels=out$improv[ppn,2], ...) } } } ## slice.contour: ## ## contour plot of the slice or projection -- not currently ## used in any tgp plotting function "slice.contour" <- function(x,y,p,z,levels=NULL,xlab="x",ylab="y",main="",xlim=NULL,ylim=NULL, ...) { g <- slice.interp(x,y,p,z,xlim,ylim) if(missing(ylim)) ylim <- range(y) if(missing(xlim)) xlim <- range(x) if(is.null(levels)) { contour(g,xlab=xlab,ylab=ylab,main=main,xlim=xlim,ylim=ylim,...) } else { contour(g,levels=levels,xlab=xlab,ylab=ylab,main=main,xlim=xlim,ylim=ylim,...) } } ## slice.image: ## ## image plot of the slice or projection -- used in pc="c" "slice.image" <- function(x,y,p,z,xlim=NULL, ylim=NULL, gridlen=c(40,40), span=0.05, col=terrain.colors(128), ...) { g <- slice.interp(x,y,p,z,xlim,ylim,gridlen=gridlen,span=span) if(missing(ylim)) ylim <- range(y) if(missing(xlim)) xlim <- range(x) image(g, col=col,xlim=xlim,ylim=ylim,...) } ## slice.image.contour: ## ## double image and contour plot of the slice or projection -- not ## currently used in any tgp plotting function "slice.image.contour" <- function(x,y,p,z, xlim=NULL, ylim=NULL, gridlen=c(40,40), span=0.05, ...) { g <- slice.interp(x,y,p,z,xlim,ylim,gridlen=gridlen,span=span) if(missing(ylim)) ylim <- range(y) if(missing(xlim)) xlim <- range(x) image(g, col=terrain.colors(128),xlim=xlim,ylim=ylim,...) contour(g, add=TRUE,...) } ## slice.persp: ## ## perspective plot of the slice or projections -- used when ## pc="p" "slice.persp" <- function(x,y,p,z,theta=-30,phi=20,xlim=NULL, ylim=NULL, gridlen=c(40,40), span=0.05, ...) { g <- slice.interp(x,y,p,z,xlim,ylim,gridlen=gridlen,span=span) if(missing(ylim)) ylim <- range(y) if(missing(xlim)) xlim <- range(x) persp(g, theta=theta, phi=phi, axes=TRUE, box=TRUE, xlim=xlim, ylim=ylim, ...) } ## slice.interp: ## ## interpolate the x, y, z data specified onto a regular 2-d ## grid, perhaps making a slice specified by the p-vector indicating ## which entries of x, y, and z should be used. This is necessary ## in order to plot using persp, contour, image, etc. ## loess is used for interpolation "slice.interp" <- function(x, y, p=NULL, z, xlim=NULL, ylim=NULL, gridlen=c(40,40), span=0.05, ...) { ## check gridlen if(length(gridlen) != 2) stop("length(gridlen) should be 2") # check and/or default the projection parameter p if(is.null(p)) p <- 1:length(x) else p <- as.integer(p) if(any(p <= 0) || any(p > length(x))) stop("invalid p (third arg: value unknown)") # make projection x <- x[p]; y <- y[p]; z <- z[p] if(!is.null(xlim)) { # crop (zoom in) x p <- x>=xlim[1] & x<=xlim[2] x <- x[p]; y <- y[p]; z <- z[p] } if(!is.null(ylim)) { # crop (zoom in) y p <- y>=ylim[1] & y<=ylim[2] x <- x[p]; y <- y[p]; z <- z[p] } # use loess return(interp.loess(x,y,z, duplicate="mean", gridlen=gridlen, span=span, ...)) } ## check.slice: ## ## checks to make sure the slice argument to plot.tgp is of a ## format that make sens for the input dimension and data locations ## provided from the getlocs function "check.slice" <- function(slice, dim, locs) { ## check to make sure the slice requested is valid numfix <- dim-2; if(length(slice$x) != numfix && length(slice$x) == length(slice$z)) { print(locs) stop(paste("must fix", numfix, "variables, each at one of the above locations\n")) } ## check to make sure enough dimensions have been fixed d <- setdiff(seq(1:dim), slice$x) if(length(d) != 2) stop(paste(length(d)-2, "more dimensions need to be fixed\n", sep="")) ## will stop if the slice is not ok, ## otherwise returns the remaining (unfixed) dimensions return(d) } ## getlocs: ## ## get the grid of locations for the data -- these are the locations ## used in the locs argument of check.slice "getlocs" <- function(X) { db <- dim(X); Xsort <- apply(X, 2, sort) unique <- (Xsort[1:(db[1]-1),] != Xsort[2:db[1],]) locs.list <- list() for(i in 1:db[2]) { locs <- c(Xsort[unique[,i],i], Xsort[db[1],i]) count <- rep(0,length(locs)) for(j in 1:length(locs)) { count[j] = sum(Xsort[,i] == locs[j]) } ll.i <- list(locs=locs,count=count) locs.list[[i]] <- ll.i } return(locs.list) } ## interp.loess: ## ## interolate x,y,z onto a regular 2-d grid of size gridlen. ## this function is meant to mimic the interp function in the ## akima library which can be buggy. It luse a loess smoother ## instead, with the span provided "interp.loess" <- function(x, y, z, gridlen = c(40,40), span=0.1, ...) { ## check the gridlen argument if(length(gridlen) == 1) gridlen <- rep(gridlen, 2) if(length(gridlen) != 2) stop("length(gridlen) should be 2") if(length(x) != length(y) && length(y) != length(z)) stop("length of x, y and z must be equal") if(length(x) < 30 && span < 0.5) { warning("with less than 30 points, suggest span >> 0.5 or use akima", immediate. = TRUE) cat(paste("currently trying span =", span, "for", length(x), "points\n")) } xo <- seq(min(x), max(x), length=gridlen[1]) yo <- seq(min(y), max(y), length=gridlen[2]) xyz.loess <- suppressWarnings(loess(z ~ x + y, data.frame(x=x, y=y), span=span, ...)) g <- expand.grid(x=xo, y=yo) g.pred <- predict(xyz.loess, g) return(list(x=xo, y=yo, z=matrix(g.pred, nrow=gridlen))) } tgp/R/tgp.read.traces.R0000644000176200001440000001640713531032535014364 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## tgp.read.traces: ## ## read the traces contained in the files written by the tgp C-side, ## process them as appropriate, and then delete the trace files ## returning a tgptraces-class object "tgp.read.traces" <- function(n, nn, d, corr, verb, rmfiles=TRUE) { trace <- list() if(verb >= 1) cat("\nGathering traces\n") ## read the parameter traces for each XX location trace$XX <- tgp.read.XX.traces(nn, d, corr, verb, rmfiles) ## read trace of hierarchical parameters if(file.exists(paste("./", "trace_hier_1.out", sep=""))) { trace$hier <- read.table("trace_hier_1.out", header=TRUE) if(rmfiles) unlink("trace_hier_1.out") if(verb >= 1) cat(" hier-params done\n") } ## read trace of linear area calulations if(file.exists(paste("./", "trace_linarea_1.out", sep=""))) { trace$linarea <- read.table("trace_linarea_1.out", header=TRUE) if(rmfiles) unlink("trace_linarea_1.out") if(verb >= 1) cat(" linarea done\n") } ## read full trace of partitions if(file.exists(paste("./", "trace_parts_1.out", sep=""))) { trace$parts <- read.table("trace_parts_1.out") if(rmfiles) unlink("trace_parts_1.out") if(verb >= 1) cat(" parts done\n") } ## read the posteriors and weights as a function of height if(file.exists(paste("./", "trace_post_1.out", sep=""))) { trace$post <- read.table("trace_post_1.out", header=TRUE) if(rmfiles) unlink("trace_post_1.out") if(verb >= 1) cat(" posts done\n") } ## read the weights adjusted for ess if(file.exists(paste("./", "trace_wlambda_1.out", sep=""))) { trace$post$wlambda <- scan("trace_wlambda_1.out", quiet=TRUE) if(rmfiles) unlink("trace_wlambda_1.out") if(verb >= 1) cat(" lambda done\n") } ## predictions at data (X) locations if(file.exists(paste("./", "trace_Zp_1.out", sep=""))) { trace$preds$Zp <- read.table("trace_Zp_1.out", header=FALSE) names(trace$preds$Zp) <- paste("X", 1:n, sep="") if(rmfiles) unlink("trace_Zp_1.out") if(verb >= 1) cat(" Zp done\n") } ## kriging means at data (X) locations if(file.exists(paste("./", "trace_Zpkm_1.out", sep=""))) { trace$preds$Zp.km <- read.table("trace_Zpkm_1.out", header=FALSE) names(trace$preds$Zp.km) <- paste("X", 1:n, sep="") if(rmfiles) unlink("trace_Zpkm_1.out") if(verb >= 1) cat(" Zp.km done\n") } ## kriging vars at data (X) locations if(file.exists(paste("./", "trace_Zpks2_1.out", sep=""))) { trace$preds$Zp.ks2 <- read.table("trace_Zpks2_1.out", header=FALSE) names(trace$preds$Zp.ks2) <- paste("XX", 1:n, sep="") if(rmfiles) unlink("trace_Zpks2_1.out") if(verb >= 1) cat(" Zp.ks2 done\n") } ## predictions at XX locations if(file.exists(paste("./", "trace_ZZ_1.out", sep="")) && nn>0) { trace$preds$ZZ <- read.table("trace_ZZ_1.out", header=FALSE) names(trace$preds$ZZ) <- paste("XX", 1:nn, sep="") if(rmfiles) unlink("trace_ZZ_1.out") if(verb >= 1) cat(" ZZ done\n") } ## kriging means at XX locations if(file.exists(paste("./", "trace_ZZkm_1.out", sep="")) && nn>0) { trace$preds$ZZ.km <- read.table("trace_ZZkm_1.out", header=FALSE) names(trace$preds$ZZ.km) <- paste("XX", 1:nn, sep="") if(rmfiles) unlink("trace_ZZkm_1.out") if(verb >= 1) cat(" ZZ.km done\n") } ## kriging vars at XX locations if(file.exists(paste("./", "trace_ZZks2_1.out", sep="")) && nn>0) { trace$preds$ZZ.ks2 <- read.table("trace_ZZks2_1.out", header=FALSE) names(trace$preds$ZZ.ks2) <- paste("XX", 1:nn, sep="") if(rmfiles) unlink("trace_ZZks2_1.out") if(verb >= 1) cat(" ZZ.ks2 done\n") } ## Ds2x samples at the XX locations if(file.exists(paste("./", "trace_Ds2x_1.out", sep="")) && nn>0) { trace$preds$Ds2x <- read.table("trace_Ds2x_1.out", header=FALSE) names(trace$preds$Ds2x) <- paste("XX", 1:nn, sep="") if(rmfiles) unlink("trace_Ds2x_1.out") if(verb >= 1) cat(" Ds2x done\n") } ## improv samples at the XX locations if(file.exists(paste("./", "trace_improv_1.out", sep="")) && nn>0) { trace$preds$improv <- read.table("trace_improv_1.out", header=FALSE) names(trace$preds$improv) <- paste("XX", 1:nn, sep="") if(rmfiles) unlink("trace_improv_1.out") if(verb >= 1) cat(" improv done\n") } ## assign class tgptraces to the returned object class(trace) <- "tgptraces" return(trace) } ## tgp.read.XX.traces ## ## particular function for reading the trace_XX_1.out file ## which contains traces of all GP (Base Model) parameters ## according to each XX location -- and then removes the file. "tgp.read.XX.traces" <- function(nn, dim, corr, verb=1, rmfiles=TRUE) { ## do nothing if there is no XX trace file file <- paste("./", "trace_XX_1.out", sep="") if(! file.exists(file)) return(NULL) ## calculate and count the names to the traces nam <- names(read.table(file, nrows=0, header=TRUE)) count <- length(nam) nam <- nam[2:length(nam)] ## read the rest of the trace file tr <- t(matrix(scan(file, quiet=TRUE, skip=1), nrow=count)) if(rmfiles) unlink(file) if(nn > 0) { traces <- list() for(i in 1:nn) { ## make tr into a matrix if it has only one entry (vector) if(is.null(dim(tr))) tr <- matrix(tr, nrow=1) ## find those rows which correspond to XX[i,] o <- tr[,1] == i ## print(c(sum(o), nrow(tr))) ## progress meter, overstimate % done, because things speed up if(verb >= 1) { if(i==nn) cat(" XX 100% done \r") else cat(paste(" XX ", round(100*log2(sum(o))/log2(nrow(tr))), "% done \r", sep="")) } ## save the ones for X[i,] traces[[i]] <- data.frame(tr[o,2:count]) ## remove the XX[i,] ones from t if(i!=nn) tr <- tr[!o,] ## reorder the trace file, and get rid of first column ## they could be out of order if using pthreads ## indx <- c(traces[[i+1]][,1] + 1) ## traces[[i+1]] <- traces[[i+1]][indx,2:(ncol-1)] ## assign the names if(sum(o) == 1) traces[[i]] <- t(traces[[i]]) names(traces[[i]]) <- nam } if(verb >= 1) cat("\n") } else { if(verb >= 1) { cat(paste(" no XX ", "traces\n", sep="")) } traces <- NULL; } return(traces) } tgp/R/tgp.default.params.R0000644000176200001440000003314513531032535015075 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## tgp.default.params: ## ## create a default parameter vector for tgp-class models with ## the specified dimension, mean function, correllation model ## and other augmentations specified in ... ## ## Note that the choice of bprior can negate the usefulness of ## (or override) some of the parameters, particularly the hierarchical ## parameters tau2.p and tau2.lam "tgp.default.params" <- function(d, meanfn=c("linear", "constant") , corr=c("expsep", "exp", "mrexpsep", "matern", "sim", "twovar"), splitmin=1, basemax=d, ...) { ## check the d argument, other check in tgp.check.params if(length(d) != 1) stop("d should be an integer scalar >= 1") ## check the splitmin argument, other check in tgp.check.params if(length(splitmin) != 1) stop("splitmin should be an integer scalar >= 1") ## check the basemax argument, other check in tgp.check.params if(length(basemax) != 1) stop("basemax should be an integer scalar >= 1") ## setting of col, the dim of (1,X) based on the mean function meanfn <- match.arg(meanfn) if(meanfn == "linear") { col <- d+1 } else if(meanfn == "constant"){ col <- 1 ## not sure why I ever had this code here ## if(basemax != d) { ## warning("must have basemax = d for constant mean function") ## basemax <- d ## } } ## adjust the starting beta and Wi values on basemax beta <- rep(0, min(col, basemax+1)) Wi <- diag(1, length(beta)) ## check the corr argument, and augment splitmin ## if fitting a multi-resolution model corr <- match.arg(corr) ## PERHAPS THIS SHOULD BE DONE IN THE C CODE SO THAT WHEN WE PRINT WITHIN C IT MAKES MORE SENSE if(corr=="mrexpsep") splitmin <- splitmin + 1 ## parameters shared by all models params <- list( tree=c(0.5,2,max(c(10,basemax+2)), # tree prior params ,, splitmin, basemax), # (continued) col=col, # defined above, based on meanfn meanfn=meanfn, # one of "linear" or "constant" bprior="bflat", # linear prior (b0, bmle, bflat, b0not, or bmzt) beta=beta, # start/prior vals for beta Wi=Wi, # start/prior vals for Wi s2tau2=c(1,1), # start vals for s2, and tau2 s2.p=c(5,10), # s2 prior params (initial values) and s2.lam=c(0.2,10), # s2 hierarc inv-gamma prior params (or "fixed") tau2.p=c(5,10), # tau2 prior params (initial values) and tau2.lam=c(0.2,0.1), # tau2 hierarch inv-gamma prior params (or "fixed") corr=corr, # correlation model (exp, expsep, matern, sim) gd=c(0.1, 0.5), # start vals for nug and d nug.p=c(1,1,1,1), # nug gamma-mix prior params (initial values) nug.lam="fixed", # nug hierarch gamma-mix prior params (or "fixed") gamma=c(10,0.2,0.7), # gamma linear pdf parameter d.p=c(1.0,20.0,10.0,10.0), # d gamma-mix prior params (initial values) delta.p=c(), # delta parameter for high fidelity variance nugf.p=c(), # residual process nugget gamma-mix prior params d.lam="fixed", # d lambda hierarch gamma-mix prior params (or "fixed") dp.sim=diag(0.2,basemax), # d-proposal covariance for sim correlaton nu=c() # matern correlation smoothing parameter ) ## parameters specific to multi-resolution corr model if(corr == "mrexpsep"){ mrd.p <- c(1,10,1,10) # gamma-mix params for the discr process (this for 'wigl') params$d.p <- c(params$d.p, mrd.p) params$delta.p <- c(1,1,1,1) params$nugf.p <- c(1,1,1,1) } ## Replace the parameters with ellipsis arguments, ## these should match the entries of params, or be "minpart" plist <- list( ... ) args <- names(plist) if(length(plist)>0) { pmatch <- match(args, c(names(params), "minpart")) for(i in 1:length(plist)){ if(args[i] == "minpart") params$tree[3] <- plist[[i]] else if(!is.na(pmatch[[i]])) params[[pmatch[i]]]<- plist[[i]] else stop(paste("your argument \"", args[i], "\" is not recognized", sep="")) } } return(params) } ## tgp.check.params: ## ## check that the parameter list describes a proper hierarchical parameter ## vector (of dimension d) -- and simultabiously convert the list into ## a double-vector to be passed to the C-side of tgp via .C "tgp.check.params" <- function(params, d) { ## check the number of parameters if(is.null(params)) return(matrix(-1)); if(length(params) != 22) { stop(paste("Number of params should be 22, you have", length(params), "\n")); } ## tree prior parameters if(length(params$tree) != 5) { stop(paste("length of params$tree should be 5, you have", length(params$tree), "\n")); } ## check tree minpart is bigger than input dimension basemax <- params$tree[5] if(params$tree[3] <= basemax) { stop(paste("tree minpart", params$tree[3], "should be > basemax =", basemax, "\n")); } ## check tree splitmin is <= than input dimension if(params$tree[4] < 1 || params$tree[4] > d) { stop(paste("tree splitmin", params$tree[4], "should be >= 1 and <= d =", d, "\n")); } ## check tree basemax is > splitmin and <= than input dimension if(basemax < 1 || params$tree[5] > d) { stop(paste("tree basemax", basemax, "should be >= 1 and <= d =", d, "\n")); } ## tree alpha and beta parameters p <- c(as.numeric(params$tree)) ## assign the mean function if(params$meanfn == "linear") { meanfn <- 0; if(params$col != d+1) stop(paste("col=", params$col, " should be d+1=", d+1, "with linear mean function", sep="")) } else if(params$meanfn == "constant"){ meanfn <- 1; if(params$col != 1) stop(paste("col=", params$col, " should be 1 with constant mean function", sep="")) } else { cat(paste("params$meanfn =", params$meanfn, "not valid\n")); meanfn <- 0; } p <- c(p, meanfn) ## beta linear prior model ## check the type of beta prior, and possibly augment by p0 if(params$bprior == "b0") { p <- c(p,0); } else if(params$bprior == "bmle") { p <- c(p, 1); } else if(params$bprior == "bflat") { p <- c(p, 2); } else if(params$bprior == "b0not") { p <- c(p, 3); } else if(params$bprior == "bmzt") { p <- c(p, 4); } else if(params$bprior == "bmznot") { p <- c(p, 5); } else { stop(paste("params$bprior =", params$bprior, "not valid\n")); } ## initial settings of beta linear prior mean parameters if(length(params$beta) != min(params$col, basemax+1)) { stop(paste("length of params$beta should be", min(params$col, basemax+1), "you have", length(params$beta), "\n")); } ## finally, set the params$beta p <- c(p, as.numeric(params$beta)) ## initial settings of the beta linear prior correlation parameters if(nrow(params$Wi) != length(params$beta) && ncol(params$Wi) != nrow(params$Wi)) { stop(paste("params$Wi should be", length(params$beta), "x", length(params$beta), "you have", nrow(params$Wi), "x", ncol(params$Wi), "\n")); } ## finally, set the params$Wi p <- c(p, as.numeric(params$Wi)) ## initial settings of variance parameters if(length(params$s2tau2) != 2) { stop(paste("length of params$s2tau2 should be 2 you have", length(params$s2tau2), "\n")); } p <- c(p, as.numeric(params$s2tau2)) ## sigma^2 prior parameters if(length(params$s2.p) != 2) { stop(paste("length of params$s2.p should be 2 you have", length(params$s2.p), "\n")); } p <- c(p, as.numeric(params$s2.p)) ## hierarchical prior parameters for sigma^2 (exponentials) or "fixed" if(length(params$s2.lam) != 2 && params$s2.lam[1] != "fixed") { stop(paste("length of params$s2.lam should be 2 or fixed, you have", params$s2.lam, "\n")); } if(params$s2.lam[1] == "fixed") p <- c(p, rep(-1, 2)) else p <- c(p, as.numeric(params$s2.lam)) ## tau^2 prior parameters if(length(params$tau2.p) != 2) { stop(paste("length of params$tau2.p should be 2 you have", length(params$tau2.p),"\n")); } p <- c(p, as.numeric(params$tau2.p)) ## hierarchical prior parameters for tau^2 (exponentials) or "fixed" if(length(params$tau2.lam) != 2 && params$tau2.lam[1] != "fixed") { stop(paste("length of params$s2.lam should be 2 or fixed, you have", params$tau2.lam, "\n")); } if(params$tau2.lam[1] == "fixed") p <- c(p, rep(-1, 2)) else p <- c(p, as.numeric(params$tau2.lam)) ## correllation model if(params$corr == "exp") { p <- c(p, 0); } else if(params$corr == "expsep") { p <- c(p, 1); } else if(params$corr == "matern") { p <- c(p, 2); } else if(params$corr == "mrexpsep") { p <- c(p,3) } else if(params$corr == "sim") { p <- c(p,4) } else if(params$corr == "twovar") { p <- c(p,5) } else { stop(paste("params$corr =", params$corr, "not valid\n")); } ## initial settings of variance parameters if(length(params$gd) != 2) { stop(paste("length of params$gd should be 2 you have", length(params$gd), "\n")); } p <- c(p, as.numeric(params$gd)) ## mixture of gamma (initial) prior parameters for nug if(length(params$nug.p) == 1 && params$nug.p[1] == 0) params$nug.p <- rep(0,4) if(length(params$nug.p) != 4) { stop(paste("length of params$nug.p should be 4 you have", length(params$nug.p),"\n")); } if(params$nug.p[1] == 0) params$nug.p[2] <- params$gd[1] p <- c(p, as.numeric(params$nug.p)) ## hierarchical prior params for nugget g (exponentials) or "fixed" if(length(params$nug.lam) != 4 && params$nug.lam[1] != "fixed") { stop(paste("length of params$nug.lam should be 4 or fixed, you have", params$nug.lam, "\n")); } if(params$nug.lam[1] == "fixed") p <- c(p, rep(-1, 4)) else p <- c(p, as.numeric(params$nug.lam)) ## gamma theta1 theta2 LLM prior params if(length(params$gamma) != 3) { stop(paste("length of params$gamma should be 3, you have", length(params$gamma),"\n")); } if(params$gamma[1] > 0 && params$corr == "sim") stop("cannot have sim corr with LLM") if(!prod(params$gamma[2:3] > 0)) stop("all params$gamma[2:3] must be positive\n") if(sum(params$gamma[2:3]) >= 1.0) stop("sum(gamma[2:3]) > 1 not allowed\n") p <- c(p, as.numeric(params$gamma)) ## mixture of gamma (initial) prior parameters for range parameter d ## if(length(params$d.p) == 1 && params$d.p[1] == 0) params$d.p <- rep(0,4) if(length(params$d.p) != 8 && params$corr == "mrexpsep") { stop(paste("length of params$d.p should be 8 you have", length(params$d.p),"\n")); } else if( length(params$d.p) != 4 && params$corr != "mrexpsep" ) { stop(paste("length of params$d.p should be 4 you have", length(params$d.p),"\n")); } if(params$d.p[1] == 0) params$d.p[2] <- params$gd[2] if(length(params$d.p) == 8 && params$d.p[5] == 0) params$d.p[6] <- params$gd[2] ## finally, set the params$d.p p <- c(p, as.numeric(params$d.p)) ## delta.p -- only do this if we are using mrexpsep if(length(params$delta.p) != 4 && params$corr == "mrexpsep") { stop(paste("length of params$delta.p should be 4 you have", length(params$delta.p),"\n")); } if(params$corr == "mrexpsep") p<- c(p, as.numeric(params$delta.p)) ## nugf.p -- only do this if we are using mrexpsep if(length(params$nugf.p) != 4 && params$corr == "mrexpsep") { stop(paste("length of params$delta.p should be 4 you have", length(params$nug.p),"\n")); } if(params$corr == "mrexpsep") p<- c(p, as.numeric(params$nugf.p)) ## hierarchical prior params for range d (exponentials) or "fixed" if(length(params$d.lam) != 4 && params$d.lam[1] != "fixed") { stop(paste("length of params$d.lam should be 4 or fixed, you have", length(params$d.lam),"\n")); } if(params$d.lam[1] == "fixed") p <- c(p, rep(-1, 4)) else p <- c(p, as.numeric(params$d.lam)) ## add sd for proposals for sim-d parameters if(params$corr == "sim") { if(nrow(params$dp.sim) != basemax || ncol(params$dp.sim) != basemax) stop("dp.sim should be ", basemax, "x", basemax, "\n"); p <- c(p,as.numeric(params$dp.sim)) } ## nu smoothness parameter for Matern correlation function if(params$corr == "matern") { if(params$nu < 0) stop(paste("nu should be greater than zero, you have", params$nu, "\n")) } p <- c(p, as.numeric(params$nu)) ## return the constructed double-vector of parameters for C return(p) } tgp/R/btgp.R0000644000176200001440000001514713531032535012334 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## btgp: ## ## tgp implementation of the Bayesian treed Gaussian process model "btgp" <- function(X, Z, XX=NULL, meanfn="linear", bprior="bflat", corr="expsep", tree=c(0.5,2), BTE=c(2000,7000,2), R=1, m0r1=TRUE, linburn=FALSE, itemps=NULL, pred.n=TRUE, krige=TRUE, zcov=FALSE, Ds2x=FALSE, improv=FALSE, sens.p=NULL, nu=1.5, trace=FALSE, verb=1, ...) { n <- nrow(X) if(is.null(n)) { n <- length(X); X <- matrix(X, nrow=n); d <- 1 } else { d <- ncol(X) } params <- tgp.default.params(d, meanfn=meanfn, corr=corr, ...) params$bprior <- bprior params$tree[1:length(tree)] <- tree params$gamma <- c(0,0.2,0.7) # no llm if(corr == "matern") params$nu<-nu if(linburn && corr == "sim") stop("cannot do linburn for SIM model") return(tgp(X,Z,XX,BTE,R,m0r1,linburn,params,itemps,pred.n,krige,zcov, Ds2x,improv,sens.p,trace,verb)) } ## bcart: ## ## tgp implementation of the Bayesian CART model of Chipman et al "bcart" <- function(X, Z, XX=NULL, bprior="bflat", tree=c(0.5,2), BTE=c(2000,7000,2), R=1, m0r1=TRUE, itemps=NULL, pred.n=TRUE, krige=TRUE, zcov=FALSE, Ds2x=FALSE, improv=FALSE, sens.p=NULL, trace=FALSE, verb=1, ...) { return(btlm(X,Z,XX,meanfn="constant", bprior,tree,BTE,R,m0r1,itemps,pred.n,krige, zcov,Ds2x,improv,sens.p,trace,verb,...)) } ## bgp: ## ## tgp implementation of a Bayesian Gaussian process model "bgp" <- function(X, Z, XX=NULL, meanfn="linear", bprior="bflat", corr="expsep", BTE=c(1000,4000,2), R=1, m0r1=TRUE, itemps=NULL, pred.n=TRUE, krige=TRUE, zcov=FALSE, Ds2x=FALSE, improv=FALSE, sens.p=NULL, nu=1.5, trace=FALSE, verb=1, ... ) { n <- dim(X)[1] if(is.null(n)) { n <- length(X); X <- matrix(X, nrow=n); d <- 1 } else { d <- dim(X)[2] } params <- tgp.default.params(d, meanfn=meanfn, corr=corr,...) params$bprior <- bprior params$tree[1:2] <- c(0,0) # no tree params$gamma <- c(0,0.2,0.7) # no llm if(corr == "matern") params$nu <- nu return(tgp(X,Z,XX,BTE,R,m0r1,FALSE,params,itemps,pred.n,krige,zcov,Ds2x, improv,sens.p,trace,verb)) } ## bgpllm: ## ## tgp implementation of a Bayesian Gaussian Process with ## jumps to the Limiting Linear Model "bgpllm" <- function(X, Z, XX=NULL, meanfn="linear", bprior="bflat", corr="expsep", gamma=c(10,0.2,0.7), BTE=c(1000,4000,2), R=1, m0r1=TRUE, itemps=NULL, pred.n=TRUE, krige=TRUE, zcov=FALSE, Ds2x=FALSE, improv=FALSE, sens.p=NULL, nu=1.5, trace=FALSE, verb=1, ...) { n <- dim(X)[1] if(is.null(n)) { n <- length(X); X <- matrix(X, nrow=n); d <- 1 } else { d <- dim(X)[2] } params <- tgp.default.params(d, meanfn=meanfn, corr=corr, ...) params$bprior <- bprior params$gamma <- gamma params$tree[1:2] <- c(0,0) # no tree if(corr == "matern"){ params$nu <- nu; } if(corr == "mrexpsep"){ stop("Sorry, the LLM is not yet available for corr=\"mrexpsep\"")} if(corr == "sim"){ stop("Sorry, the LLM is not available for corr=\"sim\"")} return(tgp(X,Z,XX,BTE,R,m0r1,FALSE,params,itemps,pred.n,krige,zcov,Ds2x, improv,sens.p,trace, verb)) } ## blm: ## ## tgp implementation of a Bayesian hierarchical Linear Model "blm" <- function(X, Z, XX=NULL, meanfn="linear", bprior="bflat", BTE=c(1000,4000,3), R=1, m0r1=TRUE, itemps=NULL, pred.n=TRUE, krige=TRUE, zcov=FALSE, Ds2x=FALSE, improv=FALSE, sens.p=NULL, trace=FALSE, verb=1, ...) { n <- dim(X)[1] if(is.null(n)) { n <- length(X); X <- matrix(X, nrow=n); d <- 1 } else { d <- dim(X)[2] } params <- tgp.default.params(d, meanfn=meanfn, ...) params$bprior <- bprior params$tree[1:2] <- c(0,0) # no tree params$gamma <- c(-1,0.2,0.7) # force llm params$nug.p <- 0 ## force a fixed nugget params$gd[1] <- 0 ## fix the nugget at zero return(tgp(X,Z,XX,BTE,R,m0r1,FALSE,params,itemps,pred.n, krige,zcov,Ds2x,improv,sens.p,trace,verb)) } ## btgpllm: ## ## tgp implementation of a Bayesian treed Gaussian Process model ## with jumps to the Limiting Linear Model "btgpllm" <- function(X, Z, XX=NULL, meanfn="linear", bprior="bflat", corr="expsep", tree=c(0.5,2), gamma=c(10,0.2,0.7), BTE=c(2000,7000,2), R=1, m0r1=TRUE, linburn=FALSE, itemps=NULL, pred.n=TRUE, krige=TRUE, zcov=FALSE, Ds2x=FALSE, improv=FALSE, sens.p=NULL, nu=1.5, trace=FALSE, verb=1, ...) { n <- nrow(X) if(is.null(n)) { n <- length(X); X <- matrix(X, nrow=n); d <- 1 } else { d <- ncol(X) } params <- tgp.default.params(d, meanfn=meanfn, corr=corr,...) params$bprior <- bprior params$tree[1:length(tree)] <- tree params$gamma <- gamma if(corr == "matern"){ params$nu <- nu } if(corr == "mrexpsep"){ stop("Sorry, the LLM is not yet available for corr=\"mrexpsep\"")} if(corr == "sim"){ stop("Sorry, the LLM is not available for corr=\"sim\"")} return(tgp(X,Z,XX,BTE,R,m0r1,linburn,params,itemps,pred.n,krige,zcov, Ds2x,improv,sens.p,trace,verb)) } "btlm" <- function(X, Z, XX=NULL, meanfn="linear", bprior="bflat", tree=c(0.5,2), BTE=c(2000,7000,2), R=1, m0r1=TRUE, itemps=NULL, pred.n=TRUE, krige=TRUE, zcov=FALSE, Ds2x=FALSE, improv=FALSE, sens.p=NULL, trace=FALSE, verb=1, ...) { n <- nrow(X) if(is.null(n)) { n <- length(X); X <- matrix(X, nrow=n); d <- 1 } else { d <- ncol(X) } params <- tgp.default.params(d, meanfn=meanfn, ...) params$bprior <- bprior params$tree[1:length(tree)] <- tree params$gamma <- c(-1,0.2,0.7) # no llm params$nug.p <- 0 ## force a nugget params$gd[1] <- 0 ## fix the nugget at zero return(tgp(X,Z,XX,BTE,R,m0r1,FALSE,params,itemps,pred.n,krige,zcov, Ds2x,improv,sens.p, trace,verb)) } tgp/R/tgp.cleanup.R0000644000176200001440000001141413531032535013611 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## tgp.cleanup ## ## gets called when the C-side is aborted by the R-side and enables ## the R-side to clean up the memory still allocaed to the C-side, ## as well as whatever files were left open on the C-side "tgp.cleanup" <- function(message="INTERRUPT", verb, rmfiles=TRUE) { .C("tgp_cleanup", PACKAGE = "tgp") ## remove the trace (and other) files? if(rmfiles) { if(file.exists(paste("./", "best_parts_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed best_parts_1.out\n", sep="")) unlink("best_parts_1.out") } if(file.exists(paste("./", "tree_m0_posts.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed tree_m0_posts.out\n", sep="")) unlink("tree_m0_posts.out") } if(file.exists(paste("./", "trace_parts_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_parts_1.out\n", sep="")) unlink("trace_parts_1.out") } if(file.exists(paste("./", "trace_post_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_post_1.out\n", sep="")) unlink("trace_post_1.out") } if(file.exists(paste("./", "trace_wlambda_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_wlambda_1.out\n", sep="")) unlink("trace_wlambda_1.out") } if(file.exists(paste("./", "trace_hier_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_hier_1.out\n", sep="")) unlink("trace_hier_1.out") } if(file.exists(paste("./", "trace_linarea_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_linarea_1.out\n", sep="")) unlink("trace_linarea_1.out") } if(file.exists(paste("./", "trace_XX_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_XX_1.out\n", sep="")) unlink("trace_XX_1.out") } if(file.exists(paste("./", "trace_Zp_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_Zp_1.out\n", sep="")) unlink("trace_Zp_1.out") } if(file.exists(paste("./", "trace_Zpkm_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_Zpkm_1.out\n", sep="")) unlink("trace_Zpkm_1.out") } if(file.exists(paste("./", "trace_Zpks2_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_Zpks2_1.out\n", sep="")) unlink("trace_Zpks2_1.out") } if(file.exists(paste("./", "trace_ZZ_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_ZZ_1.out\n", sep="")) unlink("trace_ZZ_1.out") } if(file.exists(paste("./", "trace_ZZkm_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_ZZkm_1.out\n", sep="")) unlink("trace_ZZkm_1.out") } if(file.exists(paste("./", "trace_ZZks2_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_ZZks2_1.out\n", sep="")) unlink("trace_ZZks2_1.out") } if(file.exists(paste("./", "trace_improv_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_improv_1.out\n", sep="")) unlink("trace_improv_1.out") } if(file.exists(paste("./", "trace_Ds2x_1.out", sep=""))) { if(verb >= 1) cat(paste(message, ": removed trace_Ds2x_1.out\n", sep="")) unlink("trace_Ds2x_1.out") } ## get all of the names of the tree files tree.files <- list.files(pattern="tree_m0_[0-9]+.out") ## for each tree file if(length(tree.files > 0)) { for(i in 1:length(tree.files)) { if(verb >= 1) cat(paste(message, ": removed ", tree.files[i], "\n", sep="")) if(rmfiles) unlink(tree.files[i]) } } } if(verb >= 1 && message == "INTERRUPT") cat("\n") } tgp/R/friedman.1.data.R0000644000176200001440000000553113531032535014230 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## friedman.1.data: ## ## generate a random sample of size n from Friedman's 10-d ## first data set used to validate the MARS method -- the ## response depends linearly and non-linearly on the first ## five inputs only "friedman.1.data" <- function(n=100) { X <- matrix(runif(n*10), nrow=n) Ytrue <- 10*sin(pi*X[,1]*X[,2]) + 20*(X[,3]-0.5)^2 + 10*X[,4] + 5*X[,5] Y <- Ytrue + rnorm(n, 0, 1) return(data.frame(X,Y,Ytrue)) } ## fried.bool: ## ## generate a random sample of size n from a boolean segmented ## version of Friedman's 10-d first data set used to validate the ## MARS method -- the response depends linearly and non-linearly ## on the first five inputs only, but now which part of the function ## is on depends on an indicator 1:4 "fried.bool" <- function(n=100) { ## a function that is a sum of parts f1 <- function(X) { 10*sin(pi*X[,1]*X[,2]) } f2 <- function(X) { 20*(X[,3]-0.5)^2 } f3 <- function(X) { 10*X[,4] + 5*X[,5] } f4 <- function(X) { 10*sin(pi*X[,5]*X[,4]) + 20*(X[,3]-0.5)^2 + 10*X[,2] + 5*X[,1] } fs <- list(f1, f2, f3, f4) ## boolean codings of 1:4 BoolI <- rbind(c(0,0,0), c(0,0,1), c(0,1,0), c(1,0,0)) ## sample n indicators in 1:4 and record their boolean coding I <- sample(c(1,2,3,4), n, replace=TRUE) Imat <-matrix(BoolI[I,], nrow=n) ## n random inputs U(0,1) in 10 dimensions X <- matrix(runif(n*10), nrow=n) ## allocate space for the true response Ytrue <- rep(0, n) ## calculate responses for each of the four groups for(i in 1:4) { indx <- I == i if(sum(indx) == 0) next; indx <- (1:n)[indx] XX <- matrix(X[indx,], ncol=10) Ytrue[indx] <- fs[[i]](XX) } ## add some noise Y <- Ytrue + rnorm(n, 0, 1) ## return the inputs, bookean coding and outputs return(data.frame(X=X, I=Imat, Y, Ytrue)) } tgp/R/tgp.plot.proj.R0000644000176200001440000001244113531032535014112 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* "tgp.plot.proj" <- function(out, pparts=TRUE, proj=NULL, map=NULL, as=as, center="mean", layout=layout, main=NULL, xlab=NULL, ylab=NULL, zlab=NULL, pc="pc", gridlen=40, span=0.1, pXX=TRUE, rankmax=20,...) { ## will call stop() if something is wrong with the proj proj <- check.proj(proj) ## deal with axis labels if(is.null(xlab)) xlab <- names(out$X)[proj[1]] if(is.null(ylab)) ylab <- names(out$X)[proj[2]] if(is.null(zlab)) zlab <- out$response ## choose center as median or mean (i.e., X & Z data) center <- tgp.choose.center(out, center); Z.mean <- center$Z smain <- paste(main, zlab, center$name); X <- center$X[,proj] if(is.null(dim(X))) { nX <- length(X); dX <- 1 } else { nX <- dim(X)[1]; dX <- dim(X)[2] } p <- seq(1,nX) ## for ALC and EGO plotting as <- tgp.choose.as(out, as); XX <- as$X[,proj] ZZ.q <- as$criteria emain <- paste(main, zlab, as$name) if(is.null(dim(XX))) { nXX <- length(XX); dXX <- 1 } else { nXX <- dim(XX)[1]; dXX <- dim(XX)[2] } pp <- seq(1,nXX); # if no data then do nothing if(length(Z.mean) == 0) { cat("NOTICE: no predictive data; nothing to plot\n") return() } # prepare for plotting if(layout == "both") par(mfrow=c(1,2), bty="n") # else par(mfrow=c(1,1), bty="n") if(dX == 1) { # 1-d projections if(layout == "both" || layout == "surf") { plot(out$X[,proj], out$Z, xlab=xlab, ylab=zlab, main=smain, ...) if(pXX) points(out$XX[,proj], out$ZZ.mean, pch=20, cex=0.5, ...) Zb.q1 <- c(out$Zp.q1, out$ZZ.q1) Zb.q2 <- c(out$Zp.q2, out$ZZ.q2) r <- range(X) segments(x0=X, y0=Zb.q1, x1=X, y1=Zb.q2, col=2) # plot partitions if(pparts & !is.null(out$parts) ) { tgp.plot.parts.1d(out$parts[,proj]) } } if(layout == "both" || layout == "as") { # error/as plot plot(XX, ZZ.q, ylab=as$name, xlab=xlab, main=emain, ...) if(pparts & !is.null(out$parts) ) { tgp.plot.parts.1d(out$parts[,proj]) } } } else if(pc == "pc") { # perspective and image plots if(layout == "both" || layout == "surf") slice.persp(X[,1],X[,2],p,Z.mean,xlab=xlab,ylab=ylab,zlab=zlab,main=smain, gridlen=gridlen,span=span,...) if(layout == "both" || layout == "as") { # error/as plot slice.image(XX[,1],XX[,2],pp,ZZ.q,xlab=xlab,ylab=ylab,main=emain, gridlen=gridlen,span=span,...) if(pXX && !is.null(out$XX)) points(out$XX[,proj], pch=21, ...) if(!is.null(map)) { lines(map, col="black", ...) } points(out$X[,proj],pch=20, ...) if(pparts & !is.null(out$parts)) { tgp.plot.parts.2d(out$parts, dx=proj) } if(substr(as$name,1,1) == "I"){ ranks <- out$improv[,2] <= rankmax text(out$XX[ranks,proj[1]], out$XX[ranks,proj[2]], labels=out$improv[ranks,2], pos=3, font=2,...) } } } else if(pc == "c") { # double-image plot if(layout == "both" || layout == "surf") { slice.image(X[,1],X[,2],p,Z.mean,xlab=xlab,ylab=ylab,main=smain, gridlen=gridlen,span=span,...) if(!is.null(map)) { lines(map, col="black", ...) } points(out$X[,proj],pch=20, ...) if(pXX && !is.null(out$XX)) points(out$XX[,proj], pch=21, ...) if(pparts & !is.null(out$parts)) { tgp.plot.parts.2d(out$parts, dx=proj) } } if(layout == "both" || layout == "as") { slice.image(XX[,1],XX[,2],pp,ZZ.q,xlab=xlab,ylab=ylab,main=emain, gridlen=gridlen,span=span,...) if(!is.null(map)) { lines(map, col="black", ...) } points(out$X[,proj],pch=20, ...) if(pXX && !is.null(out$XX)) points(out$XX[,proj], pch=21, ...) if(pparts & !is.null(out$parts)) { tgp.plot.parts.2d(out$parts, dx=proj) } if(substr(as$name,1,1) == "I"){ ranks <- out$improv[,2] <= rankmax text(out$XX[ranks,proj[1]], out$XX[ranks,proj[2]], labels=out$improv[ranks,2], pos=3, font=2,...) } } } else { stop(paste(pc, "not a valid plot option\n")) } } "check.proj" <- function(proj) { if(is.null(proj)) proj <- c(1,2) if(length(proj) > 2) { stop(paste("length(proj) = ", length(proj), "should be <= 2\n")) } ## will stop if the proj is not ok, ## otherwise returns the (possibly modified) proj return(proj) } tgp/R/print.tgp.R0000644000176200001440000001076413531032535013325 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## print.tgp ## ## generic print method for tgp-class objects ## (doesn't do much now except list the fields of the tgp-class list "print.tgp" <- function(x, ...) { cat("\nThis is a 'tgp' class object. ", "It is basically a list with the following entries:\n", fill=TRUE) print(names(x), quote=FALSE) cat("\nSee ?btgp for an explanation of the individual entries. ", "See plot.tgp and tgp.trees for help with visualization.\n", fill=TRUE) cat("The $trace field, if it exists, is of class 'tgptraces'", "and has its own print statement\n", fill=TRUE) } ## print.tgptraces ## ## generic print method for tgptraces-class objects ## describes the contents of each field in the list, as well as ## sub-fields where appropriate. Some fields may be empty, or have ## sub-fields which depend on the type of analysis, and this ## is indicated "print.tgptraces" <- function(x, ...) { cat("\nThis 'tgptraces'-class object contains traces of the parameters\n") cat("to a tgp model. Access is as a list:\n\n") ## info about XX cat(paste("1.) $XX contains the traces of GP parameters for ", length(x$XX), " predictive\n", sep="")) cat(" locations\n\n") if(length(x$XX) > 0) { if(length(x$XX) == 1) { cat(paste("\n$XX[[1]]" , sep="")) } else { cat(paste(" Each of $XX[[1]] ... $XX[[", length(x$XX), "]]", sep="")) } cat(paste(" is a data frame with the\n columns representing GP parameters:\n\n", sep="")) print(names(x$XX[[1]]), quote=FALSE) } else cat(" ** The $XX list is empty because XX=NULL, or T-B=0\n") ## info about hierarchial params cat("\n2.) $hier has a trace of the hierarchical params:\n", sep="", fill=TRUE) if(!is.null(names(x$hier))) print(names(x$hier), quote=FALSE) else cat(" ** $hier is empty because T-B=0\n") ## info about linarea cat("\n3.) $linarea has a trace of areas under the LLM. It is a \n") cat(" data frame with columns:\n\n") cat(" count: number of booleans b=0, indicating LLM\n") cat(" la: area of domain under LLM\n") cat(" ba: area of domain under LLM weighed by dim\n") if(length(x$linarea) <= 0) { cat("\n ** $linarea is empty since you fit a model which \n") cat(" ** either forced the LLM (btlm, blm), or disallowed\n") cat(" ** it (bgp, btgp)\n") } ## info about parts cat("\n4.) $parts contains all of the partitions visited. Use the\n") cat(" tgp.plot.parts.[1d,2d] functions for visuals\n") if(length(x$parts) <= 0) { cat("\n ** $parts is empty since you fit a non-treed model\n") } ## info about posts cat("\n5.) $post is a data frame with columns showing the following:\n") cat(" log posterior ($lpost), tree height ($height) and leaves\n") cat(" ($leaves), IS weights ($w), tempered log posterior ($tlpost),\n") cat(" inv-temp ($itemp), and weights adjusted for ESS ($wlambda)\n") if(is.null(x$post)) cat("\n ** $posts is empty since T-B=0\n") ## info about ZZ cat("\n6.) $preds is a list containing data.frames for samples from\n") cat(" the posterior predictive distributions data (X) locations\n") cat(" (if pred.n=TRUE: $Zp, $Zp.km, $Zp.ks2) and (XX) locations\n") cat(" (if XX != NULL: $ZZ, $ZZ.km, $ZZ.ks2), with $Ds2x when\n") cat(" input argument ds2x=TRUE, and $improv when improv=TRUE\n\n") if(length(x$preds) <= 0) { cat(" ** $preds is empty because pred.n=FALSE and XX=NULL, or T-B=0\n\n") } } tgp/R/lhs.R0000644000176200001440000000554213531032535012164 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## lhs: ## ## generate a Latin Hypercube Sample of size n within the rectangle ## provided. The default "prior" for the sample is uniform, but the ## shape and mode arguments can be used to describe a beta distribution ## in each dimension. The actual sample is generated C-side "lhs" <- function(n, rect, shape=NULL, mode=NULL) { ## sanity checks if(length(n) != 1) stop(paste("length(n) should be 1, you have", length(n))) if(n < 0) stop(paste("n should be positive, you have", n)) if(n == 0) return(NULL) ## get and check the rectangle dimensions if(is.null(dim(rect))) { ncol <- length(rect); d <- 1 } else { ncol <- ncol(rect); d <- dim(rect)[1] } if(ncol != 2) stop("ncol(rect) must be 2") ## check the shape argument should be positive and of length if(!is.null(shape) && length(shape) != d && all(shape > 0)) stop(paste("For beta sampling, length(shape) should be ", d, ", you have ", length(shape), ", and all positive", sep="")) if(is.null(shape)) shape <- -1 ## check the mode argument is positive and of length 1 if(!is.null(mode) && length(mode) != d && all(mode > 0)) stop(paste("To specify sampling modes, length(mode) should be ", d, ", you have ", length(mode), ", and all positive", sep="")) if(is.null(mode)) mode <- -1 ## choose a random state for the C code state <- sample(seq(0,999), 3) ## run the C code ll <- .C("lh_sample", state = as.integer(state), n = as.integer(n), d = as.integer(d), rect = as.double(rect), # no need to transpose shape = as.double(shape), mode = as.double(mode), s = double(n*d), PACKAGE="tgp" ) ## just return the samples return(t(matrix(ll$s, nrow=d))) } tgp/R/predict.tgp.R0000644000176200001440000002054713531032535013623 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## predict.tgp: ## ## generic the master tgp R function which takes most of its inputs ## from a tgp-object. Most of the changeable outputs have to do with ## sampling from the posterior predictive distribution (hence a predict ## method). It checks for valid inputs and then calls the C-side via .C ## on those inputs -- and then calls the post-processing code accordingly "predict.tgp" <- function(object, XX=NULL, BTE=c(0,1,1), R=1, MAP=TRUE, pred.n=TRUE, krige=TRUE, zcov=FALSE, Ds2x=FALSE, improv=FALSE, sens.p=NULL, trace=FALSE, verb=0, ...) { ## (quitely) double-check that tgp is clean before-hand tgp.cleanup(message="NOTICE", verb=verb, rmfiles=TRUE); ## what to do if fatally interrupted? on.exit(tgp.cleanup(verb=verb, rmfiles=TRUE)) if(object$params$corr == "mrexpsep" && !is.null(sens.p)) stop("Sorry, sensitivity analysis is not yet available for corr=\"mrexpsep\"") ## get names Xnames <- names(object$X) response <- names(object$Z) ## check XX XX <- check.matrix(XX)$X if(is.null(XX)) { nn <- 0; XX<- matrix(0); nnprime <- 0 } else { nn <- nrow(XX); nnprime <- nn if(ncol(XX) != object$d) stop("mismatched column dimension of object$X and XX"); } ## check that pred.n, krige, MAP, and Ds2x is true or false if(length(pred.n) != 1 || !is.logical(pred.n)) stop("pred.n should be TRUE or FALSE") if(length(krige) != 1 || !is.logical(krige)) stop("krige should be TRUE or FALSE") if(length(zcov) != 1 || !is.logical(zcov)) stop("zcov should be TRUE or FALSE") if(length(MAP) != 1 || !is.logical(MAP)) stop("MAP should be TRUE or FALSE") if(length(Ds2x) != 1 || !is.logical(Ds2x)) stop("Ds2x should be TRUE or FALSE") ## check the form of the improv-power argument if(length(improv) == 2) { numirank <- improv[2]; improv <- improv[1] } else { numirank <- NULL } if(length(improv) != 1 || !(is.logical(improv) || is.numeric(improv)) || (is.numeric(improv) && improv <= 0)) stop(paste("improv [", improv, "] should be TRUE, FALSE, or a positive integer (power)", sep="")) g <- as.numeric(improv) ## check numirank, which is improv[2] in input if(is.null(numirank) && improv) numirank <- max(min(10, nn), 0.1*nn) else if(!is.null(numirank) && numirank > nn) stop("improv[2] must be <= nrow(XX)") else if(is.null(numirank)) numirank <- 0 ## check for inconsistent XX and Ds2x/improv if(nn == 0 && (Ds2x || improv)) warning("need to specify XX locations for Ds2x and improv") ## check the sanity of input arguments if(nn > 0 && sum(dim(XX)) > 0 && ncol(XX) != object$d) stop("XX has bad dimensions") if(BTE[1] < 0 || BTE[2] <= 0 || BTE[1] >= BTE[2]) stop("bad B and T: must have 0<=B=E") ## might scale Z to mean of 0 range of 1 if(object$m0r1) { Zm0r1 <- mean0.range1(object$Z); Z <- Zm0r1$X } else { Z <- object$Z; Zm0r1 <- NULL } ## get infor about the tree m <- which.max(object$posts$lpost) t2c <- tree2c(object$trees[[object$posts$height[m]]]) # RNG seed state <- sample(seq(0,999), 3) ## get itemps from object, but set c0n0 <- c(0,0) ## so no stochastic approx happens object$itemps$c0n0 <- c(0,0) itemps <- check.itemps(object$itemps, object$params) ## if performing a sensitivity analysis, set up XX if(!is.null(sens.p)){ nnprime <- 0 if(nn > 0) warning("XX generated online in sensitivity analyses") sens.par <- check.sens(sens.p, object$d) nn <- sens.par$nn; nn.lhs <- sens.par$nn.lhs; XX <- sens.par$XX ngrid <- sens.par$ngrid; span <- sens.par$span MEgrid <- as.double(sens.par$MEgrid) if(verb >= 1) cat(paste("Predict at", nn, "LHS XX locs for sensitivity analysis\n")) } else{ nn.lhs <- ngrid <- 0; MEgrid <- span <- double(0) } ## calculate the number of sampling rounds S = R*(BTE[2]-BTE[1])/BTE[3] ## run the C code ll <- .C("tgp", ## begin inputs state = as.integer(state), X = as.double(t(object$X)), n = as.integer(object$n), d = as.integer(object$d), Z = as.double(Z), XX = as.double(t(XX)), nn = as.integer(nn), Xsplit = as.double(t(object$Xsplit)), nsplit = as.integer(nrow(object$Xsplit)), trace = as.integer(trace), BTE = as.integer(BTE), R = as.integer(R), linburn = as.integer(FALSE), zcov = as.integer(zcov), g = as.integer(c(g, numirank)), dparams = as.double(object$dparams), itemps = as.double(itemps), verb = as.integer(verb), tree = as.double(c(ncol(t2c),t(t2c))), hier = as.double(object$posts[m,3:ncol(object$posts)]), MAP = as.integer(MAP), sens.ngrid = as.integer(ngrid), sens.span = as.double(span), sens.Xgrid = MEgrid, ## output dimensions for checking NULL pred.n = as.integer(pred.n), nnprime = as.integer(nnprime), krige = as.integer(krige), bDs2x = as.integer(Ds2x), improv = as.integer(as.logical(improv) * nnprime), ## begin outputs Zp.mean = double(pred.n * object$n), ZZ.mean = double(nnprime), Zp.km = double(krige * pred.n * object$n), ZZ.km = double(krige * nnprime), Zp.vark = double(krige * pred.n * object$n), ZZ.vark = double(krige * nnprime), Zp.q = double(pred.n * object$n), ZZ.q = double(nnprime), Zp.s2 = double(pred.n * (zcov*object$n^2) + (!zcov)*object$n), ZZ.s2 = double(zcov*nnprime^2 + (!zcov)*nnprime^2), ZpZZ.s2 = double(pred.n * object$n * nnprime * zcov), Zp.ks2 = double(krige * pred.n * object$n), ZZ.ks2 = double(krige * nnprime), Zp.q1 = double(pred.n * object$n), Zp.med = double(pred.n * object$n), Zp.q2 = double(pred.n * object$n), ZZ.q1 = double(nnprime), ZZ.med = double(nnprime), ZZ.q2 = double(nnprime), Ds2x = double(Ds2x * nnprime), improv = double(as.logical(improv) * nnprime), irank = integer(as.logical(improv) * nnprime), ess = double(1 + itemps[1]*2), gpcs = double(4), sens.ZZ.mean = double(ngrid*object$d), sens.ZZ.q1 = double(ngrid*object$d), sens.ZZ.q2 = double(ngrid*object$d), sens.S = double(object$d*S*!is.null(sens.p)), sens.T = double(object$d*S*!is.null(sens.p)), ## end outputs PACKAGE = "tgp") ## post-process before returning ll <- tgp.postprocess(ll, Xnames, response, pred.n, zcov, Ds2x, improv, sens.p, Zm0r1, object$params, TRUE) return(ll) } ## tree2c ## ## converts the list-and-data.frame style tree contained in ## the tgp-class object into a C-style double-vector so that ## the C-side can start from the MAP tree contained in the object "tree2c" <- function(t) { ## change var into a numeric vector var <- as.character(t$var) var[var == ""] <- -1 var <- as.numeric(var) ## to return tr <- data.frame(rows=t$rows, var=var) tr <- cbind(tr, t[,8:ncol(t)]) ## order the rows by the row column o <- order(tr[,1]) tr <- tr[o,] return(as.matrix(tr)) } tgp/R/mean0.range1.R0000644000176200001440000000566013531032535013553 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## mean0.range1: ## ## translate the input columns (X.m) to each (independently) ## have a mean of zero and a range of one -- as used by Chipman ## et al. Also save the necessary mean and range information ## so that the transformation can be undone later "mean0.range1" <- function(X.m) { ## checks and coersion into a matrix if(is.null(X.m)) return(NULL) else if(is.null(dim(X.m))) X <- matrix(X.m, ncol=1) else X <- X.m ## initialize the information necesary for undoing undo <- list() undo$min <- rep(0, ncol(X)) undo$max <- rep(0, ncol(X)) undo$amean <- rep(0, ncol(X)) ## make the transformation in each dimension for(i in 1:ncol(X)) { undo$min[i] <- min(X[,i]) undo$max[i] <- max(X[,i]) X[,i] <- X[,i] / (max(X[,i]) - min(X[,i])) undo$amean[i] <- mean(X[,i]) X[,i] <- X[,i] - mean(X[,i]) } ## convert input vectors back into vectors if(is.null(dim(X.m))) X.m <- as.vector(X) else X.m <- X ## return both the transformed data and the info to undo return(list(X=X,undo=undo)) } ## undo.mean0.range1: ## ## using the info saved by mean0.range1, undo the transformation ## on X -- usually the undo is performed on new data that is curently ## on the scale of the transformed X, but should be reported on the ## scale of the original (unransformed) X "undo.mean0.range1" <- function(X.m, undo, nomean=FALSE, s2=FALSE) { ## checks and coerse into a matrix if(is.null(X.m)) return(NULL) else if(is.null(dim(X.m))) X <- matrix(X.m, ncol=1) else X <- X.m ## undo in each column of X for(i in 1:(dim(X)[2])) { if(!nomean) X[,i] <- X[,i] + undo$amean[i] if(s2) X[,i] <- X[,i]*(undo$max[i] - undo$min[i])^2 else X[,i] <- X[,i]*(undo$max[i] - undo$min[i]) } ## convert input vectors back into vectors if(is.null(dim(X.m))) X.m <- as.vector(X) else X.m <- X ## return the undone transformation return(X.m) } tgp/R/sens.R0000644000176200001440000001761013531032535012345 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## check.sens: ## ## function to check the sens.p argument provided as input ## to the sens or b* functions, depending on the imput dimension ## d "check.sens" <- function(sens.p, d) { ## sanity checks if(d==1) stop("You don't need sensitivity analysis for a single variable.") if(length(sens.p)!=(4*d+3)) stop("bad sens length.") ## nn.lhs is 'nm' in the .cc code. nn.lhs <- sens.p[1] nn <-nn.lhs*(d+2) ## The XX matrix is of the correct size for within the .cc code. ## This may or may not be necessary. ## The first 3 rows contain the LHS parameters to begin with. XX <- matrix(rep(0,nn*d),nrow=nn, ncol=d) XX[1:2,] <- matrix(sens.p[2:(2*d+1)], nrow=2) ## this is rect ## check shape for validity, and copy to XX shape <- XX[3,] <- sens.p[(2*d+2):(3*d+1)] if(length(shape) != d || !all(shape >= 0)) { print(shape) stop(paste("shape should be a non-negative ", d, "-vector", sep="")) } ## check mode for validity, and copy to XX mode <- XX[4,] <- sens.p[(3*d+2):(4*d+1)] if(length(mode) != d) { print(mode) stop(paste("mode should be a ", d, "-vector", sep="")) } ## check each coordinate of the mode argument for(i in 1:d){ if(mode[i] < XX[1,i] || mode[i] > XX[2,i]){ stop(paste("mode ", i, " should be within bounds [", XX[1,i],", ", XX[2,i],"]", sep="")) } } ## Create the Main Effect Grid ngrid <- sens.p[4*d+2] span <- sens.p[4*d+3] if((span > 1) || (span < 0)) stop("Bad smoothing span -- must be in (0,1).") MEgrid <- matrix(ncol=d, nrow=ngrid) for(i in 1:d){ MEgrid[,i] <- seq(XX[1,i], XX[2,i], length=ngrid) } ## return list(nn=nn, nn.lhs=nn.lhs, ngrid=ngrid, span=span, XX=XX, MEgrid=MEgrid) } ## sens: ## ## code for performaing a sensitivity analysis using the specified ## model and nn.lhs LHS re-sampled predictive grid for each of the T ## rounds under a beta prior specified by shape and mode "sens" <- function(X, Z, nn.lhs, model=btgp, ngrid=100, span=0.3, BTE=c(3000,8000,10), rect=NULL, shape=NULL, mode=NULL, ...) { ## the format for rect is the same as rect in LHS (ncol=2, nrow=d). Xnames <- names(X) XZ <- check.matrix(X, Z) X <- data.frame(XZ$X); names(X) <- Xnames; Z <- XZ$Z; ## process the rect, shape and mode arguments d <- ncol(as.matrix(X)) if(is.null(rect)) rect <- t(apply(as.matrix(X),2,range)) else if(nrow(rect) != d || ncol(rect) != 2) stop(paste("rect should be a ", d, "x2-vector", sep="")) ## check the shape LHS parameter vector if(is.null(shape)) shape <- rep(1,d) else if(length(shape) != d || !all(shape >= 0)) { print(shape) stop(paste("shape should be a non-negative ", d, "-vector", sep="")) } ## check the mode LHS parameter vector if(is.null(mode)) mode <- apply(as.matrix(X),2,mean) else if(length(mode) != d) { print(mode) stop(paste("mode should be a ", d, "-vector", sep="")) } ## check the LHS rectangle in the categorical variable context for(i in 1:d){ if(shape[i]==0){ if(rect[i,1] != 0 || rect[i,2] != 1){ print(rect[i,]) stop(paste("rect must be [0,1] for categorical variables (i=", i,", shape[i]=",shape[i],").", sep="")) } } } ## build the sens parameter sens.p <- c(nn.lhs,t(rect),shape,mode,ngrid,span) ## run the b* function (model) with the sens parameter, or otherwise ## just return the parameter vector and do nothing if(!is.null(model)){ return(model(X,Z,sens.p=sens.p,BTE=BTE,...)) } else{ return(sens.p) } } ## sens.plot: ## ## function for plotting the results of a sensitivity analysis -- ## intended to be used instead of plot.tgp. The type of plot retulting ## depends on whether main effects are to be plotted or not "sens.plot" <- function(s, maineff=TRUE, legendloc="topright", ...) { ## colors used for each effect (col of X) cols = rainbow(s$d) ## extract some useful things from the tgp-object 's' nom <- names(s$X) sens <- s$sens Zmean <- sens$ZZ.mean Zq1 <- sens$ZZ.q1 Zq2 <- sens$ZZ.q2 ## if maineff is logical then the S & T stats will get plotted if(is.logical(maineff)){ ## put X on a mean 0 range 1 scale X <- mean0.range1(sens$Xgrid)$X ## plot the main effects or not? if(maineff){ par(mfrow=c(1,3), ...) X <- mean0.range1(sens$Xgrid)$X ## plot each of the main effects in the same window -- start with the 1st plot(X[,1], Zmean[,1], main="Main Effects", ylab="response", xlab="scaled input", col=cols[1], typ="l", lwd=2, ylim=range(as.vector(Zmean)), ...) ## and then proceed with the rest for(i in 2:s$d){ if(nlevels(factor(Zmean[,i]))==3){ ## discrete response ... Taddy is this right? segments(-.5, Zmean[1,i], 0, Zmean[1,i], lwd=2, col=cols[i]) segments(0, Zmean[nrow(Zmean),i], .5, Zmean[nrow(Zmean),i], lwd=2, col=cols[i]) } else{ lines(X[,i], Zmean[,i], lwd=2, col=cols[i]) } ## continuous response } ## add a legend to the plot so we can see which colours are for which effects legend(x=legendloc, legend = names(s$X), col=cols, fill=cols) } else{ par(mfrow=c(1,2), ...) } ## plot the S and T statistics ## S stats first boxplot(data.frame(sens$S), names=names(s$X), main="1st order Sensitivity Indices", xlab="input variables", ylab="", ...) ## then T stats T0 <- sens$T T0[sens$T<0] <- 0 boxplot(data.frame(T0), names=names(s$X), main="Total Effect Sensitivity Indices", xlab="input variables", ylab="", ...) } else { ## only make a main effects plots ## set up the plot X <- sens$Xgrid ME <- c(maineff) pdim <- dim(as.matrix(maineff)) par(mfrow=pdim, ...) ## for each Main Effect for(i in ME){ ## discrete response ... Taddy is this right? if(nlevels(factor(Zmean[,i]))==3){ plot(c(0,1) ,c(Zmean[1,i],Zmean[nrow(Zmean),i]), main="", ylab="response", xlab=nom[i], col=cols[i], pch=20, cex=2, xlim=c(-.5,1.5), xaxt="n", ylim=c(min(Zq1[,i]), max(Zq2[,i]))) axis(1, at=c(0,1)) segments(-.1, Zq1[1,i], .1, Zq1[1,i], lwd=2, col=cols[i], lty=2) segments(.9, Zq1[nrow(Zq1),i], 1.1, Zq1[nrow(Zq1),i], lwd=2, col=cols[i], lty=2) segments(-.1, Zq2[1,i], .1, Zq2[1,i], lwd=2, col=cols[i], lty=2) segments(.9, Zq2[nrow(Zq2),i], 1.1, Zq2[nrow(Zq2),i], lwd=2, col=cols[i], lty=2) } else{ ## continuous response plot(X[,i], Zmean[,i], main="", ylab="response", xlab=nom[i], col=cols[i], typ="l", lwd=2, ylim=c(min(Zq1[,i]), max(Zq2[,i])), ...) lines(X[,i], Zq1[,i], col=cols[i], lty=2) lines(X[,i], Zq2[,i], col=cols[i], lty=2) } } ## add a title to the plot mtext(text="Main effects: mean and 90 percent interval", line=-2, outer=TRUE, font=2) } } tgp/R/check.matrix.R0000644000176200001440000000655413531032535013762 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## check.matrix: ## ## check/enfore that the X matrix has the proper dimensions ## (and the same number or rows as length(Z)) removing invalid rows ## (of Z too), i.e., NA, NaN, Inf "check.matrix" <- function(X, Z=NULL) { ## format X if(is.null(X)) return(NULL) n <- nrow(X) if(is.null(n)) { n <- length(X); X <- matrix(X, nrow=n) } X <- as.matrix(X) ## if a Z is provided to go along with X if(!is.null(Z)) { ## format Z ## Z <- as.vector(matrix(Z, ncol=1)[,1]) Z <- as.vector(as.matrix(Z)) if(length(Z) != n) stop("mismatched row dimension in X and Z") ## calculate locations of NAs NaNs and Infs in Z nna <- (1:n)[!is.na(Z) == 1] nnan <- (1:n)[!is.nan(Z) == 1] ninf <- (1:n)[!is.infinite(Z) == 1] if(length(nna) < n) warning(paste(n-length(nna), "NAs removed from input vector")) if(length(nnan) < n) warning(paste(n-length(nnan), "NaNs removed from input vector")) if(length(ninf) < n) warning(paste(n-length(ninf), "Infs removed from input vector")) neitherZ <- intersect(nna, intersect(nnan, ninf)) } else neitherZ <- (1:n) ## calculate row locations of NAs NaNs and Infs in X nna <- (1:n)[apply(!is.na(X), 1, prod) == 1] nnan <- (1:n)[apply(!is.nan(X), 1, prod) == 1] ninf <- (1:n)[apply(!is.infinite(X), 1, prod) == 1] if(length(nna) < n) warning(paste(n-length(nna), "NAs removed from input matrix")) if(length(nnan) < n) warning(paste(n-length(nnan), "NaNs removed from input matrix")) if(length(ninf) < n) warning(paste(n-length(ninf), "Infs removed from input matrix")) neitherX <- intersect(nna, intersect(nnan, ninf)) ## oops, no data: if(length(neitherX) == 0) stop("no valid (non-NA NaN or Inf) data found") ## combine good X and Z rows neither <- intersect(neitherZ, neitherX) X <- matrix(X[neither,], nrow=length(neither)) Z <- Z[neither] return(list(X=X, Z=Z)) } ## famify.X ## ## change an X matrix into a data frame with the names specified ## used by tgp.postprocess to convert a matrix enforced by check.matrix ## back into the data frame it started as "framify.X" <- function(X, Xnames, d) { X <- data.frame(t(matrix(X, nrow=d))) if(is.null(Xnames)) { nms <- c(); for(i in 1:d) { nms <- c(nms, paste("x", i, sep="")) } names(X) <- nms } else { names(X) <- Xnames } return(X) } tgp/R/exp2d.R0000644000176200001440000001112713531032535012414 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## for R CMD CHECK if(getRversion() >= "2.15.1") utils::globalVariables("exp2d", package="tgp") ## exp2d.Z: ## ## sample from he 2-d exponential data at locations X with ## normal mean-zero random deviates with sd specified "exp2d.Z" <- function(X, sd=0.001) { if(is.null(X)) return(NULL); if(is.null(ncol(X))) X <- matrix(X, ncol=length(X)) ## check the number of columns if(ncol(X) != 2) stop(paste("X should be a matrix (or data frame) with 2 columns, you have", ncol(X))) ## calculate the Z data Ztrue <- X[,1] * exp(- X[,1]^2 - X[,2]^2) ## add randomness for random sample Z <- Ztrue + rnorm(nrow(X),mean=0,sd=sd) ## return a data frame object return(data.frame(Z=Z,Ztrue=Ztrue)) } ## exp2d.rand: ## ## samplig from the 2-d exponential data using the data file ## or a d-optimal (and/or) LH design and random evaluations from ## the exp2d.Z function. n1 samples are taken from the interesting ## region, and n2 from outside. "exp2d.rand" <- function(n1=50, n2=30, lh=NULL, dopt=1) { ## check the sanity of the inputs if(n1 < 0 || n2 < 0) { stop("n1 and n2 must be >= 0") } ## use Latin Hybpercube sampling if(!is.null(lh)) { ## start with the interesting region Xcand <- lhs(n1*dopt, rbind(c(-2,2), c(-2,2))) if(dopt > 2) { X <- dopt.gp(n1, NULL, Xcand)$XX } else { X <- Xcand } ## check if n2 is a 1-vector or a 3-vector if(length(n2) == 1) n2 <- rep(ceiling(n2/3), 3) else if(length(n2 != 3)) stop(paste("length of n2 should be 1 or 3, you have", length(n2))) ## check validity of dopt if(length(dopt) != 1 || dopt < 1) stop(paste("dopt should be a scalar >= 1, you have", dopt)) ## do the remaining three (uninteresting) quadtants Xcand <- lhs(n2[1]*dopt, rbind(c(2,6), c(-2,2))) Xcand <- rbind(Xcand, lhs(n2[2]*dopt, rbind(c(2,6), c(2,6)))) Xcand <- rbind(Xcand, lhs(n2[3]*dopt, rbind(c(-2,2), c(2,6)))) ## see if we need d-optimal subsample if(dopt > 2) { X <- rbind(X, dopt.gp(sum(n2), NULL, Xcand)$XX) } else { X <- rbind(X, Xcand) } ## calculate the Z data Zdata <- exp2d.Z(X); Ztrue <- Zdata$Ztrue; Z <- Zdata$Z ## now get the size of the XX vector (for each quadtant) if(length(lh) == 1) lh <- rep(ceiling(lh/4), 4) else if(length(lh) != 4) stop(paste("length of lh should be 0 (for grid), 1 or 4, you have", length(lh))) ## fill the XX vector XX <- lhs(lh[1]*dopt, rbind(c(-2,2), c(-2,2))) XX <- rbind(XX, lhs(lh[2]*dopt, rbind(c(2,6), c(-2,2)))) XX <- rbind(XX, lhs(lh[3]*dopt, rbind(c(2,6), c(2,6)))) XX <- rbind(XX, lhs(lh[4]*dopt, rbind(c(-2,2), c(2,6)))) ## see if we need d-optimal subsample if(length(X) > 0 && dopt > 2) { XX <- dopt.gp(sum(lh), X, XX)$XX } ## calculate the ZZ data ZZdata <- exp2d.Z(XX); ZZtrue <- ZZdata$Ztrue; ZZ <- Zdata$Z } else { ## make sure we have enough data to fulfill the request if(n1 + n2 >= 441) { stop("n1 + n2 must be <= 441") } ## dopt = TRUE doesn't make sense here if(dopt != 1) { warning("argument dopt != 1 only makes sens when !is.null(lh)") } ## load the data data(exp2d, envir=environment()); n <- dim(exp2d)[1] ## get the X columns si <- (1:n)[1==apply(exp2d[,1:2] <= 2, 1, prod)] s <- c(sample(si, size=n1, replace=FALSE), sample(setdiff(1:n, si), n2, replace=FALSE)) X <- as.matrix(exp2d[s,1:2]); ## get the XX predictive columns ss <- setdiff(1:n, s) XX <- exp2d[ss, 1:2]; ## read the Z response columns Z <- as.vector(exp2d[s,3]); Ztrue <- as.vector(exp2d[s,4]); ## read the ZZ response columns ZZ <- as.vector(exp2d[ss,3]); ZZtrue <- as.vector(exp2d[ss,4]); } return(list(X=X, Z=Z, Ztrue=Ztrue, XX=XX, ZZ=ZZ, ZZtrue=ZZtrue)) } tgp/R/plot.tgp.R0000644000176200001440000001425613531032535013147 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; withx even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## plot.tgp: ## ## generic plot method for tgp-class objects -- handles sensitivity and ## multi-resolution plots through other interfaces after some pre-processing. ## Standard tgp 1-d plots are handled directly, and 2-d projections and slices ## are also handled through other interfaces after a small amount of ## pre-processing "plot.tgp" <- function(x, pparts=TRUE, proj=NULL, slice=NULL, map=NULL, as=NULL, center="mean", layout="both", main=NULL, xlab=NULL, ylab=NULL, zlab=NULL, pc="pc", gridlen=c(40,40), span=0.1, pXX=TRUE, legendloc="topright", maineff=TRUE, mrlayout="both", rankmax=20, ...) { ## check for valid layout if(layout != "both" && layout != "surf" && layout != "as" && layout != "sens") stop("layout argument must be \"both\", \"surf\", \"as\", or \"sens\""); ## check if 'as' plots can be made if(x$nn == 0 && (!is.null(as) && (as != "s2" && as != "ks2"))) { if(layout == "both") { cat("cannot make \"as\" plot since x$nn=0, default to layout = \"surf\"\n") layout <- "surf" } else if(layout == "as") stop("cannot make \"as\" plot since x$nn=0\n") } ## sensitivity plots if(layout == "sens"){ if(x$sens$par$ngrid==0){ ## make sure that a sens can be plotted cat("Cannot make sensitivity plots without sens.* matrices.\n") layout = "both" } else { ## plot the sens sens.plot(x, legendloc=legendloc, maineff=maineff, ...) return(invisible()); } } ## plots for multi-resolution tgp if(x$params$corr == "mrexpsep"){ ## the "both" method uses the mr.plot function if(mrlayout == "both"){ mr.plot(x,pparts=pparts, proj=proj, center=center, layout="both", main=main, xlab=xlab, ylab=ylab, zlab=zlab, legendloc=legendloc, gridlen=gridlen, span=span, ...) return(invisible()) ## whereas the "coarse" and "fine" methods use the regular ## tgp plotting methods with some minor changes depending on the res } else if(mrlayout == "coarse") { xTemp <- x; x <- mr.checkrez(x, res=0) if((length(x$Zp.mean)+length(x$ZZ.mean)) < 5) stop("Cannot plot 'coarse' with less than 5 predictive locations.\n") } else { ## same thing for the fine resolution xTemp <- x; x <- mr.checkrez(x, res=1) if((length(x$Zp.mean)+length(x$ZZ.mean)) < 5) stop("Cannot plot 'fine' with less than 5 predictive locations.\n") } } ## standard tgp plotting if(x$d == 1) { # plotting 1d data if(layout=="both") par(mfrow=c(1,2), bty="n") # else par(mfrow=c(1,1), bty="n") # construct/get graph labels if(is.null(xlab)) xlab <- names(x$X)[1] if(is.null(ylab)) ylab <- x$response # plot means and errors if(layout == "both" || layout == "surf") { ## choose mean or median for center center <- tgp.choose.center(x, center) Z.mean <- center$Z; smain <- paste(main, ylab, center$name) X <- center$X[,1] o <- order(X) ## plot the data plot(x$X[,1],x$Z, xlab=xlab, ylab=ylab, main=smain,...) # plot the center (mean) lines(X[o], Z.mean[o], ...) ## and 0.5 and 0.95 quantiles if(center$name == "kriging mean") { Zb.q1 <- Z.mean + 1.96*sqrt(c(x$Zp.ks2, x$ZZ.ks2)) Zb.q2 <- Z.mean - 1.96*sqrt(c(x$Zp.ks2, x$ZZ.ks2)) } else { Zb.q1 <- c(x$Zp.q1, x$ZZ.q1) Zb.q2 <- c(x$Zp.q2, x$ZZ.q2) } ## add the predictive 90% error-bars lines(X[o], Zb.q1[o], col=2, ...) lines(X[o], Zb.q2[o], col=2, ...) # plot parts if(pparts & !is.null(x$parts) ) { tgp.plot.parts.1d(x$parts) } } # adaptive sampling plotting # first, figure out which stats to plot if(layout != "surf") { # && !is.null(as)) { ## collect the error statistics that the user has requested as <- tgp.choose.as(x, as) Z.q <- as$criteria X <- as$X # then plot them o <- order(X[,1]); plot(X[o,1], Z.q[o], type="l", ylab=as$name, xlab=xlab, main=paste(main, as$name), ...) ## plot parts if(pparts & !is.null(x$parts)) { tgp.plot.parts.1d(x$parts) } ## if improv, then add order too if(substr(as$name,1,1) == "I") { ranks <- x$improv[,2] <= rankmax text(X[ranks,1], Z.q[ranks], labels=x$improv[ranks,2], pos=3, ...) } } } else if(x$d >= 2) { # 2-d plotting if(x$d == 2 || is.null(slice)) { # 2-d slice projection plot tgp.plot.proj(x, pparts=pparts, proj=proj, map=map, as=as, center=center, layout=layout, main=main, xlab=xlab, ylab=ylab, zlab=zlab, pc=pc, gridlen=gridlen, span=span, pXX=pXX, rankmax=rankmax, ...) } else { # 2-d slice plot tgp.plot.slice(x, pparts=pparts, slice=slice, map=map, as=as, center=center, layout=layout, main=main, xlab=xlab, ylab=ylab, zlab=zlab, pc=pc, gridlen=gridlen, span=span, pXX=pXX, ...) } } else { ## ERROR cat(paste("Sorry: no plot defind for ", x$d, "-d tgp data\n", sep="")) } ## reset the original tgp object for mr.tgp if(x$params$corr == "mrexpsep"){ x <- xTemp } } tgp/R/tgp.trees.R0000644000176200001440000000664213531032535013313 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## tgp.trees: ## ## plot the MAP tree found at each tree in the Markov chain ## for the tgp-class object (or, possibly constrin the plotting ## to certain heights -- requires the maptree library for plotting "tgp.trees" <- function(out, heights=NULL, main=NULL, ...) { ## get the full set of heights if none specified, and length if(is.null(heights)) heights <- out$posts$height else if(heights[1] == "map") { ## only plot the MAP heights <- out$post$height[which.max(out$posts$lpost)] } howmany <- length(heights) ## calculate how many sub-windows to make with par if(howmany > 1) { h <- howmany if(sum(out$posts$height == 1) >= 1) { h <- h - 1; } rows <- floor(sqrt(h)); cols <- floor(h / rows) while(rows * cols < h) cols <- cols + 1 par(mfrow=c(rows, cols), bty="n") } else par(mfrow=c(1,1), bty="n") ## create a vector of names for the main text section of each plot names <- names(out$X) if(is.null(names)) { for(i in 1:out$d) { names <- c(names, paste("x", i, sep="")) } } ## plot each tree for(j in 1:howmany) { if(is.null(out$trees[[heights[j]]])) next; p <- (1:length(out$posts$height))[out$posts$height == heights[j]] tgp.plot.tree(out$trees[[heights[j]]], names, out$posts[p,], main=main, ...); } } ## tgp.plot.tree: ## ## actually use maptree to plot each tree specified in the ## tree frame with specified name and posterior probability "tgp.plot.tree" <- function(frame, names, posts, main=NULL, ...) { ## don't plot (null) trees of height one if(dim(frame)[1] == 1) { cat(paste("NOTICE: skipped plotting tree of height 1, with lpost =", posts$lpost, "\n")) return() } ## concatenate the log-posterior probability to the main text main <- paste(main, " height=", posts$height, ", log(p)=", posts$lpost, sep="") ## create a frame vector that maptree understands frame[,2] <- as.character(frame[,2]) n.i <- frame[,2] != "" frame[n.i,2] <- names[as.numeric(frame[n.i,2])+1] frame[,2] <- factor(frame[,2]) splits <- as.matrix(data.frame(cutleft=as.character(frame[,6]), cutright=as.character(frame[,7]))) new.frame <- data.frame(frame[,2:5], splits=I(splits), row.names=frame[,1]) tree <- list(frame=new.frame) ## draw the tree and add a title draw.tree(tree, ...) title(main) } tgp/R/optim.tgp.R0000644000176200001440000001301413531032535013310 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## optim.ptgpf: ## ## find the minima of the MAP predictive (kriging) surface ## encoded in the tgp object, starting at the specified spot ## restrected to the provided rectangle with the specified ## method -- eventually we should be calclating and using GP ## derivative information optim.ptgpf <- function(start, rect, tgp.obj, method=c("L-BFGS-B", "Nelder-Mead", "BFGS", "CG", "SANN", "optimize")) { ## check the method argument method <- match.arg(method) ## ptgpf: ## ## predict at x for the MAP tgp object, to be used by optim ## for finding the minimum of the MAP kriging surface ptgpf <- function(x, tgp.obj, rect=NULL) { ## only need to check rectangle when 2-d or more if(!is.null(rect)) for(i in nrow(rect)) if(x[i] < rect[i,1] || x[i] > rect[i,2]) return(Inf) ## necessary b/c check.matrix doesn't know correct ncol if(!is.null(rect)) x <- matrix(x, ncol=nrow(rect)) ## run predict out <- predict(tgp.obj, XX=x, pred.n=FALSE) return(as.vector(out$ZZ.km)) } ## optimize is for 1-d data only if(method == "optimize") { if(nrow(rect) != 1) ## check if optimize method is appropriate stop("method=\"optimize\" only valid for 1-d functions") opt <- optimize(ptgpf, interval=rect[1,], tgp.obj=tgp.obj) return(list(par=opt$minimum, value=opt$objective, convergence=1)) } ## otherwise use optim in some way if(method == "L-BFGS-B") { ## use the boundary informatoin in rect opt <- optim(par=start, ptgpf, method=method, tgp.obj=tgp.obj, rect=rect, lower=rect[,1], upper=rect[,2]) } else { ## otheriwise, apply a method without boundaries opt <- optim(par=start, ptgpf, method=method, tgp.obj=tgp.obj, rect=rect) } ## return return(opt) } ## tgp.cands: ## ## create NN candidate locations (XX) either via Latin Hypercube ## sample (LHS), or sequential treed D-optimal design (based on an ## initial LHS tgp.cands <- function(tgp.obj, NN, cands=c("lhs", "tdopt"), rect, X, verb=0) { ## check the cands argument cands <- match.arg(cands) ## return a latin hypercibe sample if(cands == "lhs") return(lhs(NN, rect)) ## return a sequential treed D-optimal sample from initial LHS cands Xcand <- lhs(10*NN, rect) if(is.null(tgp.obj)) XX <- dopt.gp(NN, X=X, Xcand, verb=verb)$XX else XX <- tgp.design(NN, Xcand, tgp.obj, verb=verb) XX <- matrix(XX, ncol=ncol(X)) return(XX) } ## optim.tgp: ## execute one step in a search for the global optimum (minimum) of a ## noisy function (f) bounded in rect with starting (X,Z) data provided: ## fit a tgp model and predict creating NN+{1,2} candidates and ## select the one (or two) which give have the highest expected improv ## statistic. NN of the candidates come from cands (lhs or tdopt), ## plus one which is the location of the minima found (e.g.,) via calling ## optim (with particular method) on the MAP btgpm predictive surface ## (passed in with prev). When as != "none" an additional candidate ## is also selected, which has the highest expected alc or alm statistic ## The new X (which may be 1-3 rows) are returned optim.step.tgp <- function(f, rect, model=btgp, prev=NULL, X=NULL, Z=NULL, NN=20*length(rect), improv=c(1,5), cands=c("lhs", "tdopt"), method=c("L-BFGS-B", "Nelder-Mead", "BFGS", "CG", "SANN", "optimize"), ...) { ## lhs should verify that the rect makes sense rect <- matrix(rect, ncol=2) ## XX a predictive grid XX <- tgp.cands(prev$obj, NN, cands, rect, X) ## add optim results in as a predictive location XX <- rbind(XX, as.numeric(prev$progress[1,1:nrow(rect)])) Xboth <- rbind(X,XX) ## fit a tgp model out <- model(X=X, Z=Z, XX=XX, improv=improv, ...) ## find the predicted minimum m <- which.min(c(out$Zp.mean, out$ZZ.mean)) Xm <- Xboth[m,] ## find the optimum with kriging, and record in opt opt <- optim.ptgpf(Xm, rect, out, method) opt <- data.frame(matrix(c(opt$par, opt$value), nrow=1)) names(opt) <- c(paste("x", 1:nrow(rect), sep=""), "z") ## X & from tgp-improv ir <- out$improv[,2] Ximprov <- matrix(XX[ir <= improv[2],], nrow=sum(ir <= improv[2])) ## assemble the info about the current minimum, and return as <- data.frame(improv=max(out$improv[,1])) r <- list(X=Ximprov, progress=cbind(opt, as), obj=out) return(r) } tgp/R/default.itemps.R0000644000176200001440000002051513531032535014317 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## default.itemps: ## ## create a default inverse temperature ladder for importance ## tempering (IT) together with pseudo-prior and parameters ## for calibrating it by stochastic approximation. There are three ## choices of ladder as specified by type "default.itemps" <- function(m=40, type=c("geometric", "harmonic", "sigmoidal"), k.min=0.1, c0n0=c(100,1000), lambda=c("opt", "naive", "st")) { ## check m argument if(length(m) != 1 || m <= 0) stop("m should be a positive integer") ## check type argument type <- match.arg(type) ## check k.min argument if(length(k.min) != 1 || k.min >= 1 || k.min < 0) stop("k.min should be a integer satisfying 0 <= k.min < 1") ## check the c0n0 argument if(length(c0n0) != 2 || !prod(c0n0 >= 0)) stop("c0n0 should be a nonnegative 2-vector") ## check the lambda argument lambda <- match.arg(lambda) ## check if importance sampling only if(m == 1) return(list(c0n0=c(0,0), k=k.min, pk=1, lambda="naive")) if(type == "geometric") { ## calculate the delta for the geometric which reaches ## k.min in m steps delta <- k.min^(1/(1-m)) - 1 ## geometric temperature ladder i <- 1:m k <- (1+delta)^(1-i) } else if(type == "harmonic") { ## calculate the delta for the geometric which reaches ## k.min in m steps delta <- ((1/k.min) - 1)/(m-1) ## harmonic temperature ladder i <- 1:m k <- 1/(1+ delta*(i-1)) } else { ## sigmoid ## calculate the indices which provide the sigmoid which ## begins at 1 and ends at k.min with m steps x <- c(1,k.min) ends <- log((1.01-x)/x) t <- seq(ends[1], ends[2], length=m) ## logistic/sigmoid temperature ladder k <- 1.01 - 1.01/(1+exp(-t)) } ## return the generated ladder, as above, with a vector of ## observation counts for tgp to update return(list(c0n0=c0n0, k=k, pk=rep(1/m, m), lambda=lambda)) } ## check.itemps: ## ## check the itemps create by hand or from default.itemps or ## as modified by tgp or predict tgp and assembled inside ## the tgp.postprocess function "check.itemps" <- function(itemps, params) { ## if null, then just make one temperature (1.0) with all the prob if(is.null(itemps)) return(c(1,0,0,1,1,0,1)) ## if it is a list or a data frame else if(is.list(itemps) || is.data.frame(itemps)) { ## get the four fields c0n0 <- itemps$c0n0 pk <- itemps$pk lambda <- itemps$lambda k <- itemps$k counts <- itemps$counts ## check for non-null k m <- length(k) if(m == 0) stop("must specify k vector in list") ## check for null pk if(is.null(pk)) pk <- rep(1/m, m) ## check the dims are right if(m != length(pk)) stop("length(itemps$k) != length(itemps$pk)") ## put into decreasing order o <- order(k, decreasing=TRUE) k <- k[o] pk <- pk[o] ## checks k if(prod(k >= 0)!=1) stop("should have 0 <= itemps$k") if((m > 1 || k != 1) && params$bprior != "b0") warning("recommend params$bprior == \"b0\" for itemps$k != 1", immediate.=TRUE) ## checks for pk if(prod(pk > 0)!=1) stop("all itemps$pk should be positive") ## init and checks for c0n0 if(! is.null(c0n0)) { if(length(c0n0) != 2 || !prod(c0n0 >= 0)) stop("itemps$c0n0 should be a nonnegative 2-vector") } else c0n0 <- c(100,1000) ## check lambda if(! is.null(lambda)) { if(lambda == "opt") lambda <- 1 else if(lambda == "naive") lambda <- 2 else if(lambda == "st") { if(k[1] != 1.0) stop("cannot use lambda=\"st\" when itemps$k[1] != 1.0\n") lambda <- 3 } else stop(paste("lambda = ", lambda, "is not valid\n", sep="")) } else lambda <- 1 ## check the counts vector if(! is.null(counts)) { if(m != length(counts)) stop("length(itemps$k) != length(itemps$counts)") } else counts <- rep(0,m) ## return a double-version of the ladder return(c(m, c0n0, k, pk, counts, lambda)) } ## if it is a matrix else if(is.matrix(itemps)) { ## check dims of matrix if(ncol(itemps) != 2) stop("ncol(itemps) should be 2") ## get the two fields pk <- itemps[,2] k <- itemps[,1] m <- length(k) ## put into decreasing order o <- order(k, decreasing=TRUE) k <- k[o] pk <- pk[o] ## checks k if(prod(k >= 0)!=1) stop("should have 0 <= itemps[,1]") if((m > 1 || k != 1) && params$bprior != "b0") warning("recommend params$bprior == \"b0\" for itemps[,1] != 1", immediate.=TRUE) ## checks for pk if(prod(pk > 0)!=1) stop("all probs in itemps[,2] should be positive") ## return a double-version with a counts vector at the end return(c(m, 100, 1000, k, pk, 1, rep(0,m))) } ## if itemps is a vector else if(is.vector(itemps)) { ## get length of inverse temperature ladder m <- length(itemps) ## checks for itemps if(prod(itemps >= 0)!=1) stop("should have 0 <= itemps ") if((length(itemps) > 1 || itemps != 1) && params$bprior != "b0") warning("recommend params$bprior == \"b0\" for itemps != 1", immediate.=TRUE) ## return a double-version with a counts vector at the end return(c(m, 100, 1000, itemps, rep(1/m, m), 1, rep(0,m))) } else stop("invalid form for itemps") } ## hist2bar: ## ## make a barplot to compare the (discrete) histograms ## of each column of the input argument x hist2bar <- function(x) { ## make a matrix if(is.vector(x)) x <- matrix(x, ncol=1) ## calculate the number of, and allocate the space for, ## the bins, b, of the histogram r <- range(as.numeric(x)) b <- matrix(0, ncol=ncol(x), nrow=r[2]-r[1]+1) ## calculate the histogram height of each bin for(i in r[1]:r[2]) for(j in 1:ncol(x)) b[i-r[1]+1,j] <- sum(x[,j] == i) ## make have thr right data.frame format so that ## it will place nice with the barplot function, ## and return b <- data.frame(b) row.names(b) <- r[1]:r[2] return(t(b)) } ## itemps.barplot: ## ## make a histogram (via barplot) of the number of times ## each inverse-temperature was visited in the ST-MCMC ## chain. Requires that traces were collected itemps.barplot <- function(obj, main=NULL, xlab="itemps", ylab="counts", plot.it=TRUE, ...) { ## check to make sure traces were collected if(is.null(obj$trace)) stop(paste("no traces in tgp-object;", "re-run the b* function with argument \"trace=TRUE\"")) ## check to make sure tempering was used if(is.null(obj$itemps)) stop("no itemps in tgp-object") ## create a bin for each inverse-temperature bins <- rep(0,length(obj$itemps$k)) ## count and store the number in the first bin m <- obj$trace$post$itemp == obj$itemps$k[1] bins[1] <- sum(m) ## count and store the number in the rest of the bins for(i in 2:length(obj$itemps$k)) { m <- obj$trace$post$itemp == obj$itemps$k[i] if(sum(m) == 0) next; bins[i] <- sum(m) } ## make into a data frame for convenient barplotting bins <- data.frame(bins) row.names(bins) <- signif(obj$itemps$k,3) ## make the barplot histogram if(plot.it==TRUE) { smain <- paste(main, "itemp counts") barplot(t(bins), xlab=xlab, ylab=ylab, ...) } ## return the barplot structure for plotting later return(invisible(bins)) } tgp/R/tgp.choose.R0000644000176200001440000000754113531032535013450 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## tgp.choose.as: ## ## pick which type of "errors" to be returned, either for ## plotting purposes or for adaprive sampling purposes "tgp.choose.as" <- function(out, as) { ## choose AS stats to plot ## default quantile diffs (as=NULL), or predictive variance (as="s2") if(is.null(as) || as == "s2" || as == "ks2") { ## use fulle data, XX & X X <- out$XX ## choose quantile diffs or s2 if(is.null(as)) { criteria <- c(out$Zp.q, out$ZZ.q) name <- "quantile diff (error)" if(!is.null(out$Zp.q)) X <- rbind(out$X, X) } else if(as == "ks2") { criteria = c(out$Zp.ks2, out$ZZ.ks2) name <- "kriging var" if(!is.null(out$Zp.ks2)) X <- rbind(out$X, X) } else { if(is.matrix(out$Zp.s2)) criteria <- c(diag(out$Zp.s2), diag(out$ZZ.s2)) else criteria <- c(out$Zp.s2, out$ZZ.s2) name <- "pred var" if(!is.null(out$Zp.s2)) X <- rbind(out$X, X) } } else { ## only use predictive data X <- out$XX ## default choice is ALM stats (quantile diffs) criteria <- out$ZZ.q name <- "ALM stats" ## choose ALC or EGO stats if(as == "alc") { if(is.null(out$Ds2x)) cat("NOTICE: out$Ds2x is NULL, using ALM\n") else { criteria <- out$Ds2x; name <- "ALC stats" } } else if(as == "improv") { if(is.null(out$improv)) cat("NOTICE: out$improv is NULL, using ALM\n") else { criteria <- out$improv[,1]; name <- paste("Improv stats (g=", out$g[1], ")", sep="") } } else if(as != "alm") warning(paste("as criteria \"", as, "\" not recognized; defaulting to \"alm\"", sep="")) } ## there might be nothing to plot if(is.null(criteria)) stop("no predictive data, so nothing to plot") ## return return(list(X=X, criteria=criteria, name=name)) } ## tgp.choose.center: ## ## pick which type of center (mean, median, kriging mean, etc) ## to be returned, mostly for plotting purposes "tgp.choose.center" <- function(out, center) { X <- out$XX ## check center description if(center != "mean" && center != "med" && center != "km") { warning(paste("center = \"", center, "\" invalid, defaulting to \"mean\"\n", sep="")) center <- "mean" } ## choose center as median or mean if(center == "med") { name <- "median"; Z <- c(out$Zp.med, out$ZZ.med) if(!is.null(out$Zp.med)) X <- rbind(out$X, X) } else if(center == "km") { name <- "kriging mean"; Z <- c(out$Zp.km, out$ZZ.km) if(!is.null(out$Zp.km)) X <- rbind(out$X, X) } else { name <- "mean"; Z <- c(out$Zp.mean, out$ZZ.mean) if(!is.null(out$Zp.mean)) X <- rbind(out$X, X) } ## there might be nothing to plot if(is.null(Z)) stop("no predictive data, so nothing to plot") ## return return(list(X=X, Z=Z, name=name)) } tgp/R/mapT.R0000644000176200001440000000732313531032535012276 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## mapT: ## ## plot the Maximum a Posteriori tree in a tgp-class object, ## or add it to an existing plot -- The proj argument allows ## only some dimensions to be plotted "mapT" <- function(out, proj=NULL, slice=NULL, add=FALSE, lwd=2, ...) { ## simple for 1-d data, projection plot if(out$d == 1) { proj <- 1; slice <- NULL } ## otherwise, many options for >= 2-d data if(out$d > 2 && !is.null(slice)) { # slice plot ## will call stop() if something is wrong with the slice d <- check.slice(slice, out$d, getlocs(out$X)) ## plot the parts tgp.plot.parts.2d(out$parts, d, slice); } else { # projection plot ## will call stop() if something is wrong with the proj proj <- check.proj(proj) ## 1-d projection if(length(proj) == 1) { if(add == FALSE) plot(out$X[,proj], out$Z, ...) tgp.plot.parts.1d(out$parts[,proj], lwd=lwd) } else { ## 2-d projection if(add == FALSE) plot(out$X[,proj], ...) tgp.plot.parts.2d(out$parts[,proj], lwd=lwd) } } } ## tgp.plot.parts.1d: ## ## plot the partitings of 1-d tgp$parts output -- used ## by mapT and plot.tgp "tgp.plot.parts.1d" <- function(parts, lwd=2) { j <- 3 if(is.null(dim(parts))) dp <- length(parts) else { dp <- nrow(parts) parts <- parts[,1] } is <- seq(2, dp, by=4) m <- max(parts[is]) for(i in is) { if(parts[i] == m) next; abline(v=parts[i], col=j, lty=j, lwd=lwd); j <- j + 1 } } ## tgp.plot.parts.2d: ## ## plot the partitings of 2-d tgp$parts output -- used ## by mapT and plot.tgp via tgp.plot.slide and tgp.plot.proj ## the what argument specifies the slice, and trans can make ## rotations "tgp.plot.parts.2d" <- function(parts, dx=c(1,2), what=NULL, trans=matrix(c(1,0,0,1), nrow=2), col=NULL, lwd=3) { if(length(what) > 0) { indices <- c() for(i in seq(1,nrow(parts),4)) { opl <- i+2; opr <- i+3; if(parts[opl,what$x] == 104 && parts[opr,what$x] == 102 && what$z >= parts[i,what$x] && what$z <= parts[i+1,what$x]) { indices <- c(i, indices) } else if(parts[opl,what$x] == 105 && parts[opr,what$x] == 102 && what$z > parts[i,what$x] && what$z <= parts[i+1,what$x]) { indices <- c(i, indices) } } } else { indices <- seq(1,dim(parts)[1],4); } j <- 1 for(i in indices) { a <- parts[i,dx[1]]; b <- parts[i+1,dx[1]]; c <- parts[i,dx[2]]; d <- parts[i+1,dx[2]]; x <- c(a, b, b, a, a); y <- c(c, c, d, d, c); xy <- as.matrix(cbind(x,y)) %*% trans if(is.null(col)) { lines(xy, col=j, lty=j, lwd=lwd); } else { lines(xy, col=col, lty=1, lwd=lwd); } j <- j+1 } } tgp/R/tgp.design.R0000644000176200001440000001264413723731015013443 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## tgp.design: ## ## choose howmany of Xcand candidate locations according to a treed ## D-optimal design using the MAP tree contained in the tgp-class ## object. iter specifies the number of iterations in the stochastic ## ascent method "tgp.design" <- function(howmany, Xcand, out, iter=5000, verb=0) { ## get partitioned candidates and dat locaitons Xcand.parts <- partition(Xcand, out) X.parts <- partition(out$X, out) ## initialize selected candidates to none XX <- NULL ## subsample some from each partition cat(paste("\nsequential treed D-Optimal design in ", length(Xcand.parts), " partitions\n", sep="")) for(i in 1:length(Xcand.parts)) { nn <- ceiling(howmany*(nrow(Xcand.parts[[i]]))/(nrow(Xcand))) if(verb > 0) cat(paste("dopt.gp (", i, ") choosing ", nn, " new inputs from ", nrow(Xcand.parts[[i]]), " candidates\n", sep="")) dout <- dopt.gp(nn, X.parts[[i]], Xcand.parts[[i]], iter, max(verb-1,0)); XX <- rbind(XX, dout$XX) } return(XX) } ## tgp.partition: ## ## group X into a list containg each region as partitioned ## by the tree -- i is used to index root of the tree structure ## when applied recursively. This functio is used exclusively ## by the partition function below "tgp.partition" <- function(X, tree, i) { ## error or leaf node if(length(X) == 0) { stop("no X's found in partition\n") } if(tree$var[i] == "") return(list(X)); ## make sure X is a matrix if(is.null(nrow(X))) X <- matrix(X, ncol=1) ## gather the appropriate operations from the ith tree node var <- as.integer(as.character(tree$var[i]))+1 gt <- (1:nrow(X))[X[,var] > tree$val[i]] leq <- setdiff(1:nrow(X), gt) ## calculate the left and right tree node rows l <- (1:nrow(tree))[tree$rows == 2*tree$rows[i]] r <- (1:nrow(tree))[tree$rows == 2*tree$rows[i]+1] ## recurse on left and right subtrees if(length(leq) > 0) Xl <- tgp.partition(as.matrix(X[leq,,drop=FALSE]), tree, l) else Xl <- NULL if(length(gt) > 0) Xr <- tgp.partition(as.matrix(X[gt,,drop=FALSE]), tree, r) else Xr <- NULL return(c(Xl,Xr)) } ## partition: ## ## return a list of X location in each region of the MAP ## treed partition contained in the tgp-class object in out "partition" <- function(X, out) { m <- which.max(out$posts$lpost) tree <- out$trees[[out$posts$height[m]]] return(tgp.partition(X, tree, 1)) } ## dopt.gp: ## ## create a sequential D-optimal design of size under a GP model ## from candidates Xcand assuming that X locations are already in ## the design. The stochastic ascent algorithm uses iter rounds. ## Uses a C-side routine via .C "dopt.gp" <- function(nn, X=NULL, Xcand, iter=5000, verb=0) { if(nn == 0) return(NULL); ## check iterations if(length(iter) != 1 && iter <= 0) stop("iter must be a positive integer") ## check Kverbiterations if(length(verb) != 1 && iter < 0) stop("verb must be a non-negative integer") ## check X inputs Xnames <- names(X) X <- check.matrix(X)$X ## check the Xcand inputs if(is.null(Xcand)) stop("XX cannot be NULL") Xcand <- check.matrix(Xcand)$X ## check if X is NULL if(!is.null(X)) { n <- nrow(X); m <- ncol(X) X <- t(X) ## for row-major in .C } else { n <- 0; m <- ncol(Xcand) } ## check that cols of Xcand match X if(ncol(Xcand) != m) stop("mismatched column dimension of X and Xcand"); ncand <- nrow(Xcand) ## reduce nn if it is too big if(nn > nrow(Xcand)) { warning("nn greater than dim(Xcand)[1]"); nn <- nrow(Xcand); } ## choose a random state for the C code state <- sample(seq(0,999), 3) ## run the C code ll <- .C("dopt_gp", state = as.integer(state), nn = as.integer(nn), ## transpose of X is taken above X = as.double(X), n = as.integer(n), m = as.integer(m), Xcand = as.double(t(Xcand)), ncand = as.integer(ncand), iter = as.integer(iter), verb = as.integer(verb), fi = integer(nn), PACKAGE="tgp" ) ## deal with X, and names of X ll$X <- framify.X(ll$X, Xnames, m) ll$Xcand <- framify.X(ll$Xcand, Xnames, m) ll$XX <- ll$Xcand[ll$fi,] if(is.matrix(Xcand)) ll$XX <- matrix(as.matrix(ll$XX), ncol=ncol(Xcand)) ## dont return some of the things used by C ll$n <- NULL; ll$m <- NULL; ll$state <- NULL return(ll) } tgp/R/mrtgp.R0000644000176200001440000001401413531032535012521 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## mr.plot: ## ## plotting function for multiresolution tgp-class objects ## (i.e., those with corr=="mrexpsep") -- called by plot.tgp "mr.plot" <- function(x, pparts=TRUE, proj=NULL, center="mean", layout="both", main=NULL, xlab=NULL, ylab=NULL, zlab=NULL, legendloc="topright", gridlen=c(40,40), span=0.1, ...) { ## 1-d plot of 1-d data described by two columns (resolutions) if( x$d==2 ){ ## create plot window par(mfrow=c(1,1)) ## construct axis x&y labels if(is.null(xlab)){xlab <- names(x$X)[2]} if(is.null(ylab)){ylab <- x$response} ## collect the input and predictive data and pred outputs center <- tgp.choose.center(x, center) o <- order(center$X[,2]) X <- center$X[o,] Z <- center$Z[o] smain <- paste(main, ylab, center$name) ## collect quantiles Z.q1 <- c(x$Zp.q1, x$ZZ.q1)[o] Z.q2 <- c(x$Zp.q2, x$ZZ.q2)[o] ## plot the coarse and fine input data plot(x$X[x$X[,1]==0,2],x$Z[x$X[,1]==0], ylim=range(c(Z,x$Z)), xlab=xlab, ylab=ylab, main=smain, col=4) lines(x$X[x$X[,1]==1,2],x$Z[x$X[,1]==1], type="p", pch=20, col=2) ## add a legend if(! is.null(legendloc)) legend(legendloc, lty=c(1,2,1,2), col=c("blue", "blue", "red", "red"), c(paste("coarse", center$name), "coarse 90% CI", paste("fine", center$name), "fine 90% CI")) ## extract the coarse and fine resolutions f<-X[,1]==1 c<-X[,1]==0 ## add the coarse and fine mean and quantiles lines(X[c,2], Z[c], col=4) lines(X[f,2], Z[f], col=2) lines(X[f,2], Z.q1[f], col=2, lty=3) lines(X[f,2], Z.q2[f], col=2, lty=3) lines(X[c,2], Z.q1[c], col=4, lty=3) lines(X[c,2], Z.q2[c], col=4, lty=3) if(pparts) tgp.plot.parts.1d(x$parts[,2]) } else { ## make a projection for data is >= 2-d ## create plot window par(mfrow=c(1,2)) if(is.null(proj)) proj <- c(1,2) ## create axis lables -- augment proj argument by one column proj <- proj+1 if(is.null(xlab)){xlab <- names(x$X)[proj[1]]} if(is.null(ylab)){ylab <- names(x$X)[proj[2]]} ## collect the input and predictive data and pred outputs ## this plot only plots the mean or median, no errors center <- tgp.choose.center(x, center) X <- center$X; Z <- center$Z ## separate X and Z into coarse and fine c<-X[,1]==0; f<-X[,1]==1 Xc <- as.data.frame(X[c,proj]) Xf <- as.data.frame(X[f,proj]) Zc <- Z[c]; Zf <- Z[f] ## initialize the projection vectors p* nXc <- nrow(Xc); pc <- seq(1,nXc) nXf <- nrow(Xf); pf <- seq(1,nXf) dX <- nrow(X) ## plot the coarse predictive (mean or median) surface smain <- paste(main, x$response, "coarse", center$name) slice.image(Xc[,1], Xc[,2], p=pc, z=Zc, xlab=xlab, ylab=ylab, main=smain, gridlen=gridlen,span=span, xlim=range(X[,proj[1]]), ylim=range(X[,proj[2]]), ...) ## add inputs and predictive locations points(x$X[x$X[,1]==0,proj], pch=20, ...) points(x$XX[x$XX[,1]==0,proj], pch=21, ...) # plot parts if(pparts & !is.null(x$parts)) { tgp.plot.parts.2d(x$parts, dx=proj)} ## plot the fine predictive (mean or median) surface smain <- paste(main, x$response, "fine", center$name) slice.image(Xf[,1], Xf[,2], p=pf, z=Zf, xlab=xlab, ylab=ylab, main=smain, gridlen=gridlen, span=span, xlim=range(X[,proj[1]]), ylim=range(X[,proj[2]]), ...) ## add inputs and predictive locations points(x$X[x$X[,1]==1,proj], pch=20, ...) points(x$XX[x$XX[,1]==1,proj],pch=21, ...) # plot parts if(pparts & !is.null(x$parts)) { tgp.plot.parts.2d(x$parts, dx=proj)} } } ## mr.checkrez: ## ## used for extreacting the predictive surface information for ## one of the two resolutions so that the surface for that ## resolution can be plotted using the regualr tgp plotting ## machinery in plot.tgp "mr.checkrez" <- function(b, res) { ## select input data at the desired resolution b$d <- b$d-1 rdata <- b$X[,1]==res b$n <- sum(rdata) cnames=names(b$X)[-1] b$X <- as.data.frame(b$X[rdata,-1]) colnames(b$X) <- cnames b$Z <- b$Z[rdata] ## predictive data at input locations for the desired resolution b$Zp.mean <- b$Zp.mean[rdata] b$Zp.km <- b$Zp.km[rdata] b$Zp.q <- b$Zp.q[rdata] b$Zp.s2 <- b$Zp.s2[rdata] b$Zp.ks2 <- b$Zp.ks2[rdata] b$Zp.q1 <- b$Zp.q1[rdata] b$Zp.q2<- b$Zp.q2[rdata] b$Zp.med <- b$Zp.med[rdata] ## predictive data at the predictive locations for the desired resolution rpred <- b$XX[,1]==res b$nn <- sum(rpred) b$XX <- as.data.frame(b$XX[rpred,-1]) colnames(b$XX) <- cnames b$ZZ <- b$ZZ[rpred] b$ZZ.mean <- b$ZZ.mean[rpred] b$ZZ.km <- b$ZZ.km[rpred] b$ZZ.q <- b$ZZ.q[rpred] b$ZZ.s2 <- b$ZZ.s2[rpred] b$ZZ.ks2 <- b$ZZ.ks2[rpred] b$ZZ.q1 <- b$ZZ.q1[rpred] b$ZZ.q2<- b$ZZ.q2[rpred] b$ZZ.med <- b$ZZ.med[rpred] b$improv <- b$improv[rpred,] b$parts <- b$parts[,-1] return(b) } tgp/R/tgp.R0000644000176200001440000002154713723714746012211 0ustar liggesusers#******************************************************************************* # # Bayesian Regression and Adaptive Sampling with Gaussian Process Trees # Copyright (C) 2005, University of California # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # Questions? Contact Robert B. Gramacy (rbgramacy@ams.ucsc.edu) # #******************************************************************************* ## tgp: ## ## the master tgp R function which checks for valid inputs and ## calls the C-side via .C on those inputs -- and then calls the ## post-processing code accordingly "tgp" <- function(X, Z, XX=NULL, BTE=c(2000,7000,2), R=1, m0r1=FALSE, linburn=FALSE, params=NULL, itemps=NULL, pred.n=TRUE, krige=TRUE, zcov=FALSE, Ds2x=FALSE, improv=TRUE, sens.p=NULL, trace=FALSE, verb=1, rmfiles=TRUE) { ## (quitely) double-check that tgp is clean before-hand tgp.cleanup(message="NOTICE", verb=verb, rmfiles=TRUE); ## what to do if fatally interrupted? on.exit(tgp.cleanup(verb=verb, rmfiles=rmfiles)) ## check for two unsupported combinations of modeling options if(params$corr == "mrexpsep" && linburn) stop("Sorry, the linear burn-in is not available for corr=\"mrexpsep\"") if(params$corr == "mrexpsep" && !is.null(sens.p)) stop("Sorry, sensitivity analysis is not available for corr=\"mrexpsep\"") ## get names Xnames <- names(X) response <- names(Z) ## check X and Z XZ <- check.matrix(X, Z) X <- XZ$X; Z <- XZ$Z n <- nrow(X); d <- ncol(X) if(is.null(n)) stop("nrow(X) is NULL") ## check XX XX <- check.matrix(XX)$X if(is.null(XX)) { nn <- 0; XX <- matrix(0); nnprime <- 0 } else { nn <- nrow(XX); nnprime <- nn if(ncol(XX) != d) stop("mismatched column dimension of X and XX"); } ## check that trace is true or false) if(length(trace) != 1 || !is.logical(trace)) stop("trace argument should be TRUE or FALSE") else if(trace) { if(3*(10+d)*(BTE[2]-BTE[1])*R*(nn+1)/BTE[3] > 1e+7) warning(paste("for memory/storage reasons, ", "trace not recommended when\n", "\t 3*(10+d)*(BTE[2]-BTE[1])*R*(nn+1)/BTE[3]=", 3*(10+d)*(BTE[2]-BTE[1])*R*(nn+1)/BTE[3], " > 1e+7.\n", "\t Try reducing nrow(XX)", sep=""), immediate.=TRUE) } ## check that pred.n, krige, and Ds2x is true or false if(length(pred.n) != 1 || !is.logical(pred.n)) stop("pred.n should be TRUE or FALSE") if(length(krige) != 1 || !is.logical(krige)) stop("krige should be TRUE or FALSE") if(length(zcov) != 1 || !is.logical(zcov)) stop("zcov should be TRUE or FALSE") if(length(Ds2x) != 1 || !is.logical(Ds2x)) stop("Ds2x should be TRUE or FALSE") ## check the form of the improv-power argument if(length(improv) == 2) { numirank <- improv[2]; improv <- improv[1] } else { numirank <- NULL } if(length(improv) != 1 || !(is.logical(improv) || is.numeric(improv)) || (is.numeric(improv) && improv <= 0)) stop(paste("improv [", improv, "] should be TRUE, FALSE, or a positive integer (power)", sep="")) g <- as.numeric(improv) ## check numirank, which is improv[2] in input if(is.null(numirank) && improv) numirank <- nn ## max(min(10, nn), 0.1*nn) else if(!is.null(numirank) && numirank > nn) stop("improv[2] must be <= nrow(XX)") else if(is.null(numirank)) numirank <- 0 ## check for inconsistent XX and Ds2x/improv if(nn == 0 && (Ds2x || improv)) warning("need to specify XX locations for Ds2x and improv") ## check the sanity of input arguments if(nn > 0 && sum(dim(XX)) > 0 && ncol(XX) != d) stop("XX has bad dimensions") if(length(Z) != n) stop("Z does not have length == nrow(Z)") if(BTE[1] < 0 || BTE[2] <= 0 || BTE[1] > BTE[2]) stop("bad B and T: must have 0<=B<=T") if(BTE[3] <= 0 || ((BTE[2]-BTE[1] != 0) && (BTE[2]-BTE[1] < BTE[3]))) stop("bad E arg: if T-B>0, then must have T-B>=E") if((BTE[2] - BTE[1]) %% BTE[3] != 0) stop("E must divide T-B") if(R < 0) stop("R must be positive") ## deal with params if(is.null(params)) params <- tgp.default.params(d) ## check if X is of full rank if(params$meanfn == "linear" && class(try(solve(t(X[,1:params$tree[5]]) %*% X[,1:params$tree[5]]), silent=TRUE))[1] == "try-error") { stop("X[,1:", params$tree[5], "]-matrix is not of full rank", sep="") } ## convert params into a double-vector for passing to C dparams <- tgp.check.params(params, d); if(is.null(dparams)) stop("Bad Parameter List") ## check starting importance-tempering inv-temp itemps <- check.itemps(itemps, params) ## might scale Z to mean of 0 range of 1 if(m0r1) { Zm0r1 <- mean0.range1(Z); Z <- Zm0r1$X } else Zm0r1 <- NULL ## if performining a sensitivity analysis, set up XX ## if(!is.null(sens.p)) { if(nn > 0) warning("XX generated online in sensitivity analyses") nnprime <- 0 sens.par <- check.sens(sens.p, d) nn <- sens.par$nn; nn.lhs <- sens.par$nn.lhs; XX <- sens.par$XX ngrid <- sens.par$ngrid; span <- sens.par$span MEgrid <- as.double(sens.par$MEgrid) if(verb >= 2) cat(paste("Predict at", nn, "LHS XX locs for sensitivity analysis\n")) } else{ nn.lhs <- ngrid <- 0; MEgrid <- span <- double(0) } ## construct the set of candidate split locations Xsplit <- X if(is.null(sens.p) && nn > 0) Xsplit <- rbind(Xsplit, XX) ## for sens S = R*(BTE[2]-BTE[1])/BTE[3] # RNG seed state <- sample(seq(0,999), 3) ## run the C code ll <- .C("tgp", ## begin inputs state = as.integer(state), X = as.double(t(X)), n = as.integer(n), d = as.integer(d), Z = as.double(Z), XX = as.double(t(XX)), nn = as.integer(nn), Xsplit = as.double(t(Xsplit)), nsplit = as.integer(nrow(Xsplit)), trace = as.integer(trace), BTE = as.integer(BTE), R = as.integer(R), linburn = as.integer(linburn), zcov = as.integer(zcov), g = as.integer(c(g, numirank)), dparams = as.double(dparams), itemps = as.double(itemps), verb = as.integer(verb), tree = as.double(-1), hier = as.double(-1), MAP = as.integer(0), sens.ngrid = as.integer(ngrid), sens.span = as.double(span), sens.Xgrid = as.double(MEgrid), ## output dimensions for checking NULL pred.n = as.integer(pred.n), nnprime = as.integer(nnprime), krige = as.integer(krige), bDs2x = as.integer(Ds2x), bimprov = as.integer(as.logical(improv) * nnprime), ## begin outputs Zp.mean = double(pred.n * n), ZZ.mean = double(nnprime), Zp.km = double(krige * pred.n * n), ZZ.km = double(krige * nnprime), Zp.vark = double(krige * pred.n * n), ZZ.vark = double(krige * nnprime), Zp.q = double(pred.n * n), ZZ.q = double(nnprime), Zp.s2 = double(pred.n * (zcov*n^2 + (!zcov)*n)), ZZ.s2 = double(zcov*nnprime^2 + (!zcov)*nnprime), ZpZZ.s2 = double(pred.n * n * nnprime * zcov), Zp.ks2 = double(krige * pred.n * n), ZZ.ks2 = double(krige * nnprime), Zp.q1 = double(pred.n * n), Zp.med = double(pred.n * n), Zp.q2 = double(pred.n * n), ZZ.q1 = double(nnprime), ZZ.med = double(nnprime), ZZ.q2 = double(nnprime), Ds2x = double(Ds2x * nnprime), improv = double(as.logical(improv) * nnprime), irank = integer(as.logical(improv) * nnprime), ess = double(1 + itemps[1]*2), gpcs = double(4), sens.ZZ.mean = double(ngrid*d), sens.ZZ.q1 = double(ngrid*d), sens.ZZ.q2 = double(ngrid*d), sens.S = double(d*S*!is.null(sens.p)), sens.T = double(d*S*!is.null(sens.p)), ## end outputs PACKAGE = "tgp") ## all post-processing is moved into a new function so it ## can be shared by predict.tgp() ll <- tgp.postprocess(ll, Xnames, response, pred.n, zcov, Ds2x, improv, sens.p, Zm0r1, params, rmfiles) return(ll) } tgp/MD50000644000176200001440000001503213731677333011372 0ustar liggesusers8caf20bf27d4ad494fe21092d7b99b13 *ChangeLog 2290e2fd751052601ee76d9dcfac0827 *DESCRIPTION b84738697ab332f3042e16de92e9420e *INDEX cbc0f15c9caed6bf5b0a4b51e4d17205 *NAMESPACE 2b25f8615fc58fa288ef0d0b3d7ef3e0 *R/btgp.R d62cc5b2b7203f4b94647830d1c8cd73 *R/check.matrix.R 3baf3bbc79b7a061fae989fc329d1f47 *R/default.itemps.R 4a035497f663b856b9450bfc7fd9b278 *R/exp2d.R 951ef8c644b0a22d6722564190efd66f *R/friedman.1.data.R 9a3c7f4f872fc8ec3fdff0c10d83bba9 *R/lhs.R cf6f6d40875b697a94b2fb4fd812cd15 *R/mapT.R 41b3d32269dfc34702dbee96fda2795a *R/mean0.range1.R 3e7a3f52c48eb4918fbf96b2a3d38515 *R/mrtgp.R 5c009114b3d0298abb24c92a1fb7cf5b *R/optim.tgp.R bea43b15c98c51ca22a81c84807eb31c *R/plot.tgp.R 1ca650a4e004740dd3286e14653da285 *R/predict.tgp.R aaa1cd4e51a2713a7ae4c97942001d90 *R/print.tgp.R bc0d00e4f6a16fe1b7e2385d52d2ad0b *R/sens.R b55821e40d897bea0fef41c383166644 *R/tgp.R e87f123e3887aa98a07818faac2858fc *R/tgp.choose.R 4061b57137c57516dfe26198645aff16 *R/tgp.cleanup.R f8c0385180c2703fb264deb2e88f787c *R/tgp.default.params.R 76299c616e9a6da8eebb8bea064b2535 *R/tgp.design.R 5ad976e27d25155614c38873829216d2 *R/tgp.plot.proj.R be17e99e2760ba03a39209d75ac58c55 *R/tgp.plot.slice.R f47a264bbe0fca8f60e39d893a3f80fc *R/tgp.postprocess.R 21af361fc357c91c43074ad161273590 *R/tgp.read.traces.R 4fa0e61ec5bed0a51b38a2ca0b2070a8 *R/tgp.trees.R d77f4eb76d59d9f4c85bdee74bce7b5e *README f1fa0fae67968749e4b7481b2f44e561 *build/vignette.rds aa015dd006a0c10d8b36c4c9761ec9ca *data/exp2d.rda bb12c5c06151a8a7a542038b628aa1fe *demo/00Index 4f07c99ea7ca7b8153532fa7707438b1 *demo/as.R a09a287c6f46c3deb33537c0d5044adc *demo/cat.R 238011da83b0344a91696feca7529a45 *demo/exp.R f0a1a08b41eeeff848dc11f0a69d5997 *demo/fried.R 04fdf433d57f6a9d5754f475e11b192a *demo/it.R 2410171831030fd180b7fb267d548600 *demo/linear.R 7a7662bc8eddfac5d0fefe4877ed9c74 *demo/moto.R d780d05ff7012a3c105429b4894a8d98 *demo/optim.R 8f73ca69ecea2bcb03c7881e547af214 *demo/pred.R 28f468247ca35ea5e0012e911dc65728 *demo/sens.R 09ccb8e980d6b0cfc892e1e5017f83e4 *demo/sin.R 13399b4390c8ed75a7ac5d912d1bfa63 *demo/traces.R 0bdf92bf6a67f0babdca467e54642182 *inst/CITATION c4cf139ecaca1796f659b603a0c13de9 *inst/doc/tgp.R c9473233763575d3294e38d8a45e46c2 *inst/doc/tgp.Rnw 624833f899b9991281ac21133da6c046 *inst/doc/tgp.pdf d1c7333ca11c53dde551cf55ac4a969a *inst/doc/tgp2.R faad6232951c6a2bb7f42251d9a7932d *inst/doc/tgp2.Rnw 825a627d15d1000b89426bdb3c895f1f *inst/doc/tgp2.pdf f9638ccde7862936c7ffa6aa0ce9e8c0 *man/btgp.Rd 55a317189a867b61edc14eeb8619a7aa *man/default.itemps.Rd aa2db8aeaeaf556366bc06ad578a1f23 *man/dopt.gp.Rd 862bcdf505e59ea8ab56e7e716b297aa *man/exp2d.Rd b2508fee86f533914749d23ebe7d1db8 *man/exp2d.Z.Rd 7dc85a81d905281589cd2a5b808851d2 *man/exp2d.rand.Rd f9a131dee62552372fe51ca17972ff1f *man/friedman.1.data.Rd a13b0f5e887e5b6bb9279de78413e96e *man/interp.loess.Rd fdfdf1e2df07ee951aac2cb11af6176f *man/itemps.Rd ce238db3adb0d3b0adfb4987f153dd39 *man/lhs.Rd 36b2d2c7d7e247a82bdebeafb5a14278 *man/mapT.Rd 497aa2700abed35df72f4b33071307ee *man/optim.tgp.Rd c52a79d9eb635e72b74af994141cbe77 *man/partition.Rd 861bbb8b6e10c77db18fd1beae84b090 *man/plot.tgp.Rd a7d55b1f82b45f26864d2fefb2e4e68d *man/predict.tgp.Rd e3c9a396b9ee91ff826a62ad4b88d7f3 *man/sens.Rd 3826e0f33399d21dac9851bdc251056c *man/tgp-internal.Rd 875edfd15fef7db691b4ba4cba1cc952 *man/tgp-package.Rd d607a0c734bb169a1cf3d4071c479683 *man/tgp.default.params.Rd c9d78c5f5fb8d1b8ee8a70481748781e *man/tgp.design.Rd 229df6d44e2fd539b16aa2ae5459bde6 *man/tgp.trees.Rd 55e16471d67d6d7cedde23deac58aa3d *src/Makevars 15f6be4b619a3f7b0882f25f2874e2a2 *src/all_draws.c 391f87ba3c7cf48b56013e480a301d89 *src/all_draws.h 2dbc17df3bee7497fea459cf17fff094 *src/base.cc 37573f3fa856b77a76a232572ac20dd8 *src/base.h ab9826a3a4b42cd25c905dcca993097b *src/corr.cc a1e7b68ce6a577e9110dbf0e199c15e7 *src/corr.h c550b3b19f80cc675cf8033215e2f6d7 *src/dopt.c 8f92a351cacd58155c78a0232fa1575e *src/dopt.h b1236318d924a8ec368d9a4c5a0f5285 *src/exp.cc 74fca95a0cdc63dd73296c6c7752442e *src/exp.h c1eddeb020874a0edbbd2c522d9a8d35 *src/exp_sep.cc 8677f3d3650c46cb3d6cda44936e398e *src/exp_sep.h abb6a54aeabd0ac61871f05ba3d68e5e *src/gen_covar.c d356cc0e8ba88a9c14aa5b5157540c24 *src/gen_covar.h a3b890437ebc1d793e8baee7f96da205 *src/gp.cc 09748aa3b85a52f1ca85b60a82db86c9 *src/gp.h 86efbebf06e4b05aa0df594a0e6608d1 *src/init.c 09761c34492b873de30d1f4b8bc6e656 *src/lh.c 86119f93629c41d4767c8ef289d2690b *src/lh.h 035cf1ee2fa5a29d41bf3bab880efb51 *src/lik_post.c 71646e59fcc920a1fcf3df16960482d1 *src/lik_post.h f42a23825e83c9bb1bf61cbc054d070a *src/linalg.c c9cce2c24568995b9a9a6cdd5a723a1e *src/linalg.h 16038b89a011a854ba554e54bb93425a *src/list.cc 52371e91736361411faf5786323b101f *src/list.h 2ee2337619a3a23174e44bb4d4750c6a *src/matern.cc 682be0a76094ef37bc0e6f423f492ed3 *src/matern.h d2dec33f02d84e520ab19ea647ea7642 *src/matrix.c 82a72086e29c44601a675e129bea5401 *src/matrix.h cedd228e030188bed30ffe904882a3ef *src/model.cc 17aab050a33da1ab8ec5e0ee9aa1f3b9 *src/model.h 6c0ff5bad0f4121ac9059375a4cf8e05 *src/mr_exp_sep.cc dccb206ebe50dc0eacff0cb0697963e4 *src/mr_exp_sep.h 06012438c07fd373f87698d0405d51f9 *src/mstructs.cc 19d2790d825bbb5726639cdb86b0400a *src/mstructs.h 78ce07bf309b28898c3007e71285abdd *src/params.cc 81ab1ee751bcd8f4e2e83c61ca4ead18 *src/params.h af6b875a438fd021d5577b5ab7f704f8 *src/predict.c 635136c61fcbb917386bf0bef2096127 *src/predict.h 5024c0c17871cd622129909c597ffbc6 *src/predict_linear.c 9f8baae92d7b46ddd89378c7f95a9144 *src/predict_linear.h aaa8f6223f12237cfb6e3ea4e25ff908 *src/rand_draws.c 1a0cfd8a66d11e536fd9fcc4c34b44e1 *src/rand_draws.h 227c96897d02fe8d8713b1337d9c7fea *src/rand_pdf.c fee24fd60fe088cc52686f8760d5e2fc *src/rand_pdf.h 63f74271418b1fc76d4ffecdfb08dd5b *src/randomkit.c 59896798fb57e6b2bf4e8c8251e8d55a *src/randomkit.h 566af35ef5275604911cef5092623510 *src/rhelp.c 7133a0f471c7db934e6a9bab77270269 *src/rhelp.h 35c87e3e6ef2e3992c87f635cbf2723c *src/sim.cc ed84e3cf4bebc7703dbb7e8b7657124a *src/sim.h 528d66b4d1efc709e05ba156457e9e8c *src/temper.cc 9cab37ec7a79da5d9f0ca1c59b133203 *src/temper.h 1b74ddc05ab3053680e693428b6fd7b7 *src/tgp.cc 119fc3370516cb64b80acda8b9d5873b *src/tgp.h 3f2a729127503cc642c4d06dab0b00f7 *src/tree.cc ada0f53f3fba837987d48f61ae6a85d0 *src/tree.h e8d3942cb915e14b29b1f3293399a4c3 *src/twovar.cc 30824f73ccaf02d3c9df1c86f51bf7d8 *src/twovar.h 96f319b5ffbbe69cac4bce9874609584 *vignettes/motovate_bgp.pdf 4a5a106a111ed23c4c01b7f39e16aadc *vignettes/motovate_btgp.pdf c9473233763575d3294e38d8a45e46c2 *vignettes/tgp.Rnw c457ca0ff12c858d3a65fd4c6f2b9bd8 *vignettes/tgp.bib faad6232951c6a2bb7f42251d9a7932d *vignettes/tgp2.Rnw e6816bfd32b05acc8703a1add5a4d339 *vignettes/tree.pdf tgp/INDEX0000644000176200001440000000362613531032535011645 0ustar liggesusersblm Bayesian hierarchical linear model btlm Bayesian treed Linear (CART) model bgp Bayesian Gaussian process model bgpllm Bayesian Gaussian process with jumps to the limiting linear model (LLM) btgp Bayesian treed Gaussian process model btgpllm Bayesian treed Gaussian process with jumps to the LLM default.itemps creating inverse temperatures ladder for simulated/importance tempering dopt.gp sequential D-optimal design for a stationary Gaussian process exp2d 2-d exponential Data, for examples exp2d.rand randomly subsampled 2-d exponential Data, for examples exp2d.Z Z-values for 2-d exponential Data, for examples friedman.1.data first Friedman dataset, for examples fried.bool a version of the First Friedman dataset, with boolean indicators interp.loess Loess based interpolation of spatial data onto a regular grid lhs Latin Hypercube sampling mapT plot the MAP partition, or add one to an existing plot optim.step.tgp one step in the optimization of a noisy black box function optim.ptgpf calls the R optim function on the predictive surface of a tgp model partition partition data according to the MAP tree plot.tgp plotting for treed Gaussian process Models predict.tgp prediction for (MAP estimates of) treed GP Models sens Bayesian Monte Carlo sensitivity analysis for treed GP Models tgp generic interface to treed Gaussian process models tgp.default.params default treed Gaussian process model parameters tgp.design sequential treed D-Optimal design for treed Gaussian process models tgp.trees plot MAP tree for each height encountered by the Markov chain tgp/inst/0000755000176200001440000000000013726670360012033 5ustar liggesuserstgp/inst/doc/0000755000176200001440000000000013726670360012600 5ustar liggesuserstgp/inst/doc/tgp2.pdf0000644000176200001440000342452713726670363014173 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4598 /Filter /FlateDecode /N 74 /First 612 >> stream xkS{~R)Goi&*` 6ʇawvίO^ZFRXF$ќ(F4iB bSK¹V$%\IA8#8-|U~.u5s_q6<rۼ+y&@ ,NiNo-.蒮nhI?~Я?UpWhnI-ޏ(*-2N+YWadC6ϻc1[rhHOP\&hn-UXfCӋ_?`@4p _|+Fa79<ֻce%۞.ʛqKDh$x أ@='HO=gzI@"pF^u6-/gMk(i\T4]f N&lvS| 4wzڻ@pQ,r%]2v7W׎i~C/|z=s煟&le;u7(i'_/[bg$t"WjRեKz86Hi—}s!}~>IDEtoش&VM,=kG`4mv DgӡH'م-Oo^9^6ΪK#6qcAӀ ‰{xkt5ς=% a\>Dhe@{S g$NAƶtV|@5SXguJonLb)s{7e(kڅz|7ǧNS|&OmFħ'ؠ_p@2 -Tq_9i6NӧzofC:`f)|㿂gy6YP]X\gG^ l:rS/ޔw?Ɲk[z%,^EЀU Ei O0 ^P/8K 1T[ ;QmG@s= 7D U)"' \_;F+"j<tjCJDzohzf7wlu-~>Ͳ4hB31 P6 )/3BI5# iFIУUm>\\}: 4 &Z+7=% ÿ]vO"06E%kPßk!͢BQ &j}qL0v7'k|x?)׳c,ˏ>ECE?Ǿ5 5VADH U2jm`ku7_852yA!5}n cyh4Vz(E<+uvm_Y'{XWռXb5J T$I'4rqS̋YG""RC$ҳ@tPx0xus4ttfoD}WK'@4n{jV:v{1\=148̪;ZV۵qӾPU%ǰڮƊr3(/-:w1uvXHĮ #-eA+؂=O"K02~=$Iy*g #Q$pxX/X_iŨ&b5s.noϋi](W .~dU3W Wwr,YR YC΋ u|SSl6-6Y*C/tu6-& ܃lJT-2-Z@Hfx0*OmhSH:Ǡޱw/x?E"Wס3\$S“nO> `0<5i"v8B"֑8JoS|2@iHQ5r*u<=L[2&Nճȳ^ў.'vu^;S(D3z#y'$=[ڑQ7(^hkbP^P5<7x j=  ץ=e>>?&Tvtq۫ן1^/gӦۋ (*T*!bb-RTl>7S3\ $m&i> (:}hdFߍ8gEt.mߖTцG".fqP.ifZ,> stream 2020-09-11T08:43:30-04:00 2020-09-11T08:43:30-04:00 TeX Untitled endstream endobj 77 0 obj << /Type /ObjStm /Length 1838 /Filter /FlateDecode /N 74 /First 633 >> stream xYnF}Wc K8r:)،F\FܿRHQriM^vvY)&HhO>&a5yAPik Y-[HhH{J-'(@Q01hHI'!ObR@ $&e Ha HJ@`R`  %#m'恴uI{ɂӄoX+б,8LOFk&EXRh %4ر`!9xj%,ғU@0G@1dE+% f`9 HpeÂู# 7` `,B/0`!&[0 g> 05%]~7L4Ɉ(Oؓ\ͦIE*?UºcYu+ q..YɰKU2Lו dxJ\Y/@&o6cdP5#Q;28hr:=K' ,q1aΕ]%,ʧ3Gk^ LP9Jm-Xw9)[τG(Tvd%p]Lc|~at1gI;"6< wK TK '6ގ.8=ݙ`fP.LA6X=eټ]śînG+oh/ީZmm/âKV)h:I+fX \QynX%k$v Vyҭ.\Jyxe6v/\;7v}(pqOP Z7Uڰ`Q X)tnɲ/m̆ꥳ&o:՗ *m=)e̟V cFn}W[W:^e:?xn ݓfZ^i4^α\kԈ~zՊqlWuhI$YG:Bk3v\ kdZuHu×_} '㖬}8 Xᒫ۝4IAq;,IZ`NVL4H#Ly4ZXt~*H>dIJJU#ރNG{B46E7 .3i}eQTyR^^(oYoã.HQ㐠8)ؘӅm:BXγ¬'EV$7=)܈ Ӌ3F\Վ֏?1endstream endobj 152 0 obj << /Type /ObjStm /Length 1200 /Filter /FlateDecode /N 73 /First 648 >> stream xYnF}Wc/@`6M]r<~`e&HJ됱ZE !9sffwHII8ZR8z (cp g L]q#Q 9bO>]NeI ^J^q4;lM^@`O*hL s0L@ւP(i)0<㞴7  t`c<#?%t"#&,2Z2yEG2/x7y@9F2Δd(ρP 4f Y(U)GV<8)Z Xh,Y`#%Yϲa*c `RҐP!=9Ń`HN+J r$Rd bώ'Kݛ7TM0l0DrR+@HN3FeƐwiK#1Uj'k16 6(hJiF]i\Рlc,cEףKкz|?B׻ʣo,/ȶڇ R ۑnWk˸A:UJ0.6v/,.cCzܢ͊^f[ъ ͇tl):wͻ6 (ɇ;D-(QF Ts%Ex]; o㨿2]+ծaʟJȲu*|SBm)6Y[Z(@wҡ@rƏ)o f|k(2=ں-~ 4H?YI+…7%箺k&:6d@S6q(j)GʴZ8O&?Tk^8j?}j0sKIό#ߛٳendstream endobj 226 0 obj << /Filter /FlateDecode /Length 5328 >> stream x\Koɑ  vMދ=axaZ>x|hI6ɦF7YՕ :L:+2Ed|WwLߞ}?k->V,9қ>yfW)=O&kSPڜmțG͓&>K^sy)C:ix XrH6gY@WDt<6*M:mY):}yRR:h ͚.Y!T=css2qGSǙ jc3ECR\}v{]7QP|dCO&<胠b %.V%:ɡH5 Ȭ4MA?f€Χַ*LNʥjF[PHZ$eA^OP5HHBdPTӉ`7{PzXW 2ǃ V4M&;٘ɥdpSbܼ'!WyNsz&E*Zw@q}l'|&4(]M>$C"dJY>vqZ'IvԊJYio{H|㔭I,0+ֱKѪ lnU')usR&qk#>6oXjP&VG0 R}RI~bTμucb\h/wLdL-~{asMY5&)8(ס0d 3$8xϛ_OB0TȘTq(9t)TY!/7{ePD:eBS?%P|76fR~0;3/gKb80c])! י\~ pl>Hy1`i h$nPCW 2̤!/(=LW1bdB%A4mjX%%s, bH2G~P+of\X:DdR⒘\+Inh &k.tY,XF.n'@6P±.) 0\V5HsVq5YFU,n T흍,?@Z/PU-5K?v{Epn[x gf'#HY%02O`ŌXZ~d۽" 0D 9)$f*T'_7ezmHڞDFuޫ|xp?>m.L@^Z;!E#JмϻYk\A]uEzarx@!0x0%FC"_zhe)1\{h%R'8&/ >B5޿QGZ_|Z :?"LbJRX:S1pt#5I7;Zܲ),I<$ -b mCPv YOۖn7G lEJkΏ "q4mLI(k>T֦rWQD(O"'N]7aHQT4YfG"Loa@1XYB*Ue 衝At< WR֓쭩^J"HlsO]=7BmM==hS#6$i[y>>א)wx{CDZy|lя: 3 O@we=o~ȹha)JJ;sW#ihQlv38CѼ]; .R^"p=.G6+in-fЄbOaL/|ס Ba=?%OP+#O@O X"{T/ٰ~ұ IuʤUZqBZH/M)E2 r(4MQSeax6PExz;D .X̦ ŠpJX5;ӫ؅QxY&'heY+4?oBd9y-淢,!# er:)B@ij$f[8T"q*"790ۅj8欑C}HTB`mFȃNåOY@9O#Tp@tv2zP Rbӵ 395Hu} _)ˠczC>=}<\Q80=ח".VW,7-=JP6{94" a/U6)4d]Qz}*PaŪn}#[E$~ͻg=#|:gkG^3~Q<3tGC󴁓7=MO3lDI")Pei5jҨj" "xcoC g3RC %aNa>]vL FpOdM7V}I aj T4آv25Q.(Z8WF ԝsGg%bއn p5#'F/B\V]{w=-Q~n,/R  lbm? /cTsSvߝp9V@f ? Ny;E~t.[9<խe'+΍ .'݌ӿei3T=3GqI$ћ?K5DM&#!}l߶PbHۧE3=^ףbخfӝ$fh"cu-@ k3G+M[㵐QJgZcau4s:!v{,30࢓+Po%zbuBg-'Q-Nxc׆NBVD!tzM/=LC^RbXyZx<`z-j>D%ObELjm& gBgTML+pȾBYjyvZy [@v@&_w= Ե=^Ȼow} Oyo*>_3&&@BiW$;ᑼDN~0cba) 3zK̈+A߀~x$%vd:vF| ;zG&&z#9fXl+g^v } `Zpi˄>=(%ҺZz|ZHz&z ĴT)jEୋr?RqK˭-C F`m* X%BH셨vu|U޻QiFƪK5eU v;Bba13 O.` hz®̮zqxF'" 2^e)HUu K[d:Lґ= 7,?9avxX.q!f\2 Q\ tޥ!gf@M зQ:Oh7[>Wz/YF 32!#L~UBt>SF؉i F w'7Ά"fwq̄Da=+F$wEWqR4XK1Z"mԓ霳/nUA.޾e}ǑtHQ(:CCX\B eÂΪOH gX~$ŦLZl>+9P}w@}t FRZJ=QE҅ 7Txk׳h>dQfE~)|jrq3s\ ]3Sx Dˀ`R.kaI1foAq !NZ"Ž |߀ ,P.Ё[7}#s^N܎g+Ou"{<)9Jjv߷,㸬OtM )(.yQ(/G 3E~RǶvw^vsռ:M5dm'? )k"ݟE|/s+/K*tEwi4J程2}|xw Q; yEv ";ц. ۧosu3B>=fKD<]fW-2k.x>J}tI+)QdiQu;FIQAJjK.a5tW@hMoޏyj#":M{aODoc^ҖS"otPĬ[ƹ)g9mWڄe!ͲeXjOj F=Y辸g}Nc^>S]O_ ג? :IiD_aj.')r%әdAxMTR觢Rقk%hm~QREV OqgaW&$RNqQ t"T=Yj'KxpI%W[N.%'ZȎC%9Ӯå'_UƑX_Q/> stream xV PSg!{D6]zvkV@|B@y ܓ"Z(Vk_umjXn?O2ssw%D!3 !P ԨEoLoy|yhȜ1)1 FSB !9'XKQK䓥3Ν3M:kƌ҅X,A"SD)dj'^A)RcyAA&PHT&E/,cME$9]8\M -]]5ɻGbZv Hʝ(`\S]kWU9qY9.=q#p$ Sh}46(C~'c餗1̋x dG4ȫ2TK,Y`* ,U$'+B/;U=qIkapͲ=|.|m{J4Aඌ/jۊ 8",Z8?:m$}Ѝ+B4~V.BJ*:t0&= c%0< 4C7.8 $~+A]=6=7d2 |ڜ'y7Xgե@4#K4;]=i$x"3sEfsI[\ZPlI<: ̃3v',(Zb%+ga͆"R( Ist?y% hhAEE'6B"(5s:@ٲ/Z'If$eӿTD24 OGoj>"hRC!Ł#Ϻ=|I]XBt"Ę51iC'bɞm&%k>eI'[ǜZpnN#lv~0Frw)홍pZo2@)rrOJ\)ǡ{:gGqZ.B*ōhrd rApk>'( C8$t< sj<8H `Wt/:'o 3-7ZL:j)ǔ;7N%ī8WIB/zLp:npGX6&A Bm'Aafy QpoQz cKθ9knr :.ۄAT.pXfk-!+<`*ח45j /}La`N#M3-oPm(f')=-X&y'0=[PzM>3NwijCvml;qw=𠅄Ż]=!,B?E|m2̭we('[ "01g`CjjIzLeV&e_N~,S5^PUKHvCZ%(vks,xnd2u#4e\An.e%yp`V-8дaudN*A”AslU%~Qv ?n|+ղȁ{Dz,܂ȈzZ4WH-D]jLXqi^Зw:/[$h4⿧7 ^B*b Z`^@ĔN%T3 LJZ<$DyBYBy/XܜQSEZ˙lʲͤ#;<͘+V4; XeƞD В+eNψLw 3h߲Wsmޔ IFpԔFC_}^UJeD;;?Dʋz!ֽܺr#C"i:pVD\Ҙ{E^^'Ѫb-4βWB[mE DTC3#䰕 ǃx `6EMp:tKrݽ hąOZR\4VfL?A`M$"w)x'+_'=)˥Ys64p&DANWN)UzIi-RǠ~u#^i#Z,+-9wH=hIum-vp6=d0c^|&i7i{W}l9V!*h*!T %ҝ_'+Wcr}عQruU`>DI3\gn.(u,cA d8_~B+Aӯ<=Ol((>ܢ*LFN ||n[])q}CxZ_f;hSl!s( jd[ B1 ^CV)t:^TV9EHYppx)a=uJNow$ELӇgendstream endobj 228 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6220 >> stream xXXSۿ1ps]hjUu^u1D@Q$@V !&) *.{`ԶQԪuUZm?=$_=X??!=H޸~D7磉wl@>c}܂`s??)"8dKqdSN8~ܸsC#=%A[%x% GHDƎJ[-F;JC$AQA☠M ǥ[-u/*=A΍X;O8_@0j$zI_.ݴ4h[=CBW ߺwq0q)|2uڰΜ5igG&OeTb(F p‹A$Fgb-1XG'3X@%Ebb 1p%&n$LxK baG#M|@|H=O "$%z їp"l1/wLJ=R{{Oظؔ-%Y2/TBTyOǞzyj齢>}t}^moA_{+9`ߏ8pಁ/ЃP|SkC÷1xbȊ!5 w&+㊀z^=shn)pHK C۷هJ@DD=(a!KACCg렍-L!>PYt0)! 8[4^3~1&>7=4uц Y, J%dB$X%GmAa Kgm-PO޽ǩ< oPec1dJvrmk;_mի'a_$CHo+EH٧%u:R `yM0ĿACyoM*rzPd>u4=VvQ9 `->Na0~(x1Fx3qVbHӨׯ`zBo.\Qs(\O]Ԥ4&]-!7 `< q 7<%PΓ!@ǖPMBoVF8mNdn%kDz)|yl(k-xLk[G-ZŜ1]ӌ A6(AP*]"IcdbݞLi ! T2ٔWTP-c՘F~c #ݵI&7[]s"#!* o !2}G?_|iK`vt{nOC{2ȚAu|`@MvuAC] !ַD7bV#ݐ^`Q܆+j p] 2smy.+j/[s/עl5<ߡJ;Z2t#&8t6nw6F@mkZ]պC֓]EsK|΅ޑQjI&X 8bS]Bj;el!Nޔۉ`%9$Ϳ&$H (|");L RPЉ)7c'.+??b:kM(p1Mg; uL]*d*et֑A#YvJ ĪRәİ5 F%r=[T4d#;kd,>f] 8\Oc~;%93uKK(t&S_AUha2y&K5a  #bE~3 {Nxr=3ލ-1eWYlW}->5 I57F^5f`Y+ơ{mwԑP` ėr2>}G6LkMnu )nE)r*\)|԰Гjd/*;]Y#4/R@)K`_y&(ápЮelZae+~1tb@zu(6Ful",NL R nz) #Ks[:2jr# r\ R0RO PƤ)wbLx23JRWY)vV%  Tg垀죘g@ByL ss1qc~quӟNȩzW;͍4 utq#hl 7"Bw@[|xnDa["77F5oG_ Ơ@gþ :]K#ftrL*3-EĪjF1t̘ I*Z[diߨ99=^@]{@>1͜f)s+J+SrSvuę˗ay%)Ӂ/ɪ\\?76|2U0\*T۱->2ORqi@-ÎShe"$TpqZ=3Pe2 k%/=[WsM)! fa.Xy;gk dJ" e3w,;Gb)kVyyKJbaܝ{>6/px<0TCSMωnd𜵏vC4Mв 7 OהӋgLt]6# ~#t ֠$T"kڡQh;p) QL[F]"(t6CMG3pqE298;>mlb4^.5zӜ:ګlM; Vc܇w5_'2s#knHaA D|v?=x~zO9 Nܸa\rL]~•g3-[uŔԹez޿wĽG".L:!Lw $i"6SnG* TҊP&A ԛwY8,w#vf呎~;͉̹%]7P<c Bv _tihj  &ل,[:;FT$r0>%[T\#/R#9KS(e4,Pj,$sCbЈE8nCPAxEↃ{n8"|ؠSåAޱʌT G!q2QhmԎ> stream xcd`ab`dddw 641H3a!O/VY~'Y|<<,k!={3#c~is~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTWqr-(-I-ROI-c``` b`0f`bdd S{N|qo1~K $_i?"}w}>|g|g.904<_Nӿg^8wT\׹X*y8O>/}5endstream endobj 230 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8568 >> stream xz XSW8=Ԟ`gyVp8 $ a IV 0TYT֡ZVkOܴhk?TW@#aH3fL8a Aa^RA^Cú`߈XwDD?>::zWP0#8DDpX8X+qwࠐ0`0B/.nr 0tQ%D.ZgJ#׮> dB 7v]?܀^0@4iƁgv5{ZHRϡA= 8h!o y4]?L2l0݇WzDjNikfܛLFJR*oմT|^=PGFsI 3z #{;uɠ}&cJrI܀Je m4.*DlpȖk7 @e}YȭA <}Ӣi"<0F*&UbXFR 0A˝-OCRӵ.mZ俽v3$lcT  b*'{x*6A,-Y&) !R2T/2+#tEƒ&$W)" y . X{^*>͇P _&KT hT2!96·G6އ*$ hI[Gy )t։2g6Z!ჯ:}{J]7&ox1~AZmA.iҍӱP2xH >m̕ FJlDYhB' f= ¯7Do,މ=?( 9> 7;pZ`o }|G}}9y&:\TII*,^:uT7dP$ /k>*+?~b7̐R{^8Zk wyc<$x̅9LdrJ&gf{^ x9v$mMR41>EVKR$L/"n?:o#ehAYtdHz[oV~Jn `Hw\{w7X0}ERrE%|\ק{J:wM(M~Ic-@<7w=L(-,DT&@YHRn@&4M) \!J6ldpM%,tMF]rnTj)Jǃe@9"[s򋢾uH/~Y?\+xm+V$y-=7S]`תvx Yι0"q->Ru<_DM?3 XiD2yBB'?evޛ~8TJ:,0ma[&-m$QFJS@+űi4RV ½O'ع;5W_Zw*stC$Џ Բl:te$)Q&dFXa]Yܘ}YKmBU!vdMdr17BgUG>k^ զH&~YM+O!p]Jc""20˲V^jڳ3ЗC( M7~Vln "R?z7È\^,YKYN*L%-D1٘KҲI'E? w(ȚlX5 CFltxuӅ2#7$("[Qz 3*! `u6W RU EPoFEԨi20F2vҺ4e.Q(lkK B\IpMh_y|u!P" Tq񠶔(LKݹZwwHU1 x\l75-j!Ӿd']d:(T';bhT($+kAeIɊIwIR2!toQݷES}>dfgӼx1{ oR aV};v{y=c2iybeUiiU?$H*-kY߉o1ު7 ҳ ;ޡ֣l{?'3EKNG OKcHܶ7EvhnAO;ƈk.)&2;Z 0BaKjTB$$FF3%>X{NI>I:n)0{I<-J@bYZ6C9UU5Uudt3 t!ڃRSrc#ٻy4%lND"O[>n,y.dۃ^WVoͦ?B8!kUe +猔%yzlp 'BuoP%9y=mU J#吖/#}YtκhjwVNo@d2"f1V-ea'⬜J^a^+e/j:h:tOx;2pItwfpqIF5+b I/vzU&p{MڂlI$UM"7T9gbr#M9]X*73B3XgZ^Dƾ 9FZZ3( D#;yUFZ\PЁ1e Ƭƪظ(Էck-U ӽ/Dr"&UU,::w77 D z377jeR53O1hm-|*%ϙTq Qy ^&!xoD#1MwbMOtcH;#/ g}.1bat >FIսyx(,|ώ APurqÙ|tc"'٬ hM*XtD5bQ܃W;WIXvQN G5$G7p'#Q[ˋ$hoYC]ct3СCnVZ4zđǾbVq(KԨ Ak4Z&6'm jpJ: )GvAE Lʿs ¢ICpl("{BQȒN{' hauh\)gr_ǃ4$BmTyv ї c#v"x$LD''"g@VkTHrghxQ[tBHo GD畘 Q7ÇrU6C R:$ߴelס,6GzGeUDv z,DRD|;=9 `*TΠjJDDN ?2"S(8 9_w-eB>\6enɾ##,Gd Љy%9eĺ}v%$A; ͟ΒkR% R254(&m֢ިdz7Ϯj`7l)!\ZF(՗d$ Jk%<#ПðX"ɢňtIEQ.\>ɫ繏' ?@~$4zQGM [< -ٳW[˖ -t7 r̓\Y%n;`D4_YP33@4Ң 9`!ֱqgY,ݶ=(JLP%2kp_/yyߝMe}/zuo| cr3cYG#)_?+i-ZSj}fCm #N}Q)2*i. #i'A ) "cV @Eo=}9G:dnE}+DN\'SUTSPVSb${)WNH וVkfSG;\xMSYm2d\O3n)l44ۘv*H~$7,]s"zgڗ~wmA6cl)nAh׻OPBHyф|(K!#OȐЊȚ*$f.!) ֨(mSW#č\ F& W#nyy&Tk9?*BMȑ:Qd;MHKE?>v[2/ E{%I ܒ ʁ ׿;ZNx}*ڍy9+249̋99y %*L)UB<f1$6\/:B+}1[(ri5Dj4أ6~|Zky`13Ʈ܊YԶb<oHr l?XP+R9!VmZ 'Jp,!8~FۼsrVqEr {\] DyxUoJ ڛڡbYY˗,QRg1M4gMU>V ;>Ok=Юya< \_༺lIBJc:vx*LU'ʒ$mR2_$)c εvx2 uqϳ5_ |[v\r1ɕءY%2YYb:g-ݑE!@'] &/Ef@a =a I]OZd&I֡^h24yZZf\i* qfsf,Dͩ WQ~Ak:PnNDpB7Й <ǘc4:",:X (|A&?҅2}Z25I⇿:)اfg A-sKȭG0p_qnJ`TS}󮅟~t8CmCf,+Asph{a+x|&|JZ2#;0/ee "fHj:H'4lxf!@Lq%ILLJEڧ$R@$e-I{'|'Wh>>zQc_ 4Ye\zY|zZ[Dj+_" xF0q,KFLt25ŻbʃSUVW;_ Ou[v9d8&4 ztJpDt 8uRiaѧ-F7p2=dd ᡉ_8^G}RA6}gƙQtnH+6V/[vr+"g=F(II<!jkzkK΀e0}ƿ Z4A:-cn8 Y/eZxC_|}ΐAJj3Ag.2B.25by; gR5GK.V<;G\LyJ ܴ\]vs1h{3%$:,8.QB8z=xbX*ȾF!L\LN'w9luMS'y.~nm^ǎ{xYSM^ gIB<¶ P~[QϚ/M:O+ힻz1MKT(T*KLԙԫpt*kr et)3_,dx7'KxPx&XD? b6͂ y)*8Ht~&JؘR(pCH](m!y #FEH 4FDFDo,J3PLcC!ِT PQ}%ORV2_E0l2 ݽv-7W4م"u,rn5WT$Ũy2,7BtA ڸ߭C3mh=z+B4yiXX{p8{[F&bN $~r3Ƅ!jDZnPu^zθtB%W4Nxm7YDtY+ ש {JD sHp]F !Pk"і[.DO>xpsS$wC{t  ! K<5h 6-#ٛlΑC<+%$M6"ޙHw0 B4Q>@Esda-1Bk@h|a ("bWD4MDt&dG=w|ڌ@ܻv66_` 7@c bc .&lpD>!JpROM1QưتjEkEEE*xm '.-f SwC6;g)ҪҲN7cmP&듶?_&Lzgcs!j.-L hBby*ϭ %to}kf_9W0EDʪDv*JN5jk#2h4,^)1ݦsȖ4I/eȄiME GM;7{Ɔt!@]7_gq BӖs!Ć(bHqz)bC-Xru!$э^@Mw?H>6u44 * -./D.Q~NXlKĥs1 1Wr{i ={^.ًkPendstream endobj 231 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1071 >> stream x=QoLSw}Ҿ'+US{:6DA41T 4(mJPB2@!22(9YH>a2eK\}ݏd˽$'sMEGQ4M3ye7=DZz5JJ+]HDۑgAJ(=MqhZ(M[O[k*]Hե srf[6mv j"jFYkBUWm;Էv{Ͷ,Ñ5eZmU2G(4l j EZAx!3E˷kPhl:RGQQT UJQ.f!-wG {SraaJH룯Gd%9qh+trqW\\`Sg<|\ba@9+ _ IgD=4<'ΐǒI 2.' d%"U <4(gȶvy9s z],L|+Oy ,lcttY:)!>V%rMJS״x$ C{!.,LYJz9Y{ z8F=W;`k&@t_4N[XҤkuYPqcZ'4mx=0D85} >`10e0^ՋQS;Ů \=i#6x.M]hsjF&66W9rzۄ5LzVL)2xS#jR$x{qu?58ːC^=\^iO!k6>&ɼ9Yl-`Q$Jj @ɡ#O =1d,kǺτ;@$ aɚo!lvep<˨ wxՉ~i加WDeeTQԿendstream endobj 232 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5707 >> stream xYgXT>ETs5g0XbT1$bQiR^F SЋa H`AF1QKh{w|ߞAyn~<<^]h.̿p+u=wؼN t׵oفlwkF J(D ^!˽|ȇ gPmQcfDE7qbtt -*yoo߭ BCWx:[`9748L쨁 ʞSC(j5bר~,* G$i)`HNa7]Dzz&s5y_k+Ͱ}>`}v7m~?mS<\|gHcC. yʾưs8:RvJp:9x]w FX/#^ƦwNPOc7įU3Atf LЩWi7FTuQ `iU V!n?'|`cDq7@3" b ;Qd5G:`V 1DwFI-=M.`AW.At d HJ6kpmp+4<{vu&4;GT?;o8x[Gkq1[!WݚNሪU̢s̝k!bx#l-? ^RFXI9T{oNO6xs||marЀ+_D4*Zo*&t s );F&08<[!_ZFX֓_vE МO/o8b:V5(̆3O) $BZ;qєqZ-hKyWhp]Rd{[n Om4BV.AZN Z` !Lt$%rJErB[ `;EnšR>FulԔG&M nw4:;gBiO>0S$AtKFSQLPP=}G',SBMAƆSGG ֯=6 <O^ MSj8fI ֣PzW/<Z%DsQ,i#ѲzfX#x5r'"D?7&ޅ:|73ۤͿUD9}#P Nĝ(!#Q[B{4ZI`OEviaANcaWYʷ1S"D/ыS7/t/r%x=&88쫩CS!ϯ˿'Eεf8{q2ln*9\)+燚e|n%{i QGA$|ӘI7 RT M㈭QWdlR`* G,9 4 #Ǭmz!BFnFj{-5+.Ѽl+آݶIm%JOsǠzEZ N-'7"!BvmbU^b¬;UvSmԚ4FvUeHuiPچ_71GV1%%>4ǵ"-: B6AHkx"XtZZ~`ć7~;O>"A}g,byPT~h 5zV7Vl}-lf:((&/%qSO!859) ZioM8⩒ժ A 36CכǸW iW#pLOL.O ]ҁY)#Ō18*Z'*I?&p,%Tk(E3=o伕`HdKk>l)<?CA ZlAIZZB&,IF̯M=mkH=M1(Ip )0peq (訖MiI`|(cfWZKh~Q>ƳEXsʑd!A{JdsB,4*QeȊH{@N ٤膨~;<0COGN콰G ~$,Kզ*.` $Fj>砉r=( ㉰c'~X%x!~OD'IhZFSdCDPzy8gLء"BSoܽB4"}"H+DGW+͟nYAW?3vDu"`!`P!FY4[lO_g JT¢޹KM@gyhɛ*k:/!K';~UIr *jZ ԁԤPf+ PQo mSs;#*$M2K 3A)e&eW$o{{q^ ^:)0,[Cq7Aq}١~ҘpdC f $ i& ϳo-8r}:g[qww9446:|>?{YʐȐZ2/,GsMU( T 'td{(K4BӊPJ`*W m$j h`‡~v6KخҌ|2 (ھ OcD} >{( jZխ }# )&NC|-'V]{H(jmz$O9Ү-7e"?,&Z2u !:!)5 v|:Ɍnif9!߽}M/=*"ͯ4]ep7_I$-/_e}U֡,Q"GI0S\h*=޽kN@9;bI