Revision 63d8a43408637eef9a81e05ffd7e6ff3afa51947 authored by Robert B. Gramacy on 20 September 2006, 00:00:00 UTC, committed by Gabor Csardi on 20 September 2006, 00:00:00 UTC
1 parent 622e02d
predict_linear.c
/********************************************************************************
*
* 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 <math.h>
#include <stdlib.h>
#include <stdio.h>
#include <assert.h>
#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, nug)
unsigned int n1, col;
int i;
double nug;
double *FFrow, *b;
{
double zz;
/* f(x)' * beta */
zz = linalg_ddot(col, FFrow, 1, b, 1);
#ifdef DEBUG
/* checking for a old bug, where predictions went wild */
if(abs(zz) > 10e10)
warning("(predict) abs(zz)=%g > 10e10", zz);
#endif
return zz;
}
/*
* 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,nug
* returns the number of warnings
*
* b[col], z[n1], FFrow[n1][col];
*/
void predict_data_noK(zmean,zs,n1,col,FFrow,b,ss2,nug)
unsigned int n1, col;
double *b, *zmean, *zs;
double **FFrow;
double ss2, nug;
{
int i;
/* for each point at which we want a prediction */
for(i=0; i<n1; i++) {
zmean[i] = predictive_mean_noK(n1, col, FFrow[i], i, b, nug);
zs[i] = sqrt(ss2*nug);
}
}
/*
* delta_sigma2_noK:
*
* compute one row of the Ds2xy (of size n2) matrix
*
* Ds2xy[n2], fW[col], IDpFWFiQx[n1], FW[col][n1], FFrow[n2][col],
*/
void delta_sigma2_noK(Ds2xy, n1, n2, col, ss2, denom, FW, tau2, fW,
IDpFWFiQx, FFrow, which_i, nug)
unsigned int n1, n2, col, which_i;
double ss2, denom, tau2, nug;
double *Ds2xy, *fW, *IDpFWFiQx;
double **FW, **FFrow;
{
unsigned int i;
double last, fxWfy, diff, kappa;
/*double Qy[n1];*/
double *Qy;
/*assert(denom > 0);*/
Qy = new_vector(n1);
for(i=0; i<n2; i++) {
/* Qy = tau2*FW*f(y); */
zerov(Qy, n1);
linalg_dgemv(CblasNoTrans, n1,col,tau2,FW,n1,FFrow[i],1,0.0,Qy,1);
/* Qy (Id+nug + FWF)^{-1} Qx */
/* last = Qy*KpFWFiQx = Qy*KpFWFi*Qx */
last = linalg_ddot(n1, Qy, 1, IDpFWFiQx, 1);
/* tau2*f(x)*W*f(y) */
fxWfy = tau2 * linalg_ddot(col, fW, 1, FFrow[i], 1);
/* now kappa(x,y) */
kappa = fxWfy;
if(which_i == i) kappa += 1.0 + nug;
/* now use the Delta-s2 formula from the ALC paper */
diff = (last - kappa);
/*if(i == which_i) assert(diff == denom);*/
if(denom <= 0) {
#ifdef DEBUG
/* numerical instabilities can lead to a negative denominator, which
could lead to a nonsense "reduction" in variance calculation */
warning("denom = %g, diff = %g, (i=%d, which_i=%d)", denom, diff, i, which_i);
#endif
Ds2xy[i] = 0;
} else Ds2xy[i] = ss2 * diff * diff / denom;
/* sanity check */
assert(Ds2xy[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, nug)
unsigned int n1, col;
double *Q, *rhs, *Wf, *f, *s2cor;
double **FW, **IDpFWFi, **W;
double nug, ss2, tau2;
{
double s2, kappa, fWf, last;
/* Var[Z(x)] = s2*[1 + nug + 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*[1 + nug + fWf - Q (Id + FWF)^{-1} Q] */
/* Var[Z(x)] = s2*[kappa - Q C^{-1} Q] */
kappa = 1.0 + nug + tau2*fWf;
*s2cor = kappa - last;
s2 = ss2*(*s2cor);
/* this is to catch bad s2 calculations;
nore that var = 1.0 + nug for non-mr_tgp */
if(s2 <= 0) { s2 = 0; *s2cor = nug; }
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,nug
*
* Also calls delta_sigma2 at each predictive location,
* becuase 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(zmean,zs,Ds2xy,n1,n2,col,FFrow,FW,W,tau2,IDpFWFi,b,ss2,nug)
unsigned int n1, n2, col;
double *b, *zmean, *zs;
double **FFrow, **IDpFWFi, **FW, **W, **Ds2xy;
double ss2, nug, 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<n2; i++) {
/* predictive mean and variance */
zmean[i] = predictive_mean_noK(n1, col, FFrow[i], -1, b, nug);
zs[i] = sqrt(predictive_var_noK(n1, col, Q, rhs, Wf, &s2cor, ss2, FFrow[i],
FW, W, tau2, IDpFWFi, nug));
/* compute the ith row of the Ds2xy matrix */
delta_sigma2_noK(Ds2xy[i], n1, n2, col, ss2, s2cor, FW, tau2, Wf,
rhs, FFrow, i, nug);
}
/* clean up */
free(rhs); free(Wf); free(Q);
}
/*
* predict_no_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,nug
*
* does not call delta_sigma2, so it also has fewer arguments
*
* b[col], z[n2], FFrow[n2][col]
* IDpFWFi[n1][n1], FW[col][n1], W[col][col];
*/
void predict_no_delta_noK(zmean,zs,n1,n2,col,FFrow,FW,W,tau2,IDpFWFi,b,ss2,nug)
unsigned int n1, n2, col;
double *b, *zmean, *zs;
double **FFrow, **IDpFWFi, **FW, **W;
double ss2, nug, 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<n2; i++) {
/* predictive mean and variance */
zmean[i] = predictive_mean_noK(n1, col, FFrow[i], -1, b, nug);
zs[i] = sqrt(predictive_var_noK(n1, col, Q, rhs, Wf, &s2cor, ss2,
FFrow[i], FW, W, tau2, IDpFWFi, nug));
}
/* clean up */
free(rhs); free(Wf); free(Q);
}
/*
* predict_help_noK:
*
* computes stuff that has only to do with the input data
* used by the predict funtions that loop over the predictive
* locations
*
* F[col][n1], W[col][col], FW[col][n1],
* IDpFWFi[n1][n1], b[col];
*/
void predict_help_noK(n1,col,b,F,W,tau2,FW,IDpFWFi,nug)
unsigned int n1, col;
double **F, **W, **FW, **IDpFWFi;
double *b;
double tau2, nug;
{
/*double IDpFWF[n1][n1];
int p[n1]; */
double **IDpFWF;
int i, info;
/* FW = F*W; first zero-out FW */
zero(FW, col, n1);
linalg_dsymm(CblasRight,n1,col,1.0,W,col,F,n1,0.0,FW,n1);
/* IDpFWF = K + tau2*FWF' */
IDpFWF = new_zero_matrix(n1, n1);
linalg_dgemm(CblasNoTrans,CblasTrans,n1,n1,col,
tau2,FW,n1,F,n1,0.0,IDpFWF,n1);
for(i=0; i<n1; i++) IDpFWF[i][i] += 1.0+nug;
/* IDpFWFi = inv(K + FWF') */
id(IDpFWFi, n1);
/* compute inverse, replacing KpFWF with its cholesky decomposition */
info = linalg_dgesv(n1, IDpFWF, IDpFWFi);
delete_matrix(IDpFWF);
}
/*
* delta_sigma2_linear:
*
* compute a Ds2xy row under the (limiting) linear model
*/
void delta_sigma2_linear(ds2xy, n, col, s2, Vbf, fVbf, F, nug)
unsigned int n, col;
double s2, nug, fVbf;
double *ds2xy, *Vbf;
double **F;
{
unsigned int i, j;
double *fy;
double fyVbf, numer, denom;
assert(ds2xy);
fy = new_vector(col);
for(i=0; i<n; i++) {
/* copy the jth col of F; to focus on the jth
predictive location */
for(j=0; j<col; j++) fy[j] = F[j][i];
/* fyVbf = fy * Vbf */
fyVbf = linalg_ddot(col, Vbf, 1, fy, 1);
/* finish out the formula */
numer = s2* fyVbf * fyVbf;
denom = 1 + nug + fVbf;
ds2xy[i] = numer / denom;
}
/* clean up */
free(fy);
}
/*
* predict_linear:
*
* predict using only the linear part of the GP model
*/
void predict_linear(n, col, zmean, zs, F, b, s2, Vb, Ds2xy, nug)
unsigned int n, col;
double *b, *zmean, *zs;
double **Vb, **F, **Ds2xy;
double s2, nug;
{
unsigned int i, j;
double *f, *Vbf;
double fVbf;
/* sanity check */
if(!zmean || !zs) { return; }
/* for the mean */
linalg_dgemv(CblasNoTrans,n,col,1.0,F,n,b,1,0.0,zmean,1);
/*
* tread x's as independant, and just draw from
* n independant normal distributions
*/
/* allocate vectors to be used for each col of F */
f = new_vector(col);
Vbf = new_zero_vector(col);
for(i=0; i<n; i++) {
/* Vbf = Vb * f(x) */
for(j=0; j<col; j++) f[j] = F[j][i];
linalg_dsymv(col,1.0,Vb,col,f,1,0.0,Vbf,1);
/* fVbf = f(x) * Vbf */
fVbf = linalg_ddot(col, Vbf, 1, f, 1);
/* compute delta sigma */
if(Ds2xy) delta_sigma2_linear(Ds2xy[i], n, col, s2, Vbf, fVbf, F, nug);
/* normal deviates with correct variance */
zs[i] = sqrt(s2 * (1.0 + fVbf));
}
/* clean up */
free(f); free(Vbf);
}
/*
* predict_full_linear:
*
* predict_linear on the data and candidate locations,
* and do delta_sigma_linear on them too, if applicable
*/
int predict_full_linear(n, nn, col, z, zz, Z, F, FF, bmu, s2, Vb, Ds2xy, ego, nug, err, state)
unsigned int n, nn, col;
double *z, *zz, *Z, *bmu, *ego;
double **F, **FF, **Vb, **Ds2xy;
double s2, nug;
int err;
void *state;
{
double *zmean, *zs;
int warn = 0;
/* predict at the data locations */
/* NOTE: there are no if statements here checking for
the non-nullness of z or zz -- presumably this is because
none of these statements do anything for n or nn = 0 ?? */
/* allocate mean and s2 data */
zmean = new_vector(n);
zs = new_vector(n);
/* calculate the necessary means and vars for prediction */
predict_linear(n, col, zmean, zs, F, bmu, s2, Vb, NULL, 0.0);
/* draw from the posterior predictive distribution */
warn += predict_draw(n, z, zmean, zs, err, state);
/* clean up */
free(zmean); free(zs);
/* predict at the new predictive locations */
/* allocate man and s2 data */
zmean = new_vector(nn);
zs = new_vector(nn);
/* calculate the necessary means and vars for predicition */
predict_linear(nn, col, zmean, zs, FF, bmu, s2, Vb, Ds2xy, nug);
/* draw from the posterior predicitive distribtution */
warn += predict_draw(nn, zz, zmean, zs, err, state);
/* compute EGO statistics */
if(ego) compute_ego(n, nn, ego, Z, zmean, zs);
/* clean up */
free(zmean); free(zs);
/* return a tally of the number of warnings */
return(warn);
}
/*
* predict_full_noK:
*
* predicts at the fiven data locations (X (n1 x col): F, K, Ki) and the NEW
* predictive locations (XX (n2 x col): FF, KK) given the current values of the
* parameters b, s2, d, nug
*
* returns the number of warnings
*/
int predict_full_noK(n1, n2, col, zz, z, Ds2xy, F, W, tau2, FF, b, ss2, nug, err, state)
unsigned int n1, n2, col;
int err;
double *zz, *z, *b;
double **F, **W, **FF, **Ds2xy;
double ss2, nug, tau2;
void *state;
{
/*double FW[col][n1], KpFWFi[n1][n1], KKrow[n2][n1], FFrow[n2][col], Frow[n1][col];*/
double **FW, **IDpFWFi, **FFrow, **Frow;
double *zmean, *zs;
int warn = 0;
/* sanity check */
if(!(z || zz)) { assert(n2 == 0); return 0; }
assert(F && W);
/* init */
FW = new_matrix(col, n1);
IDpFWFi = new_matrix(n1, n1);
predict_help_noK(n1,col,b,F,W,tau2,FW,IDpFWFi,nug);
if(zz) {
/* predicting and Delta-sigming at the predictive locations */
/* sanity check */
assert(FF);
/* allocate for new pred location predictive means and vars */
zmean = new_vector(n2);
zs = new_vector(n2);
/* transpose the FF and KK matrices */
FFrow = new_t_matrix(FF, col, n2);
if(Ds2xy) {
/* yes, compute Delta-sigma for all pairs of new locations */
predict_delta_noK(zmean,zs,Ds2xy,n1,n2,col,FFrow,FW,W,tau2,
IDpFWFi,b,ss2,nug);
} else {
/* just predict, don't compute Delta-sigma */
predict_no_delta_noK(zmean,zs,n1,n2,col,FFrow,FW,W,tau2,
IDpFWFi,b,ss2,nug);
}
/* use means and vars to get normal draws */
warn += predict_draw(n2, zz, zmean, zs, err, state);
/* clean up */
free(zmean); free(zs);
delete_matrix(FFrow);
}
if(z) { /* predicting at the data locations */
/* allocate for new data location predictive means and vars */
zmean = new_vector(n1);
zs = new_vector(n1);
/* get data location posterior predictive means and vars */
Frow = new_t_matrix(F, col, n1);
predict_data_noK(zmean,zs,n1,col,Frow,b,ss2,nug);
delete_matrix(Frow);
/* use means and vars to get normal draws */
warn += predict_draw(n1, z, zmean, zs, err, state);
/* clean up */
free(zmean); free(zs);
}
/* clean up */
delete_matrix(FW);
delete_matrix(IDpFWFi);
/* return a tally of the number of warnings */
return warn;
}
![swh spinner](/static/img/swh-spinner.gif)
Computing file changes ...