MAT *bifactor(MAT *A, MAT *U, MAT *V)
#endif
{
int k;
STATIC VEC *tmp1=VNULL, *tmp2=VNULL, *w=VNULL;
Real beta;
if ( ! A )
error(E_NULL,"bifactor");
if ( ( U && ( U->m != U->n ) ) || ( V && ( V->m != V->n ) ) )
error(E_SQUARE,"bifactor");
if ( ( U && U->m != A->m ) || ( V && V->m != A->n ) )
error(E_SIZES,"bifactor");
tmp1 = v_resize(tmp1,A->m);
tmp2 = v_resize(tmp2,A->n);
w = v_resize(w, max(A->m,A->n));
MEM_STAT_REG(tmp1,TYPE_VEC);
MEM_STAT_REG(tmp2,TYPE_VEC);
MEM_STAT_REG(w, TYPE_VEC);
if ( A->m >= A->n )
for ( k = 0; k < A->n; k++ )
{
get_col(A,k,tmp1);
hhvec(tmp1,k,&beta,tmp1,&(A->me[k][k]));
_hhtrcols(A,k,k+1,tmp1,beta,w);
if ( U )
_hhtrcols(U,k,0,tmp1,beta,w);
if ( k+1 >= A->n )
continue;
get_row(A,k,tmp2);
hhvec(tmp2,k+1,&beta,tmp2,&(A->me[k][k+1]));
hhtrrows(A,k+1,k+1,tmp2,beta);
if ( V )
_hhtrcols(V,k+1,0,tmp2,beta,w);
}
else
for ( k = 0; k < A->m; k++ )
{
get_row(A,k,tmp2);
hhvec(tmp2,k,&beta,tmp2,&(A->me[k][k]));
hhtrrows(A,k+1,k,tmp2,beta);
if ( V )
_hhtrcols(V,k,0,tmp2,beta,w);
if ( k+1 >= A->m )
continue;
get_col(A,k,tmp1);
hhvec(tmp1,k+1,&beta,tmp1,&(A->me[k+1][k]));
_hhtrcols(A,k+1,k+1,tmp1,beta,w);
if ( U )
_hhtrcols(U,k+1,0,tmp1,beta,w);
}
#ifdef THREADSAFE
V_FREE(tmp1); V_FREE(tmp2);
#endif
return A;
}
MAT *Hfactor(MAT *A, VEC *diag, VEC *beta)
#endif
{
STATIC VEC *hh = VNULL, *w = VNULL;
int k, limit;
if ( ! A || ! diag || ! beta )
error(E_NULL,"Hfactor");
if ( diag->dim < A->m - 1 || beta->dim < A->m - 1 )
error(E_SIZES,"Hfactor");
if ( A->m != A->n )
error(E_SQUARE,"Hfactor");
limit = A->m - 1;
hh = v_resize(hh,A->m);
w = v_resize(w,A->n);
MEM_STAT_REG(hh,TYPE_VEC);
MEM_STAT_REG(w, TYPE_VEC);
for ( k = 0; k < limit; k++ )
{
/* compute the Householder vector hh */
get_col(A,(unsigned int)k,hh);
/* printf("the %d'th column = "); v_output(hh); */
hhvec(hh,k+1,&beta->ve[k],hh,&A->me[k+1][k]);
/* diag->ve[k] = hh->ve[k+1]; */
v_set_val(diag,k,v_entry(hh,k+1));
/* printf("H/h vector = "); v_output(hh); */
/* printf("from the %d'th entry\n",k+1); */
/* printf("beta = %g\n",beta->ve[k]); */
/* apply Householder operation symmetrically to A */
_hhtrcols(A,k+1,k+1,hh,v_entry(beta,k),w);
hhtrrows(A,0 ,k+1,hh,v_entry(beta,k));
/* printf("A = "); m_output(A); */
}
#ifdef THREADSAFE
V_FREE(hh); V_FREE(w);
#endif
return (A);
}
MAT *QRfactor(MAT *A, VEC *diag)
#endif
{
unsigned int k,limit;
Real beta;
STATIC VEC *hh=VNULL, *w=VNULL;
if ( ! A || ! diag )
error(E_NULL,"QRfactor");
limit = min(A->m,A->n);
if ( diag->dim < limit )
error(E_SIZES,"QRfactor");
hh = v_resize(hh,A->m);
w = v_resize(w, A->n);
MEM_STAT_REG(hh,TYPE_VEC);
MEM_STAT_REG(w, TYPE_VEC);
for ( k=0; k<limit; k++ )
{
/* get H/holder vector for the k-th column */
get_col(A,k,hh);
/* hhvec(hh,k,&beta->ve[k],hh,&A->me[k][k]); */
hhvec(hh,k,&beta,hh,&A->me[k][k]);
diag->ve[k] = hh->ve[k];
/* apply H/holder vector to remaining columns */
/* hhtrcols(A,k,k+1,hh,beta->ve[k]); */
_hhtrcols(A,k,k+1,hh,beta,w);
}
#ifdef THREADSAFE
V_FREE(hh); V_FREE(w);
#endif
return (A);
}
MAT *Hfactor(MAT *A, VEC *diag, VEC *beta)
#endif
{
char MatrixTempBuffer[ 2000 ];
/*STATIC */VEC *hh = VNULL, *w = VNULL;
int k, limit;
if ( ! A || ! diag || ! beta )
error(E_NULL,"Hfactor");
if ( diag->dim < A->m - 1 || beta->dim < A->m - 1 )
error(E_SIZES,"Hfactor");
if ( A->m != A->n )
error(E_SQUARE,"Hfactor");
limit = A->m - 1;
if( SET_VEC_SIZE( A->m ) < 1000 ) {
vec_get( &hh, (void *)MatrixTempBuffer, A->m );
} else {
hh = v_get( A->m );
}
if( SET_VEC_SIZE( A->n ) < 1000 ) {
vec_get( &w, (void *)(MatrixTempBuffer + 1000), A->n );
} else {
w = v_get( A->n );
}
/*hh = v_resize(hh,A->m);
w = v_resize(w,A->n);
MEM_STAT_REG(hh,TYPE_VEC);
MEM_STAT_REG(w, TYPE_VEC);*/
for ( k = 0; k < limit; k++ )
{
/* compute the Householder vector hh */
get_col(A,(unsigned int)k,hh);
/* printf("the %d'th column = "); v_output(hh); */
hhvec(hh,k+1,&beta->ve[k],hh,&A->me[k+1][k]);
/* diag->ve[k] = hh->ve[k+1]; */
v_set_val(diag,k,v_entry(hh,k+1));
/* printf("H/h vector = "); v_output(hh); */
/* printf("from the %d'th entry\n",k+1); */
/* printf("beta = %g\n",beta->ve[k]); */
/* apply Householder operation symmetrically to A */
_hhtrcols(A,k+1,k+1,hh,v_entry(beta,k),w);
hhtrrows(A,0 ,k+1,hh,v_entry(beta,k));
/* printf("A = "); m_output(A); */
}
/*
#ifdef THREADSAFE
V_FREE(hh); V_FREE(w);
#endif
*/
if( hh != (VEC *)(MatrixTempBuffer ) ) // память выделялась, надо освободить
V_FREE(hh);
if( w != (VEC *)(MatrixTempBuffer + 1000) ) // память выделялась, надо освободить
V_FREE(w);
return (A);
}
MAT *QRCPfactor(MAT *A, VEC *diag, PERM *px)
#endif
{
unsigned int i, i_max, j, k, limit;
STATIC VEC *gamma=VNULL, *tmp1=VNULL, *tmp2=VNULL, *w=VNULL;
Real beta, maxgamma, sum, tmp;
if ( ! A || ! diag || ! px )
error(E_NULL,"QRCPfactor");
limit = min(A->m,A->n);
if ( diag->dim < limit || px->size != A->n )
error(E_SIZES,"QRCPfactor");
tmp1 = v_resize(tmp1,A->m);
tmp2 = v_resize(tmp2,A->m);
gamma = v_resize(gamma,A->n);
w = v_resize(w, A->n);
MEM_STAT_REG(tmp1,TYPE_VEC);
MEM_STAT_REG(tmp2,TYPE_VEC);
MEM_STAT_REG(gamma,TYPE_VEC);
MEM_STAT_REG(w, TYPE_VEC);
/* initialise gamma and px */
for ( j=0; j<A->n; j++ )
{
px->pe[j] = j;
sum = 0.0;
for ( i=0; i<A->m; i++ )
sum += square(A->me[i][j]);
gamma->ve[j] = sum;
}
for ( k=0; k<limit; k++ )
{
/* find "best" column to use */
i_max = k; maxgamma = gamma->ve[k];
for ( i=k+1; i<A->n; i++ )
/* Loop invariant:maxgamma=gamma[i_max]
>=gamma[l];l=k,...,i-1 */
if ( gamma->ve[i] > maxgamma )
{ maxgamma = gamma->ve[i]; i_max = i; }
/* swap columns if necessary */
if ( i_max != k )
{
/* swap gamma values */
tmp = gamma->ve[k];
gamma->ve[k] = gamma->ve[i_max];
gamma->ve[i_max] = tmp;
/* update column permutation */
px_transp(px,k,i_max);
/* swap columns of A */
for ( i=0; i<A->m; i++ )
{
tmp = A->me[i][k];
A->me[i][k] = A->me[i][i_max];
A->me[i][i_max] = tmp;
}
}
/* get H/holder vector for the k-th column */
get_col(A,k,tmp1);
/* hhvec(tmp1,k,&beta->ve[k],tmp1,&A->me[k][k]); */
hhvec(tmp1,k,&beta,tmp1,&A->me[k][k]);
diag->ve[k] = tmp1->ve[k];
/* apply H/holder vector to remaining columns */
/* hhtrcols(A,k,k+1,tmp1,beta->ve[k]); */
_hhtrcols(A,k,k+1,tmp1,beta,w);
/* update gamma values */
for ( j=k+1; j<A->n; j++ )
gamma->ve[j] -= square(A->me[k][j]);
}
#ifdef THREADSAFE
V_FREE(gamma); V_FREE(tmp1); V_FREE(tmp2); V_FREE(w);
#endif
return (A);
}
