MAT new_MAT_from_array( const int nrow, const int ncol, const real_t * x){
if(NULL==x){ return NULL;}
MAT mat = new_MAT(nrow,ncol);
if(NULL==mat){return NULL;}
memcpy(mat->x,x,nrow*ncol*sizeof(real_t));
return mat;
}
/**
* Process observed intensities into sequence space.
* Solves the linear system vec(I_i-N) = A vec(S_i).
* The input is the LU decomposition of the transpose of A.
*/
MAT processNew(const struct structLU AtLU, const MAT N, const MAT intensities, MAT p) {
if (NULL==AtLU.mat || NULL==N || NULL==intensities) {
return NULL;
}
const int ncycle = N->ncol;
const int nelt = NBASE*ncycle;
// Create a new matrix for result if doesn't exist
if(NULL==p) {
p = new_MAT(NBASE,ncycle);
if(NULL==p) {
return NULL;
}
}
// Left-hand of equation. Writen over by solution
for ( int i=0 ; i<nelt ; i++) {
p->x[i] = intensities->xint[i] - N->x[i];
}
// Solve using LAPACK routine
const int inc = 1;
int info = 0;
getrs(LAPACK_TRANS,&nelt,&inc,AtLU.mat->x,&nelt,AtLU.piv,p->x,&nelt,&info);
if(info!=0) {
warnx("getrs in %s returned %d\n",__func__,info);
}
return p;
}
MAT * block_diagonal_MAT( const MAT mat, const int n){
validate(NULL!=mat,NULL);
validate(mat->ncol==mat->nrow,NULL); // Ensure symmetry
const int nelts = mat->ncol / n; // Number of blocks on diagonal
validate((mat->ncol % n)==0,NULL); // Is parameter valid?
// Create memory
MAT * mats = calloc(nelts,sizeof(*mats));
if(NULL==mats){ goto cleanup; }
for ( int i=0 ; i<nelts ; i++){
mats[i] = new_MAT(n,n);
if(NULL==mats[i]){ goto cleanup;}
}
// Copy into diagonals
for ( int i=0 ; i<nelts ; i++){
for ( int col=0 ; col<n ; col++){
const int oldcol = i*n+col;
for ( int row=0 ; row<n ; row++){
const int oldrow = i*n+row;
mats[i]->x[col*n+row] = mat->x[oldcol*mat->nrow+oldrow];
}
}
}
return mats;
cleanup:
if(NULL!=mats){
for ( int i=0 ; i<nelts ; i++){
free_MAT(mats[i]);
}
}
xfree(mats);
return NULL;
}
MAT identity_MAT( const int nrow){
MAT mat = new_MAT(nrow,nrow);
validate(NULL!=mat,NULL);
for ( int i=0 ; i<nrow ; i++){
mat->x[i*nrow+i] = 1.0;
}
return mat;
}
MAT copy_MAT( const MAT mat){
if(NULL==mat){ return NULL;}
MAT newmat = new_MAT(mat->nrow,mat->ncol);
if(NULL==newmat){ return NULL;}
memcpy(newmat->x,mat->x,mat->nrow*mat->ncol*sizeof(real_t));
return newmat;
}
/**
* Process intensities.
* ip = Minv %*% (Intensities-N) %*% Pinv
* - Uses identity: Vec(ip) = ( Pinv^t kronecker Minv) Vec(Intensities-N)
* - Storing Intensities-N as an intermediate saved < 3%
* - Calculating ip^t rather than ip (pcol loop is over minor index) made no difference
* - Using Pinv rather than Pinv^t makes little appreciable difference
*/
MAT process_intensities(const MAT intensities,
const MAT Minv_t, const MAT Pinv_t, const MAT N, MAT ip) {
validate(NULL != intensities, NULL);
validate(NULL != Minv_t, NULL);
validate(NULL != Pinv_t, NULL);
validate(NULL != N, NULL);
const uint_fast32_t ncycle = Pinv_t->nrow;
if (NULL==ip) {
ip = new_MAT(NBASE, ncycle);
validate(NULL != ip, NULL);
}
memset(ip->x, 0, ip->nrow * ip->ncol * sizeof(real_t));
// pre-calculate I - N, especially as I now integer
real_t *tmp = calloc(NBASE * ncycle, sizeof(real_t));
if (NULL==tmp) {
goto cleanup;
}
for (uint_fast32_t i = 0; i < (NBASE * ncycle); i++) {
tmp[i] = intensities->xint[i] - N->x[i];
}
for (uint_fast32_t icol = 0; icol < ncycle; icol++) { // Columns of Intensity
for (uint_fast32_t base = 0; base < NBASE; base++) { // Bases (rows of Minv, cols of Minv_t)
real_t dp = 0;
for (uint_fast32_t chan = 0; chan < NBASE; chan++) { // Channels
dp += Minv_t->x[base * NBASE + chan] * tmp[icol * NBASE + chan];
}
for (uint_fast32_t pcol = 0; pcol < ncycle; pcol++) { // Columns of ip
ip->x[pcol * NBASE + base] += Pinv_t->x[icol * ncycle + pcol] * dp;
}
}
}
free(tmp);
return ip;
cleanup:
free_MAT(ip);
return NULL;
}
MAT expected_intensities(const real_t lambda, const NUC * bases,
const MAT M, const MAT P, const MAT N, MAT e) {
validate(lambda>=0,NULL);
validate(NULL!=bases,NULL);
validate(NULL!=M,NULL);
validate(NULL!=P,NULL);
validate(NULL!=N,NULL);
const uint_fast32_t ncycle = P->nrow;
if(NULL==e) {
e = new_MAT(NBASE,ncycle);
validate(NULL!=e,NULL);
}
memset(e->x, 0, NBASE*ncycle*sizeof(real_t));
if(has_ambiguous_base(bases,ncycle)) {
for(uint_fast32_t cy2=0 ; cy2<ncycle ; cy2++) {
for(uint_fast32_t cy=0 ; cy<ncycle ; cy++) {
const uint_fast32_t base = bases[cy];
if(!isambig(base)) {
for ( uint_fast32_t ch=0 ; ch<NBASE ; ch++) {
e->x[cy2*NBASE+ch] += M->x[base*NBASE+ch] * P->x[cy2*ncycle+cy];
}
}
}
}
} else {
for(uint_fast32_t cy2=0 ; cy2<ncycle ; cy2++) {
for(uint_fast32_t cy=0 ; cy<ncycle ; cy++) {
const uint_fast32_t base = bases[cy];
for ( uint_fast32_t ch=0 ; ch<NBASE ; ch++) {
e->x[cy2*NBASE+ch] += M->x[base*NBASE+ch] * P->x[cy2*ncycle+cy];
}
}
}
}
// Multiply by brightness;
scale_MAT(e,lambda);
// Add noise
for ( uint_fast32_t i=0 ; i<(NBASE*ncycle) ; i++) {
e->x[i] += N->x[i];
}
return e;
}
/* Vec transpose operation */
MAT vectranspose ( const MAT mat, const unsigned int p ){
/* Simple checking of arguments */
if ( NULL==mat){
warn("Attempting to apply vec-transpose operation to a NULL matrix");
return NULL;
}
if ( 0==mat->nrow || 0==mat->ncol ){
warn("Vec-transpose of matrix with no columns or no rows is not completely defined\n");
}
if ( 0!=(mat->nrow % p) ){
warn("Invalid application of vec-transpose(%u) to a matrix with %u rows.\n",p,mat->nrow);
return NULL;
}
MAT vtmat = new_MAT(p*mat->ncol,mat->nrow/p);
if ( NULL==vtmat){
return NULL;
}
/* Iterate through columns of matrix doing necessary rearrangement.
* Note: assumed column-major format
* Each column is split into imaginary subcolumns of length p,
* which will form the submatrix corresponding to that column.
* Refer to external documentation for definition of vec-tranpose
* (give document reference here).
*/
/* Routine is valid for matrices with zero columns or rows since it
* it will never attempt to access elements in this case
*/
for ( unsigned int col=0 ; col<mat->ncol ; col++){
/* offset represents where in the "matrix stack" that the column
* should be formed into.*/
unsigned int offset = col*p;
for ( unsigned int subcol=0 ; subcol<(mat->nrow/p) ; subcol++){
for ( unsigned int i=0 ; i<p ; i++){
vtmat->x[ (subcol*vtmat->nrow) + offset + i ]
= mat->x[col*mat->nrow + subcol*p + i];
}
}
}
return vtmat;
}
/**
* Accumulate covariance matrix (ncycle * NBASE x ncycle * NBASE).
* Only lower triangular matrix is accumulated.
* Note: If V is NULL, the required memory is allocated.
* - p: Matrix of processed intensities
* - lambda: Brightness of cluster
* - base: Current base call
* - do_full: Calculate full covariance matrix, or just band suitable for fitting Omega
* - V: Covariance matrix used for accumulation
*/
static MAT accumulate_covariance( const real_t we, const MAT p, const real_t lambda, const NUC * base, const bool do_full, MAT V) {
validate(NULL!=p, NULL);
validate(NBASE==p->nrow, NULL);
validate(lambda>=0.0, NULL);
const uint_fast32_t ncycle = p->ncol;
const int lda = ncycle * NBASE;
// Allocate memory for V if necessary
if (NULL==V) {
V = new_MAT(lda, lda);
if (NULL==V) {
return NULL;
}
}
// Perform accumulation. V += R R^t
// Note: R = P - \lambda I_b, where I_b is unit vector with b'th elt = 1
for (uint_fast32_t cy = 0; cy < ncycle; cy++) {
if (!isambig(base[cy])) {
p->x[cy * NBASE + base[cy]] -= lambda;
}
}
if ( do_full ) {
syr(LAPACK_LOWER, &lda, &we, p->x, LAPACK_UNIT, V->x, &lda);
}
else {
// Only update base*base blocks on the diagonal or immediately above and below it
// Update more elements than necessary but excess are ignored later.
for ( int i=0 ; i<lda ; i++) {
for ( int j=i ; j<i+2*NBASE ; j++ ) {
if(j>=lda) {
break;
}
V->x[i*lda+j] += we * p->x[i] * p->x[j];
}
}
}
return V;
}