/*
This code contains functions to make Gibbs sampling for a full Boltzman machine model.
Here a full Boltzman machine means everything connects with everything.
Compile with
gcc -Wall -pedantic -std=gnu99 -shared -I/apps/lib64/R/include -I/usr/local/include -fPIC -o gibbsBM.so gibbsBM.c -lm
*/
#include
#include
#include
#include
#include
#include
/* function to compute vector dot product*/
double vector_dot_prod(double *a, double *b, int n)
{
double val=0;
int i;
for (i=0; ikold) {
array_copy(p2,tx[knew],txc);
array_copy(pt,txx[knew],txxc);
}
if (knew==n2-1){break;}
}
PutRNGstate();
/* convert tx, txx back to single array*/
array2to1(n2, p2, TX, tx);
array2to1(n2, pt, TXX, txx);
printf("%d,",pt);
}/*Rgibbs*/
/* Function to simulate images given a theta vector for a single class; the theta vector usually a posterior mean from training a single class
TX: pointer of theta.x vector
TXX: pointer of theta.xx vector
N: pointer of n, which is the number of images to be simulated
P1: pointer of p1, which is the number of hidden nodes
Nx: pointer of nx, which is the number of pixels
VH: pointer of vh, for storing simulated images
*/
void Rvh(double *TX, double *TXX, int *N, int *P1, int *Nx, double *VH)
{
double *txc, *txxc; /* vectors to store theta.x and theta.xx*/
double **vh; /*double arrays for visibles and hiddens*/
double u; /*uniform variable*/
double *vec1, *vec2, a, p;
int p1=*P1, p2, nx=*Nx, pt, n=*N, i, j, m, *idx;
p2=p1+nx; /* there are p2 nodes in total */
pt=p2*(p2-1)/2; /* there are pt theta.xx in total*/
/* allocate matrix/list using R's memory management tools*/
txc=(double *) R_alloc(p2, sizeof *txc); /* txc is an array with order p2 */
txxc=(double *) R_alloc(pt, sizeof *txxc); /* txxc is an array with order pt*/
idx=(int *) R_alloc(p2-1, sizeof *idx); /* idx is an array with order p2-1*/
vec1=(double *) R_alloc(p2-1, sizeof *vec1); /* vec1 is an array with order p2-1*/
vec2=(double *) R_alloc(p2-1, sizeof *vec2); /* vec2 is an array with order p2-1*/
vh=(double **)R_alloc(p2, sizeof *vh);/*vh is an array with order (p2, n); the first p1 columns are hiddens and the last nx columns are visibles.*/
for (i=0; i1){vh[j][i]=1;}
}
}
PutRNGstate();
/* convert tx, txx back to single array*/
array2to1(p2, n, VH, vh);
}/*Rvh*/
/* Function to compute unnormalized probability scores of a test set from one class under a model from a certain class
A score for an input visible vector is based on an average of M scores from M times simulation of hiddens
TEST: pointer of the vector of test data set; it is from one single class
TX: pointer of the vector of trained theta.x, usually a posterior mean based on training under a certain class
TXX: pointer of the vector of trained theta.xx, usually a posterior mean based on training under a certain class
P1: pointer of p1, the number of hiddens in the model
Nx: pointer of nx, the number of visible pixels in the model; 256 in this case
N: pointer of n, the number of records in the test set
SCORE: pointer of score, the vector of unnormalized probability score, of length N, the number of records in the test set
M: pointer of m1, whichi is the number of replications per visible vector to be simulated
*/
void Rscore(double *TEST, double *TX, double *TXX, int *P1, int *Nx, int *N, double *SCORE, int *M)
{
double **data, **test;
double *txc, *txxc, *vec1, *vec2, a, p, *score;
int p1=*P1, nx=*Nx, n=*N, i, j, k, p2, pt, *idx, s, m, m1=*M, m2;
p2=p1+nx; /* there are p2 nodes in total */
pt=p2*(p2-1)/2; /* there are pt theta.xx in total*/
/* allocate matrix/list using R's memory management tools*/
txc=(double *) R_alloc(p2, sizeof *txc); /* txc is an array with order p2 */
txxc=(double *) R_alloc(pt, sizeof *txxc); /* txxc is an array with order pt*/
idx=(int *) R_alloc(p2-1, sizeof *idx); /* idx is an array with order p2-1*/
vec1=(double *) R_alloc(p2-1, sizeof *vec1); /* vec1 is an array with order p2-1*/
vec2=(double *) R_alloc(p2-1, sizeof *vec2); /* vec2 is an array with order p2-1*/
score=(double *) R_alloc(n, sizeof *score); /* score is an array with order n*/
data=(double **) R_alloc(p2, sizeof *data);/*data is an array with order (p2,n); the first p1 columns are hiddens to be simulated; the last nx columns are from test data*/
for (i=0; i