https://github.com/cran/BDgraph
Tip revision: 741028bca46c23b743948c4b080d1910957a1727 authored by Abdolreza Mohammadi on 28 February 2015, 01:16:46 UTC
version 2.16
version 2.16
Tip revision: 741028b
BDgraph.cpp
#include <R.h>
#include <Rmath.h>
#include <R_ext/Lapack.h>
#include <R_ext/BLAS.h>
#include <R_ext/Utils.h>
#include <sstream>
# include <string> // std::string, std::to_string
#include <vector> // for using vector
using namespace std;
extern "C" {
// copying square matrix A to matrix copyA, for arrary with one dimention
void copyMatrix( double A[], double copyA[], int *pxp )
{
for( register unsigned short int i = 0, dim = *pxp; i < dim; i++ ) copyA[i] = A[i];
}
// Takes square matrix A (p x p) and retrieves square submatrix B (p_sub x p_sub), dictated by vector sub
void subMatrix( double A[], double subA[], int sub[], int *p_sub, int *p )
{
for( int i = 0, psub = *p_sub, pdim = *p; i < psub; i++ )
for( register unsigned short int j = 0; j < psub; j++ )
subA[j * psub + i] = A[sub[j] * pdim + sub[i]];
}
// Takes square matrix A (p x p) and retrieves vector subA which is 'sub' th row of matrix A, minus 'sub' element
// Likes A[j, -j] in R
void subRowMins( double A[], double subA[], int *sub, int *p )
{
register unsigned short int i;
int dimSub = *sub, pdim = *p;
for( i = 0; i < dimSub; i++ )
subA[i] = A[i * pdim + dimSub];
for( i = dimSub + 1; i < pdim; i++ )
subA[i - 1] = A[i * pdim + dimSub];
}
// Takes square matrix A (p x p) and retrieves submatrix subA(2 x p-2) which is sub rows of matrix A, minus two elements
// Likes A[(i,j), -(i,j)] in R
void subRowsMins( double A[], double subA[], int *row, int *col, int *p )
{
register unsigned short int j;
int l = 0, pdim = *p, sub0 = *row, sub1 = *col;
for( j = 0; j < sub0; j++ )
{
subA[l++] = A[j * pdim + sub0];
subA[l++] = A[j * pdim + sub1];
}
for( j = sub0 + 1; j < sub1; j++ )
{
subA[l++] = A[j * pdim + sub0];
subA[l++] = A[j * pdim + sub1];
}
for( j = sub1 + 1; j < pdim; j++ )
{
subA[l++] = A[j * pdim + sub0];
subA[l++] = A[j * pdim + sub1];
}
}
// Takes symmatric matrix A (p x p) and retrieves A_jj, A12(1x(p-1)), A21((p-1)x1), and A22((p-1)x(p-1))
// Like A11=A[j, j], A12=A[j, -j], and A22=A[-j, -j] in R
void subMatrices1( double A[], double A12[], double A22[], int *sub, int *p )
{
register unsigned short int j;
int i, pdim = *p, p1 = pdim - 1, psub = *sub;
for( i = 0; i < psub; i++ )
{
A12[i] = A[i * pdim + psub];
for( j = 0; j < psub; j++ )
A22[j * p1 + i] = A[j * pdim + i];
for( j = psub + 1; j < pdim; j++ )
{
A22[(j - 1) * p1 + i] = A[j * pdim + i];
A22[i * p1 + j - 1] = A[i * pdim + j];
}
}
for( i = psub + 1; i < pdim; i++ )
{
A12[i - 1] = A[i * pdim + psub];
for( j = psub + 1; j < pdim; j++ )
A22[(j - 1) * p1 + i - 1] = A[j * pdim + i];
}
}
// Takes square matrix A (p x p) and retrieves A11(2x2), A12(2x(p-2)), and A22((p-2)x(p-2))
// Like A11=A[e, e], A12=A[e, -e], and A22=A[-e, -e] in R
void subMatrices( double A[], double A11[], double A12[], double A22[], int *row, int *col, int *p )
{
register unsigned short int j;
int i, pdim = *p, p2 = pdim - 2, sub0 = *row, sub1 = *col;
A11[0] = A[sub0 * pdim + sub0];
A11[1] = A[sub0 * pdim + sub1];
A11[2] = A11[1]; // for symmetric matrices
A11[3] = A[sub1 * pdim + sub1];
for( i = 0; i < sub0; i++ )
{
A12[i * 2] = A[i * pdim + sub0];
A12[i * 2 + 1] = A[i * pdim + sub1];
for( j = 0; j < sub0; j++ )
A22[j * p2 + i] = A[j * pdim + i];
for( j = sub0 + 1; j < sub1; j++ )
{
A22[(j - 1) * p2 + i] = A[j * pdim + i];
A22[i * p2 + j - 1] = A[i * pdim + j];
}
for( j = sub1 + 1; j < pdim; j++ )
{
A22[(j - 2) * p2 + i] = A[j * pdim + i];
A22[i * p2 + j - 2] = A[i * pdim + j];
}
}
for( i = sub0 + 1; i < sub1; i++ )
{
A12[(i - 1) * 2] = A[i * pdim + sub0];
A12[i * 2 - 1] = A[i * pdim + sub1];
for( j = sub0 + 1; j < sub1; j++ )
A22[(j - 1) * p2 + i - 1] = A[j * pdim + i];
for( j = sub1 + 1; j < pdim; j++ )
{
A22[(j - 2) * p2 + i - 1] = A[j * pdim + i];
A22[(i - 1) * p2 + j - 2] = A[i * pdim + j];
}
}
for( i = sub1 + 1; i < pdim; i++ )
{
A12[(i - 2) * 2] = A[i * pdim + sub0];
A12[(i - 2) * 2 + 1] = A[i * pdim + sub1];
for( j = sub1 + 1; j < pdim; j++ )
A22[(j - 2) * p2 + i - 2] = A[j * pdim + i];
}
}
////////////////////////////////////////////////////////////////////////////////
// Multiplies (p_i x p_k) matrix by (p_k x p_j) matrix to give (p_i x p_j) matrix
// C := A * B
void multiplyMatrix( double A[], double B[], double C[], int *p_i, int *p_j, int *p_k )
{
double alpha = 1.0, beta = 0.0;
char trans = 'N';
F77_NAME(dgemm)( &trans, &trans, p_i, p_j, p_k, &alpha, A, p_i, B, p_k, &beta, C, p_i );
}
// inverse function for symmetric positive-definite matrices (p x p)
// ******** WARNING: this function change matrix A **************************
void inverse( double A[], double A_inv[], int *p )
{
int info, dim = *p;
char uplo = 'U';
// creating an identity matrix
for( unsigned short int i = 0; i < dim; i++ )
for(register unsigned short int j = 0; j < dim; j++ )
A_inv[j * dim + i] = (i == j);
// LAPACK function: computes solution to A x X = B, where A is symmetric positive definite matrix
F77_NAME(dposv)( &uplo, &dim, &dim, A, &dim, A_inv, &dim, &info );
}
// inverse function for symmetric (2 x 2)
void inverse2x2( double B[], double B_inv[] )
{
double detB = B[0] * B[3] - B[1] * B[1];
B_inv[0] = B[3] / detB;
B_inv[1] = - B[1] / detB;
B_inv[2] = B_inv[1];
B_inv[3] = B[0] / detB;
}
// sampling from Wishart distribution
// Ti = chol( solve( D ) )
void rwish( double Ti[], double K[], int *b, int *p )
{
int dim = *p, pxp = dim * dim, bK = *b;
vector<double> psi( pxp );
// ---- Sample values in Psi matrix ---
GetRNGstate();
for( unsigned short int i = 0; i < dim; i++ )
for( register unsigned short int j = 0; j < dim; j++ )
psi[j * dim + i] = (i < j) ? rnorm(0, 1) : ( (i > j) ? 0.0 : sqrt( rchisq( bK + dim - i - 1 ) ) );
PutRNGstate();
// ------------------------------------
// C = psi %*% Ti
vector<double> C( pxp );
multiplyMatrix( &psi[0], Ti, &C[0], &dim, &dim, &dim );
// K = t(C) %*% C
double alpha = 1.0, beta = 0.0;
char transA = 'T', transB = 'N';
// LAPACK function to compute C := alpha * A * B + beta * C
F77_NAME(dgemm)( &transA, &transB, &dim, &dim, &dim, &alpha, &C[0], &dim, &C[0], &dim, &beta, K, &dim );
}
// A is adjacency matrix which has zero in its diagonal
// threshold = 1e-8
void rgwish( int G[], double Ti[], double K[], int *b, int *p )
{
register int k;
int j, l, a, one = 1, dim = *p, pxp = dim * dim;
double temp;
rwish( Ti, K, b, &dim );
vector<double> Sigma( pxp );
inverse( K, &Sigma[0], &dim );
// copying matrix sigma to matrix W
vector<double> W( Sigma );
vector<double> W_last( pxp );
vector<double> beta_star( dim );
vector<double> ww( dim );
double difference = 1.0;
while ( difference > 1e-8 )
{
// copying matrix W to matrix W_last
copyMatrix( &W[0], &W_last[0], &pxp );
for( j = 0; j < dim; j++ )
{
// Count size of note
a = 0;
for( k = 0; k < dim; k++ ) a += G[k * dim + j];
if( a > 0 )
{
// Record size of node and initialize zero in beta_star for next steps
vector<double> Sigma_N_j( a );
vector<int> N_j( a );
l = 0;
for( k = 0; k < dim; k++ )
{
if( G[k * dim + j] )
{
Sigma_N_j[l] = Sigma[j * dim + k]; // Sigma_N_j[k] = Sigma[j * dim + N_j[k]];
N_j[l++] = k;
}
beta_star[k] = 0.0; // for( k = 0; k < *p; k++ ) beta_star[k] = 0.0;
}
// -------------------------------------------------------------
vector<double> W_N_j( a * a );
subMatrix( &W[0], &W_N_j[0], &N_j[0], &a, &dim );
vector<double> W_N_j_inv( a * a );
inverse( &W_N_j[0], &W_N_j_inv[0], &a );
vector<double> beta_star_hat_j( a );
multiplyMatrix( &W_N_j_inv[0], &Sigma_N_j[0], &beta_star_hat_j[0], &a, &one, &a );
for( k = 0; k < a; k++ ) beta_star[N_j[k]] = beta_star_hat_j[k];
multiplyMatrix( &W[0], &beta_star[0], &ww[0], &dim, &one, &dim );
for( k = 0; k < j; k++ )
{
W[k * dim + j] = ww[k];
W[j * dim + k] = ww[k];
}
for( k = j + 1; k < dim; k++ )
{
W[k * dim + j] = ww[k];
W[j * dim + k] = ww[k];
}
}
else
{
for( k = 0; k < j; k++ )
{
W[k * dim + j] = 0.0;
W[j * dim + k] = 0.0;
}
for( k = j + 1; k < dim; k++ )
{
W[k * dim + j] = 0.0;
W[j * dim + k] = 0.0;
}
}
}
difference = fabs( W[0] - W_last[0] );
for( k = 1; k < pxp; k++ )
{
temp = fabs( W[k] - W_last[k] );
if( temp > difference ) difference = temp;
}
}
inverse( &W[0], K, &dim );
}
// A is adjacency matrix which has zero in its diagonal
// threshold = 1e-8
void rgwish_sigma( int G[], double Ti[], double K[], double W[], int *b, int *p )
{
register int k;
int i, j, l, a, one = 1, dim = *p, pxp = dim * dim, bK = *b;
double temp;
// STEP 1: sampling from wishart distributions
vector<double> psi( pxp );
// ---- Sample values in Psi matrix ---
GetRNGstate();
for( i = 0; i < dim; i++ )
for( j = 0; j < dim; j++ )
psi[j * dim + i] = (i < j) ? rnorm(0, 1) : ( (i > j) ? 0.0 : sqrt( rchisq( bK + dim - i - 1 ) ) );
PutRNGstate();
// ------------------------------------
// C <- psi %*% Ti
vector<double> C( pxp );
multiplyMatrix( &psi[0], Ti, &C[0], &dim, &dim, &dim );
vector<double> invC( pxp );
char side = 'L', up = 'U', transA = 'N', diag = 'N';
double alpha = 1.0;
// creating an identity matrix
for( i = 0; i < dim; i++ )
for( j = 0; j < dim; j++ )
invC[j * dim + i] = (i == j);
// op( A )*X = alpha*B, or X*op( A ) = alpha*B,
F77_NAME(dtrsm)( &side, &up, &transA, &diag, &dim, &dim, &alpha, &C[0], &dim, &invC[0], &dim );
vector<double> Sigma( pxp );
// Sigma <- invC %*% t(invC)
double beta = 0.0;
char transB = 'T';
// LAPACK function to compute C := alpha * A * B + beta * C
F77_NAME(dgemm)( &transA, &transB, &dim, &dim, &dim, &alpha, &invC[0], &dim, &invC[0], &dim, &beta, &Sigma[0], &dim );
// copying matrix sigma to matrix W
//~ copyMatrix( &Sigma[0], W, &pxp );
for( i = 0; i < pxp; i++ ) W[i] = Sigma[i];
vector<double> W_last( pxp );
vector<double> beta_star( dim );
vector<double> ww( dim );
double difference = 1.0;
while ( difference > 1e-8 )
{
// copying matrix W to matrix W_last
//~ copyMatrix( W, &W_last[0], &pxp );
for( i = 0; i < pxp; i++ ) W_last[i] = W[i];
for( j = 0; j < dim; j++ )
{
// Count size of note
a = 0;
for( k = 0; k < dim; k++ ) a += G[k * dim + j];
if( a > 0 )
{
// Record size of node and initialize zero in beta_star for next steps
vector<double> Sigma_N_j( a );
vector<int> N_j( a );
l = 0;
for( k = 0; k < dim; k++ )
{
if( G[k * dim + j] )
{
Sigma_N_j[l] = Sigma[j * dim + k]; // Sigma_N_j[k] = Sigma[j * dim + N_j[k]];
N_j[l++] = k;
}
beta_star[k] = 0.0; // for( k = 0; k < *p; k++ ) beta_star[k] = 0.0;
}
// -------------------------------------------------------------
vector<double> W_N_j( a * a );
subMatrix( W, &W_N_j[0], &N_j[0], &a, &dim );
vector<double> W_N_j_inv( a * a );
inverse( &W_N_j[0], &W_N_j_inv[0], &a );
vector<double> beta_star_hat_j( a );
multiplyMatrix( &W_N_j_inv[0], &Sigma_N_j[0], &beta_star_hat_j[0], &a, &one, &a );
for( k = 0; k < a; k++ ) beta_star[N_j[k]] = beta_star_hat_j[k];
multiplyMatrix( W, &beta_star[0], &ww[0], &dim, &one, &dim );
for( k = 0; k < j; k++ )
{
W[k * dim + j] = ww[k];
W[j * dim + k] = ww[k];
}
for( k = j + 1; k < dim; k++ )
{
W[k * dim + j] = ww[k];
W[j * dim + k] = ww[k];
}
}
else
{
for( k = 0; k < j; k++ )
{
W[k * dim + j] = 0.0;
W[j * dim + k] = 0.0;
}
for( k = j + 1; k < dim; k++ )
{
W[k * dim + j] = 0.0;
W[j * dim + k] = 0.0;
}
}
}
difference = fabs( W[0] - W_last[0] );
for( k = 1; k < pxp; k++ )
{
temp = fabs( W[k] - W_last[k] );
if( temp > difference ) difference = temp;
}
}
//~ copyMatrix( W, &Sigma[0], &pxp );
for( i = 0; i < pxp; i++ ) Sigma[i] = W[i];
inverse( &Sigma[0], K, &dim );
}
////////////////////////////////////////////////////////////////////////////////
// bdmcmc algoirthm with exact value of normalizing constant for D = I_p
// ********************* NEW WORK *****************************************
////////////////////////////////////////////////////////////////////////////////
// K0_ij <- diag(c(K[i, i], K_12 %*% invKjj %*% t(K_12)))
void K022ij( double K[], double sigma[], double *K022, int *i, int *j, int *p )
{
int one = 1, dim = *p, p1 = dim - 1, p1xp1 = p1 * p1;
vector<double> K12( p1 );
subRowMins( K, &K12[0], j, &dim ); // K12 = K[j, -j]
K12[ *i ] = 0.0; // K12[1,i] = 0
double sigma11 = sigma[*j * dim + *j]; // sigma[j, j]
vector<double> sigma12( p1 ); // sigma[-j, j]
vector<double> sigma22( p1xp1 ); // sigma[-j, -j]
subMatrices1( sigma, &sigma12[0], &sigma22[0], j, &dim );
// sigma[-j,-j] - ( sigma[-j, j] %*% sigma[j, -j] ) / sigma[j,j]
vector<double> K22_inv( p1xp1 );
for( unsigned short int ii = 0; ii < p1; ii++ )
for( register unsigned short int jj = 0; jj < p1; jj++ )
K22_inv[jj * p1 + ii] = sigma22[jj * p1 + ii] - sigma12[ii] * sigma12[jj] / sigma11;
// K12 %*% K22_inv
vector<double> K12xK22_inv( p1 );
multiplyMatrix( &K12[0], &K22_inv[0], &K12xK22_inv[0], &one, &p1, &p1 );
// K121 = K12 %*% solve(K[-e, -e]) %*% t(K12)
double alpha = 1.0, beta = 0.0;
char transA = 'N', transB = 'T';
F77_NAME(dgemm)( &transA, &transB, &one, &one, &p1, &alpha, &K12xK22_inv[0], &one, &K12[0], &one, &beta, K022, &one );
}
// K[e, -e] %*% solve(K[-e, -e]) %*% t( K[e, -e] )
void K121output( double K[], double sigma[], double K121[], int *i, int *j, int *p )
{
int two = 2, dim = *p, p2 = dim - 2, p2xp2 = p2 * p2, p2x2 = p2 * 2;
vector<double> K12( p2x2 );
subRowsMins( K, &K12[0], i, j, &dim ); // K12 = K[e, -e]
vector<double> sigma11( 4 ); // sigma[e, e]
vector<double> sigma12( p2x2 ); // sigma[e, -e]
vector<double> sigma22( p2xp2 ); // sigma[-e, -e]
subMatrices( sigma, &sigma11[0], &sigma12[0], &sigma22[0], i, j, &dim );
// solve( sigma[e, e] )
vector<double> sigma11_inv( 4 );
inverse2x2( &sigma11[0], &sigma11_inv[0] );
// sigma21 %*% sigma11_inv = t(sigma12) %*% sigma11_inv
vector<double> sigma21xsigma11_inv( p2x2 );
double alpha = 1.0, beta = 0.0;
char transT = 'T', transN = 'N';
F77_NAME(dgemm)( &transT, &transN, &p2, &two, &two, &alpha, &sigma12[0], &two, &sigma11_inv[0], &two, &beta, &sigma21xsigma11_inv[0], &p2 );
// sigma21xsigma11_inv %*% sigma12
vector<double> sigma2112( p2xp2 );
multiplyMatrix( &sigma21xsigma11_inv[0], &sigma12[0], &sigma2112[0], &p2, &p2, &two );
// solve( K[-e, -e] ) = sigma22 - sigma2112
vector<double> K22_inv( p2xp2 );
for( register unsigned short int i = 0; i < p2xp2 ; i++ ) K22_inv[i] = sigma22[i] - sigma2112[i];
// K12 %*% K22_inv
vector<double> K12xK22_inv( p2x2 );
multiplyMatrix( &K12[0], &K22_inv[0], &K12xK22_inv[0], &two, &p2, &p2 );
// K121 <- K12 %*% solve(K[-e, -e]) %*% t(K12)
F77_NAME(dgemm)( &transN, &transT, &two, &two, &p2, &alpha, &K12xK22_inv[0], &two, &K12[0], &two, &beta, K121, &two );
}
// Colculating all the birth and death rates
void ratesMatrixExact( double K[], double sigma[], double invDsee[], int G[], double rates[], int *b, double Ds[], int *p )
{
register unsigned short int col;
double sumDiag, K022, a11, bstar = *b, sigmaj11;
int row, rowCol, i, j, k, ii, ij, jj, nustar, one = 1, two = 2, dim = *p, p1 = dim - 1, p1xp1 = p1 * p1, p2 = dim - 2, p2xp2 = p2 * p2, p2x2 = p2 * 2;
vector<double> K121( 4 );
double alpha = 1.0, beta = 0.0;
char transT = 'T', transN = 'N';
vector<double> Kj12( p1 ); // K[j, -j]
vector<double> sigmaj12( p1 ); // sigma[-j, j]
vector<double> sigmaj22( p1xp1 ); // sigma[-j, -j]
vector<double> Kj22_inv( p1xp1 );
vector<double> Kj12xK22_inv( p1 );
vector<double> K12( p2x2 ); // K[e, -e]
vector<double> sigma11( 4 ); // sigma[e, e]
vector<double> sigma12( p2x2 ); // sigma[e, -e]
vector<double> sigma22( p2xp2 ); // sigma[-e, -e]
vector<double> sigma11_inv( 4 );
vector<double> sigma21xsigma11_inv( p2x2 );
vector<double> sigma2112( p2xp2 );
vector<double> K22_inv( p2xp2 );
vector<double> K12xK22_inv( p2x2 );
for( i = 0; i < dim; i++ )
for( j = i + 1; j < dim; j++ )
{
ii = i * dim + i;
ij = j * dim + i;
jj = j * dim + j;
// For (i,j) = 0 ---------------------------------------------------------------|
// For (i,j) = 0
// K022 <- K_12 %*% solve( K0[-j, -j] ) %*% t(K_12)
//~ K022ij( &K[0], &sigma[0], &K022, &i, &j, &dim );
subRowMins( K, &Kj12[0], &j, &dim ); // K12 = K[j, -j]
Kj12[ i ] = 0.0; // K12[1,i] = 0
sigmaj11 = sigma[jj]; // sigma[j, j]
subMatrices1( sigma, &sigmaj12[0], &sigmaj22[0], &j, &dim );
// sigma[-j,-j] - ( sigma[-j, j] %*% sigma[j, -j] ) / sigma[j,j]
for( row = 0; row < p1; row++ )
for( col = 0; col < p1; col++ )
{
rowCol = col * p1 + row;
Kj22_inv[rowCol] = sigmaj22[rowCol] - sigmaj12[row] * sigmaj12[col] / sigmaj11;
}
// K12 %*% K22_inv
multiplyMatrix( &Kj12[0], &Kj22_inv[0], &Kj12xK22_inv[0], &one, &p1, &p1 );
// K121 = K12 %*% solve(K[-e, -e]) %*% t(K12)
F77_NAME(dgemm)( &transN, &transT, &one, &one, &p1, &alpha, &Kj12xK22_inv[0], &one, &Kj12[0], &one, &beta, &K022, &one );
// Finished (i,j) = 0 ----------------------------------------------------------|
// For (i,j) = 1 ---------------------------------------------------------------|
// K121 <- K[e, -e] %*% solve( K[-e, -e] ) %*% t(K[e, -e])
//~ K121output( K[], sigma, K121[], *i, *j, *p )
//~ K121output( &K[0], sigma, &K121[0], &i, &j, &dim );
subRowsMins( K, &K12[0], &i, &j, &dim ); // K12 = K[e, -e]
subMatrices( sigma, &sigma11[0], &sigma12[0], &sigma22[0], &i, &j, &dim );
// solve( sigma[e, e] )
inverse2x2( &sigma11[0], &sigma11_inv[0] );
// sigma21 %*% sigma11_inv = t(sigma12) %*% sigma11_inv
F77_NAME(dgemm)( &transT, &transN, &p2, &two, &two, &alpha, &sigma12[0], &two, &sigma11_inv[0], &two, &beta, &sigma21xsigma11_inv[0], &p2 );
// sigma21xsigma11_inv %*% sigma12
multiplyMatrix( &sigma21xsigma11_inv[0], &sigma12[0], &sigma2112[0], &p2, &p2, &two );
// solve( K[-e, -e] ) = sigma22 - sigma2112
for( k = 0; k < p2xp2 ; k++ ) K22_inv[k] = sigma22[k] - sigma2112[k];
// K12 %*% K22_inv
multiplyMatrix( &K12[0], &K22_inv[0], &K12xK22_inv[0], &two, &p2, &p2 );
// K121 <- K12 %*% solve(K[-e, -e]) %*% t(K12)
F77_NAME(dgemm)( &transN, &transT, &two, &two, &p2, &alpha, &K12xK22_inv[0], &two, &K12[0], &two, &beta, &K121[0], &two );
// Finished (i,j) = 1-----------------------------------------------------------|
a11 = K[ii] - K121[0];
//~ sumDiagAB( &Dsee[0], &K0_ij[0], &K121[0], &sumDiag );
// sumDiag = sum( Ds[e,e] * ( K0_ij - K121 ) ) in R
sumDiag = Ds[ii] * a11 - Ds[ij] * K121[1] - Ds[ij] * K121[2] + Ds[jj] * ( K022 - K121[3] );
// nustar = b + sum( Gf[,i] * Gf[,j] )
nustar = bstar;
for( k = 0; k < dim; k++ )
nustar += G[i * dim + k] * G[j * dim + k];
rates[ij] = sqrt( 2.0 * Ds[jj] / a11 ) * exp( lgamma( (nustar + 1) / 2 ) - lgamma( nustar / 2 ) + ( invDsee[ij] * a11 - sumDiag ) / 2 );
if( G[ij] == 0 ) rates[ij] = 1.0 / rates[ij];
}
}
////////////////////////////////////////////////////////////////////////////////
void bdmcmcExact( int *iter, int *burnin, int G[], double Ts[], double K[], int *p,
string allGraphs[], double allWeights[], double Ksum[],
string sampleGraphs[], double graphWeights[], int *sizeSampleG,
int lastGraph[], double lastK[],
int *b, int *bstar, double Ds[] )
{
register unsigned short int col;
bool thisOne;
int selectedEdgei, selectedEdgej, selectedEdgeij, burn_in = *burnin, sizeSampleGraph = *sizeSampleG;
int row, rowCol, i, j, k, ii, ij, jj, Dsjj, Dsij, counter, nustar, one = 1, two = 2;
int dim = *p, pxp = dim * dim, p1 = dim - 1, p1xp1 = p1 * p1, p2 = dim - 2, p2xp2 = p2 * p2, p2x2 = p2 * 2;
double rate, maxRates, sumRates, sumDiag, K022, a11, b1 = *b, sigmaj11;
//~ vector<double> rates( pxp, 0.0 );
vector<double> sigma( pxp );
copyMatrix( K, lastK, &pxp );
inverse( lastK, &sigma[0], &dim );
vector<char> charG( dim * ( dim - 1 ) / 2 ); // char stringG[pp];
double alpha = 1.0, beta = 0.0;
char transT = 'T', transN = 'N';
vector<double> K121( 4 );
vector<double> Kj12( p1 ); // K[j, -j]
vector<double> sigmaj12( p1 ); // sigma[-j, j]
vector<double> sigmaj22( p1xp1 ); // sigma[-j, -j]
vector<double> Kj22_inv( p1xp1 );
vector<double> Kj12xK22_inv( p1 );
vector<double> K12( p2x2 ); // K[e, -e]
vector<double> sigma11( 4 ); // sigma[e, e]
vector<double> sigma12( p2x2 ); // sigma[e, -e]
vector<double> sigma22( p2xp2 ); // sigma[-e, -e]
vector<double> sigma11_inv( 4 );
vector<double> sigma21xsigma11_inv( p2x2 );
vector<double> sigma2112( p2xp2 );
vector<double> K22_inv( p2xp2 );
vector<double> K12xK22_inv( p2x2 );
for( unsigned int g = 0, iteration = *iter; g < iteration; g++ )
{
if( ( g + 1 ) % 1000 == 0 ) Rprintf( " Iteration %d \n", g + 1 );
// STEP 1: calculating birth-death rates
// computing birth and death rates
//~ ratesMatrixExact( K, &sigma[0], &invDsee[0], G, &rates[0], b, Ds, &dim );
counter = 0;
sumRates = 0.0;
maxRates = -1.7e307;
for( j = 1; j < dim; j++ )
{
jj = j * dim + j;
Dsjj = Ds[jj];
sigmaj11 = sigma[jj]; // sigma[j, j]
subMatrices1( &sigma[0], &sigmaj12[0], &sigmaj22[0], &j, &dim );
// sigma[-j,-j] - ( sigma[-j, j] %*% sigma[j, -j] ) / sigma[j,j]
for( row = 0; row < p1; row++ )
for( col = 0; col < p1; col++ )
{
rowCol = col * p1 + row;
Kj22_inv[rowCol] = sigmaj22[rowCol] - sigmaj12[row] * sigmaj12[col] / sigmaj11;
}
for( i = 0; i < j; i++ )
{
ij = j * dim + i;
Dsij = Ds[ij];
// For (i,j) = 0 ---------------------------------------------------------------|
// For (i,j) = 0
// K022 <- K_12 %*% solve( K0[-j, -j] ) %*% t(K_12)
//~ K022ij( &K[0], &sigma[0], &K022, &i, &j, &dim );
subRowMins( K, &Kj12[0], &j, &dim ); // K12 = K[j, -j]
Kj12[ i ] = 0.0; // K12[1,i] = 0
// K12 %*% K22_inv
multiplyMatrix( &Kj12[0], &Kj22_inv[0], &Kj12xK22_inv[0], &one, &p1, &p1 );
// K121 = K12 %*% solve(K[-e, -e]) %*% t(K12)
F77_NAME(dgemm)( &transN, &transT, &one, &one, &p1, &alpha, &Kj12xK22_inv[0], &one, &Kj12[0], &one, &beta, &K022, &one );
// Finished (i,j) = 0 ----------------------------------------------------------|
// For (i,j) = 1 ---------------------------------------------------------------|
// K121 <- K[e, -e] %*% solve( K[-e, -e] ) %*% t(K[e, -e])
//~ K121output( K[], sigma, K121[], *i, *j, *p )
//~ K121output( &K[0], sigma, &K121[0], &i, &j, &dim );
subRowsMins( K, &K12[0], &i, &j, &dim ); // K12 = K[e, -e]
subMatrices( &sigma[0], &sigma11[0], &sigma12[0], &sigma22[0], &i, &j, &dim );
// solve( sigma[e, e] )
inverse2x2( &sigma11[0], &sigma11_inv[0] );
// sigma21 %*% sigma11_inv = t(sigma12) %*% sigma11_inv
F77_NAME(dgemm)( &transT, &transN, &p2, &two, &two, &alpha, &sigma12[0], &two, &sigma11_inv[0], &two, &beta, &sigma21xsigma11_inv[0], &p2 );
// sigma21xsigma11_inv %*% sigma12
multiplyMatrix( &sigma21xsigma11_inv[0], &sigma12[0], &sigma2112[0], &p2, &p2, &two );
// solve( K[-e, -e] ) = sigma22 - sigma2112
for( k = 0; k < p2xp2 ; k++ ) K22_inv[k] = sigma22[k] - sigma2112[k];
// K12 %*% K22_inv
multiplyMatrix( &K12[0], &K22_inv[0], &K12xK22_inv[0], &two, &p2, &p2 );
// K121 <- K12 %*% solve(K[-e, -e]) %*% t(K12)
F77_NAME(dgemm)( &transN, &transT, &two, &two, &p2, &alpha, &K12xK22_inv[0], &two, &K12[0], &two, &beta, &K121[0], &two );
// Finished (i,j) = 1-----------------------------------------------------------|
a11 = K[i * dim + i] - K121[0];
//~ sumDiagAB( &Dsee[0], &K0_ij[0], &K121[0], &sumDiag );
//~ sumDiag = Dsii * a11 - Dsij * K121[1] - Dsij * K121[2] + Dsjj * ( K022 - K121[3] );
sumDiag = - Dsij * K121[1] - Dsij * K121[2] + Dsjj * ( K022 - K121[3] );
// nustar = b + sum( Gf[,i] * Gf[,j] )
nustar = b1;
for( k = 0; k < dim; k++ )
nustar += G[i * dim + k] * G[j * dim + k];
//~ rates[ij] = sqrt( 2.0 * Dsjj / a11 ) * exp( lgamma( (nustar + 1) / 2 ) - lgamma( nustar / 2 ) + ( ( Dsii - Dsij * Dsij / Dsjj ) * a11 - sumDiag ) / 2 );
rate = sqrt( 2.0 * Dsjj / a11 ) * exp( lgamma( (nustar + 1) / 2 ) - lgamma( nustar / 2 ) - ( Dsij * Dsij * a11 / Dsjj + sumDiag ) / 2 );
if( G[ij] == 0 ) rate = 1.0 / rate;
sumRates += rate; // sumUpperMatrix( &rates[0], &allWeights[g], p );
if( rate > maxRates ) // selectEdge( &rates[0], selectedEdge, p );
{
maxRates = rate;
selectedEdgei = i;
selectedEdgej = j;
}
charG[counter++] = G[ij] + '0'; // adjToString( G, &allGraphs[g], p );
}
}
allGraphs[g] = std::string( charG.begin(), charG.end() );
allWeights[g] = 1 / sumRates;
////////////////////////////////////////////////////////////////////////////////
if( g > burn_in )
{
for( i = 0; i < pxp ; i++ ) Ksum[i] += K[i];
thisOne = false;
for( i = 0; i < sizeSampleGraph; i++ )
if( sampleGraphs[i] == allGraphs[g] )
{
graphWeights[i] += allWeights[g];
thisOne = true;
break;
}
if( !thisOne || sizeSampleGraph == 0 )
{
sampleGraphs[sizeSampleGraph] = allGraphs[g];
graphWeights[sizeSampleGraph] = allWeights[g];
sizeSampleGraph++;
}
}
selectedEdgeij = selectedEdgej * dim + selectedEdgei;
G[selectedEdgeij] = 1 - G[selectedEdgeij];
G[selectedEdgei * dim + selectedEdgej] = G[selectedEdgeij];
rgwish_sigma( G, Ts, K, &sigma[0], bstar, &dim );
}
*sizeSampleG = sizeSampleGraph;
// For last graph and its precision matrix
for( i = 0; i < pxp; i++ )
{
lastK[i] = K[i];
lastGraph[i] = G[i];
}
}
////////////////////////////////////////////////////////////////////////////////
// Gaussian copula graphical models
////////////////////////////////////////////////////////////////////////////////
// for copula function
void getMean( double Z[], double K[], double *muij, double *sigma, int *i, int *j, int *n, int *p )
{
register unsigned short int k;
unsigned short int dim = *p, number = *n, row = *i, col = *j;
double mu_ij = 0.0;
for( k = 0; k < col; k++ )
mu_ij += Z[k * number + row] * K[col * dim + k];
for( k = col + 1; k < dim; k++ )
mu_ij += Z[k * number + row] * K[col * dim + k];
*muij = - mu_ij * *sigma;
}
// for copula function
void getBounds( double Z[], int R[], double *lb, double *ub, int *i, int *j, int *n )
{
unsigned short int kj, ij, row = *i, col = *j;
double lowb = -1e308, upperb = +1e308;
for( register unsigned short int k = 0, number = *n; k < number; k++ )
{
kj = col * number + k;
ij = col * number + row;
// if( R[k, j] < R[i, j] ) lb = max( Z[ k, j], lb )
// if( R[k, j] > R[i, j] ) ub = min( Z[ k, j], ub )
if( R[kj] < R[ij] )
lowb = max( Z[kj], lowb );
else if( R[kj] > R[ij] )
upperb = min( Z[kj], upperb );
}
*lb = lowb;
*ub = upperb;
}
// copula part
void copula( double Z[], double K[], int R[], int *n, int *p )
{
int number = *n, dim = *p;
double sigma, sdj, muij;
double lb, ub;
double runifValue, pnormlb, pnormub;
for( int j = 0; j < dim; j++ )
{
sigma = 1 / K[j * dim + j];
sdj = sqrt( sigma );
// interval and sampling
for( register int i = 0; i < number; i++ )
{
getMean( Z, K, &muij, &sigma, &i, &j, &number, &dim );
getBounds( Z, R, &lb, &ub, &i, &j, &number );
// runifValue = runif( 1, pnorm( lowerBound, muij, sdj ), pnorm( upperBound, muij, sdj ) )
// Z[i,j] = qnorm( runifValue, muij, sdj )
GetRNGstate();
pnormlb = pnorm( lb, muij, sdj, TRUE, FALSE );
pnormub = pnorm( ub, muij, sdj, TRUE, FALSE );
runifValue = runif( pnormlb, pnormub );
Z[j * number + i] = qnorm( runifValue, muij, sdj, TRUE, FALSE );
PutRNGstate();
}
}
}
///////////////////////////////////////////////////////////////////////////////
// for copula function with missing data
void getBoundsNA( double Z[], int R[], double *lb, double *ub, int *i, int *j, int *n )
{
unsigned short int kj, ij, row = *i, col = *j;
double lowb = -1e308, upperb = +1e308;
for( register unsigned short int k = 0, number = *n; k < number; k++ )
{
kj = col * number + k;
ij = col * number + row;
if( R[kj] != 0 )
{
// if( R[k, j] < R[i, j] ) lb = max( Z[ k, j], lb )
// if( R[k, j] > R[i, j] ) ub = min( Z[ k, j], ub )
if( R[kj] < R[ij] )
lowb = max( Z[kj], lowb );
else if( R[kj] > R[ij] )
upperb = min( Z[kj], upperb );
}
}
*lb = lowb;
*ub = upperb;
}
// copula part
void copulaNA( double Z[], double K[], int R[], int *n, int *p )
{
int ij, number = *n, dim = *p;
double sigma, sdj, muij, lb, ub, runifValue, pnormlb, pnormub;
for( int j = 0; j < dim; j++ )
{
sigma = 1 / K[j * dim + j];
sdj = sqrt( sigma );
// interval and sampling
for( register int i = 0; i < number; i++ )
{
getMean( Z, K, &muij, &sigma, &i, &j, &number, &dim );
ij = j * number + i;
GetRNGstate();
if( R[ij] != 0 )
{
getBoundsNA( Z, R, &lb, &ub, &i, &j, &number );
pnormlb = pnorm( lb, muij, sdj, TRUE, FALSE );
pnormub = pnorm( ub, muij, sdj, TRUE, FALSE );
runifValue = runif( pnormlb, pnormub );
Z[ij] = qnorm( runifValue, muij, sdj, TRUE, FALSE );
}
else
Z[ij] = rnorm( muij, sdj );
PutRNGstate();
}
}
}
// for bdmcmcCopulaDmh function
void getDs( double K[], double Z[], int R[], double D[], double Ds[], int *gcgm, int *n, int *p )
{
int gcgmCheck = *gcgm, dim = *p, pxp = dim * dim;
if( gcgmCheck == 0 )
copula( Z, K, R, n, &dim );
else
copulaNA( Z, K, R, n, &dim );
vector<double> S( pxp );
// S <- t(Z) %*% Z
// Here, I'm using Ds instead of S, for saving memory
double alpha = 1.0, beta = 0.0;
char transA = 'T', transB = 'N';
// LAPACK function to compute C := alpha * A * B + beta * C
// DGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A,LDA,B, LDB,BETA, C, LDC )
F77_NAME(dgemm)( &transA, &transB, &dim, &dim, n, &alpha, Z, n, Z, n, &beta, &S[0], &dim );
// Ds = D + S
for( register unsigned short int i = 0; i < pxp ; i++ ) Ds[i] = D[i] + S[i];
}
// Cholesky decomposition of symmetric positive-definite matrix
// Note: the matrix you pass this function is overwritten with the result.
// A = U' %*% U
void cholesky( double A[], double U[], int *p )
{
char uplo = 'U';
register int j;
int info, dim = *p, i, pxp = dim * dim;
// copying matrix A to matrix L
for( i = 0; i < pxp; i++ ) U[i] = A[i];
F77_NAME(dpotrf)( &uplo, &dim, U, &dim, &info );
// dpotrf function doesn't zero out the lower diagonal
for( i = 0; i < dim; i++ )
for( j = 0; j < i; j++ )
U[j * dim + i] = 0.0;
}
// for bdmcmcCopulaDmh function
void getTs( double Ds[], double Ts[], int *p )
{
int dim = *p, pxp = dim * dim;
vector<double> invDs( pxp );
vector<double> copyDs( pxp );
//~ copyMatrix( Ds, ©Ds[0], &pxp );
for( register unsigned int i = 0; i < pxp; i++ ) copyDs[i] = Ds[i];
inverse( ©Ds[0], &invDs[0], &dim );
cholesky( &invDs[0], Ts, &dim );
}
////////////////////////////////////////////////////////////////////////////////
// Gaussian copula graphical models
//********* with NEW idea of exact normalizing constant ***********************
////////////////////////////////////////////////////////////////////////////////
void bdmcmcCopula( int *iter, int *burnin, int G[], double Ts[], double K[], int *p,
double Z[], int R[], int *n, int *gcgm,
string allGraphs[], double allWeights[], double Ksum[],
string sampleGraphs[], double graphWeights[], int *sizeSampleG,
int lastGraph[], double lastK[],
int *b, int *bstar, double D[], double Ds[] )
{
int selectedEdgei, selectedEdgej, selectedEdgeij, l, burn_in = *burnin, sizeSampleGraph = *sizeSampleG;
bool thisOne;
register unsigned short int col;
double Dsjj, Dsij, sumDiag, K022, a11, b1 = *b, sigmaj11;
int row, rowCol, i, j, k, ii, ij, jj, nustar, one = 1, two = 2, dim = *p, pxp = dim * dim, p1 = dim - 1, p1xp1 = p1 * p1, p2 = dim - 2, p2xp2 = p2 * p2, p2x2 = p2 * 2;
//~ vector<double> rates( pxp, 0.0 );
vector<double> sigma( pxp );
copyMatrix( K, &lastK[0], &pxp );
inverse( &lastK[0], &sigma[0], &dim );
vector<char> charG( dim * ( dim - 1 ) / 2 ); // char stringG[pp];
double rate, maxRates, sumRates;
vector<double> K121( 4 );
double alpha = 1.0, beta = 0.0;
char transT = 'T', transN = 'N';
vector<double> Kj12( p1 ); // K[j, -j]
vector<double> sigmaj12( p1 ); // sigma[-j, j]
vector<double> sigmaj22( p1xp1 ); // sigma[-j, -j]
vector<double> Kj22_inv( p1xp1 );
vector<double> Kj12xK22_inv( p1 );
vector<double> K12( p2x2 ); // K[e, -e]
vector<double> sigma11( 4 ); // sigma[e, e]
vector<double> sigma12( p2x2 ); // sigma[e, -e]
vector<double> sigma22( p2xp2 ); // sigma[-e, -e]
vector<double> sigma11_inv( 4 );
vector<double> sigma21xsigma11_inv( p2x2 );
vector<double> sigma2112( p2xp2 );
vector<double> K22_inv( p2xp2 );
vector<double> K12xK22_inv( p2x2 );
for( unsigned int g = 0, iteration = *iter; g < iteration; g++ )
{
if( ( g + 1 ) % 1000 == 0 ) Rprintf( " Iteration %d \n", g + 1 );
getDs( K, Z, R, D, Ds, gcgm, n, &dim );
getTs( Ds, Ts, &dim );
l = 0;
sumRates = 0.0;
maxRates = -1.7e307;
// computing birth and death rates
//~ ratesMatrixExactCopula( K, &sigma[0], G, &rates[0], b, Ds, &dim );
for( j = 1; j < dim; j++ )
{
jj = j * dim + j;
Dsjj = Ds[jj];
sigmaj11 = sigma[jj]; // sigma[j, j]
subMatrices1( &sigma[0], &sigmaj12[0], &sigmaj22[0], &j, &dim );
// sigma[-j,-j] - ( sigma[-j, j] %*% sigma[j, -j] ) / sigma[j,j]
for( row = 0; row < p1; row++ )
for( col = 0; col < p1; col++ )
{
rowCol = col * p1 + row;
Kj22_inv[rowCol] = sigmaj22[rowCol] - sigmaj12[row] * sigmaj12[col] / sigmaj11;
}
for( i = 0; i < j; i++ )
{
ij = j * dim + i;
Dsij = Ds[ij];
// For (i,j) = 0 ---------------------------------------------------------------|
// For (i,j) = 0
// K022 <- K_12 %*% solve( K0[-j, -j] ) %*% t(K_12)
//~ K022ij( &K[0], &sigma[0], &K022, &i, &j, &dim );
subRowMins( K, &Kj12[0], &j, &dim ); // K12 = K[j, -j]
Kj12[ i ] = 0.0; // K12[1,i] = 0
// K12 %*% K22_inv
multiplyMatrix( &Kj12[0], &Kj22_inv[0], &Kj12xK22_inv[0], &one, &p1, &p1 );
// K121 = K12 %*% solve(K[-e, -e]) %*% t(K12)
F77_NAME(dgemm)( &transN, &transT, &one, &one, &p1, &alpha, &Kj12xK22_inv[0], &one, &Kj12[0], &one, &beta, &K022, &one );
// Finished (i,j) = 0 ----------------------------------------------------------|
// For (i,j) = 1 ---------------------------------------------------------------|
// K121 <- K[e, -e] %*% solve( K[-e, -e] ) %*% t(K[e, -e])
//~ K121output( K[], sigma, K121[], *i, *j, *p )
//~ K121output( &K[0], sigma, &K121[0], &i, &j, &dim );
subRowsMins( K, &K12[0], &i, &j, &dim ); // K12 = K[e, -e]
subMatrices( &sigma[0], &sigma11[0], &sigma12[0], &sigma22[0], &i, &j, &dim );
// solve( sigma[e, e] )
inverse2x2( &sigma11[0], &sigma11_inv[0] );
// sigma21 %*% sigma11_inv = t(sigma12) %*% sigma11_inv
F77_NAME(dgemm)( &transT, &transN, &p2, &two, &two, &alpha, &sigma12[0], &two, &sigma11_inv[0], &two, &beta, &sigma21xsigma11_inv[0], &p2 );
// sigma21xsigma11_inv %*% sigma12
multiplyMatrix( &sigma21xsigma11_inv[0], &sigma12[0], &sigma2112[0], &p2, &p2, &two );
// solve( K[-e, -e] ) = sigma22 - sigma2112
for( k = 0; k < p2xp2 ; k++ ) K22_inv[k] = sigma22[k] - sigma2112[k];
// K12 %*% K22_inv
multiplyMatrix( &K12[0], &K22_inv[0], &K12xK22_inv[0], &two, &p2, &p2 );
// K121 <- K12 %*% solve(K[-e, -e]) %*% t(K12)
F77_NAME(dgemm)( &transN, &transT, &two, &two, &p2, &alpha, &K12xK22_inv[0], &two, &K12[0], &two, &beta, &K121[0], &two );
// Finished (i,j) = 1-----------------------------------------------------------|
a11 = K[i * dim + i] - K121[0];
//~ sumDiagAB( &Dsee[0], &K0_ij[0], &K121[0], &sumDiag );
//~ sumDiag = Dsii * a11 - Dsij * K121[1] - Dsij * K121[2] + Dsjj * ( K022 - K121[3] );
sumDiag = - Dsij * K121[1] - Dsij * K121[2] + Dsjj * ( K022 - K121[3] );
// nustar = b + sum( Gf[,i] * Gf[,j] )
nustar = b1;
for( k = 0; k < dim; k++ )
nustar += G[i * dim + k] * G[j * dim + k];
//~ rates[ij] = sqrt( 2.0 * Dsjj / a11 ) * exp( lgamma( (nustar + 1) / 2 ) - lgamma( nustar / 2 ) + ( ( Dsii - Dsij * Dsij / Dsjj ) * a11 - sumDiag ) / 2 );
rate = sqrt( 2.0 * Dsjj / a11 ) * exp( lgamma( (nustar + 1) / 2 ) - lgamma( nustar / 2 ) - ( Dsij * Dsij * a11 / Dsjj + sumDiag ) / 2 );
if( G[ij] == 0 ) rate = 1.0 / rate;
sumRates += rate; // sumUpperMatrix( &rates[0], &allWeights[g], p );
if( rate > maxRates ) // selectEdge( &rates[0], selectedEdge, p );
{
maxRates = rate;
selectedEdgei = i;
selectedEdgej = j;
}
charG[l++] = G[ij] + '0'; // adjToString( G, &allGraphs[g], p );
}
}
allGraphs[g] = std::string( charG.begin(), charG.end() );
allWeights[g] = 1 / sumRates;
////////////////////////////////////////////////////////////////////////////////
if( g > burn_in )
{
for( i = 0; i < pxp ; i++ ) Ksum[i] += K[i];
thisOne = false;
for( i = 0; i < sizeSampleGraph; i++ )
if( sampleGraphs[i] == allGraphs[g] )
{
graphWeights[i] += allWeights[g];
thisOne = true;
break;
}
if( !thisOne || sizeSampleGraph == 0 )
{
sampleGraphs[sizeSampleGraph] = allGraphs[g];
graphWeights[sizeSampleGraph] = allWeights[g];
sizeSampleGraph++;
}
}
selectedEdgeij = selectedEdgej * dim + selectedEdgei;
G[selectedEdgeij] = 1 - G[selectedEdgeij];
G[selectedEdgei * dim + selectedEdgej] = G[selectedEdgeij];
rgwish_sigma( G, Ts, K, &sigma[0], bstar, &dim );
}
*sizeSampleG = sizeSampleGraph;
// For last graph and its precision matrix
for( i = 0; i < pxp; i++ )
{
lastK[i] = K[i];
lastGraph[i] = G[i];
}
}
////////////////////////////////////////////////////////////////////////////////
// For generating scale-free graphs: matrix G (p x p) is an adjacency matrix
void scaleFree( int *G, int *p )
{
unsigned int i, j, tmp, total, dim = *p, p0 = 2;
double randomValue;
vector<int> size_a( dim );
for( i = 0; i < p0 - 1; i++ )
{
G[i * dim + i + 1] = 1;
G[(i + 1) * dim + i] = 1;
}
for( i = 0; i < p0; i++ ) size_a[i] = 2;
for( i = p0; i < dim; i++ ) size_a[i] = 0;
total = 2 * p0;
GetRNGstate();
for( i = p0; i < dim; i++ )
{
randomValue = (double) total * runif( 0, 1 );
tmp = 0;
j = 0;
while ( tmp < randomValue && j < i )
tmp += size_a[j++];
j--;
G[i * dim + j] = 1;
G[j * dim + i] = 1;
total += 2;
size_a[j]++;
size_a[i]++;
}
PutRNGstate();
}
////////////////////////////////////////////////////////////////////////////////
} // exturn "C"