int main(){vsip_init((void*)0);
{
int solretval=0;
vsip_scalar_vi i,j;
vsip_mview_f *A = vsip_mcreate_f(M, N,VSIP_COL,0);
vsip_mview_f *X = vsip_mcreate_f(M,NB,VSIP_ROW,0);
/* Nullify the data-space */
for (i=0; i < vsip_mgetcollength_f(A); i++)
for(j=0; j < vsip_mgetrowlength_f(A); j++)
vsip_mput_f(A,i,j,(double)0);
for (i=0; i < vsip_mgetcollength_f(X); i++)
for(j=0; j < vsip_mgetrowlength_f(X); j++)
vsip_mput_f(X,i,j,(double)0);
/* Initialise matrix A */
for (i=0; i<M; i++)
for (j = 0; j < N; j++)
if(i == j)
vsip_mput_f(A,i,j, (double)(M+1));
else
vsip_mput_f(A,i,j, -1.0);
{ /* store data */
/* vsip_mput_f(A,0,0,1); vsip_mput_f(A,0,1,2); vsip_mput_f(A,0,2,1); */
/* vsip_mput_f(A,1,0,3); vsip_mput_f(A,1,1,-1); vsip_mput_f(A,1,2,0); */
/* vsip_mput_f(A,2,0,2); vsip_mput_f(A,2,1,1); vsip_mput_f(A,2,2,-1); */
/* vsip_mput_f(A,3,0,1); vsip_mput_f(A,3,1,2); vsip_mput_f(A,3,2,2); */
/* vsip_mput_f(X,0,0,1); */
/* vsip_mput_f(X,1,0,2); */
/* vsip_mput_f(X,2,0,2); */
/* vsip_mput_f(X,3,0,1); */
}
{int i,j;
printf("matrix\n A = [\n");
for(i=0; i<M; i++)
{
for(j=0; j< N; j++)
printf("%9.2f%s",vsip_mget_f(A,i,j),(j == N-1) ? "":",");
(i==M-1) ? printf(";]\n") : printf(";\n") ;
}
}
{ int j, k;
vsip_vview_f *y = NULL;
vsip_vview_f *x;
vsip_length L = NB;
vsip_length p = M;
for(k=0; k<L; k++)
{
x = vsip_mcolview_f(X,k);
for (j=0; j<p; j++)
{
y = vsip_mrowview_f(A,j);
vsip_vput_f(x,j,(double)(k+1)*(vsip_vsumval_f(y)));
/* vsip_vput_f(x,j,(vsip_vsumval_f(y)));*/
vsip_vdestroy_f(y);
}
vsip_vdestroy_f(x);
}
}
{int i,j;
printf("rhs matrix\n B = [\n");
for(i=0; i<NN; i++)
{
for(j=0; j<NB; j++)
printf("%9.2f%s",vsip_mget_f(X,i,j),(j == NB-1) ? "":",");
(i==NN-1) ? printf(";]\n") : printf(";\n") ;
}
}
{vsip_qr_f* qrAop = vsip_qrd_create_f(M,N, QOPT);
if(qrAop == NULL) exit(1);
{int i,j;
if(QOPT == VSIP_QRD_SAVEQ1)
{
printf("qrd returns %i\n",vsip_qrd_f(qrAop,A));
printf("matrix A after factorisation: skinny Q explicitly\n Q1 = [\n");
for(i= 0; i< M ; i++)
{
for(j=0; j< N; j++)
printf("%8.4f %s",vsip_mget_f(A,i,j),(j == N-1) ? "":",");
(i == M - 1) ? printf("]\n") : printf(";\n");
}
} else if(QOPT == VSIP_QRD_SAVEQ || QOPT == VSIP_QRD_NOSAVEQ)
{
printf("qrd returns %i\n",vsip_qrd_f(qrAop,A));
printf("matrix A after fact.: R and ");
(QOPT == VSIP_QRD_SAVEQ) ? printf("full Q implicitly\n Q/R = [\n") :
printf("Q not saved -- ignore LT portion. \n R = [\n");
for(i= 0; i<M ; i++)
{
for(j=0; j< N; j++)
printf("%9.5f %s",vsip_mget_f(A,i,j),(j == N-1) ? "":",");
(i == M - 1) ? printf("]\n") : printf(";\n");
}
}
}
if( QPROB == VSIP_LLS)
{
if (QOPT == VSIP_QRD_SAVEQ1 || QOPT == VSIP_QRD_SAVEQ)
{
if((solretval=vsip_qrsol_f(qrAop, QPROB, X)))
{
printf("Warning -- Least Squares soln returns %i -- Check\n",
solretval);
printf("Upper triang. mat. R, possibly singular\n");
}
else
printf("Least Squares soln returns %i\n", solretval);
}
else
{
printf("Least Squares systems cannot be solved by the NOSAVEQ option --exiting\n");
exit(1);
}
}
else
{
if((solretval=vsip_qrsol_f(qrAop,QPROB, X)))
{
printf("Warning -- Covariance soln returns %i -- Check\n",solretval);
printf("Upper triang. mat. R, possibly singular\n");
}
else
printf("Covariance soln returns %i\n",solretval);
}
vsip_qrd_destroy_f(qrAop);
}
{int i,j;
printf("Soln Matrix\n");
for(i=0; i<N; i++)
{
for(j=0; j<NB; j++)
printf("%9.5f%s",vsip_mget_f(X,i,j),(j == NB-1) ? "":",");
printf(";\n");
}
}
vsip_malldestroy_f(X);
vsip_malldestroy_f(A);
} vsip_finalize((void*)0); return 1;
}
static qr_type *qr_create(length_type n, length_type m, storage_type s)
{
qr_type *qr = vsip_qrd_create_f(n, m, storage(s));
if (!qr) VSIP_IMPL_THROW(std::bad_alloc());
return qr;
}
int main(int argc, char *argv[]){vsip_init((void*)0);
{ if(argc < 3){
printf("usage\nqrdex M N FileName\n");
} else {
/* matrix size */
vsip_length M = (vsip_length)atoi(argv[1]),
N = (vsip_length)atoi(argv[2]);
/* Create some space to hold the matrix */
vsip_mview_f *A = vsip_mcreate_f(M,N,VSIP_COL,VSIP_MEM_NONE),
*A0 = vsip_mcreate_f(M,N,VSIP_COL,VSIP_MEM_NONE);
/* get data */
FILE *fptr = fopen(argv[3],"r");
VU_mreadf_f(fptr,A);
fclose(fptr);
vsip_mcopy_f_f(A,A0); /* will use A, original data in A0 */
{ /* test prodq for Q1 */
/* create a QRD object */
vsip_qr_f *qrd = vsip_qrd_create_f(M,N,VSIP_QRD_SAVEQ1);
/* create a matrix to hold Q */
vsip_mview_f *I = VU_I_f(M);
vsip_mview_f *Q = vsip_msubview_f(I,0,0,M,N);
vsip_mview_f *Qt = vsip_mtransview_f(Q);
/* create a matrix to hold R */
vsip_mview_f *A1 = vsip_mcreate_f(M,N,VSIP_ROW,VSIP_MEM_NONE);
vsip_mview_f *R1 = vsip_msubview_f(A1,0,0,N,N);
vsip_mview_f *R = vsip_mcreate_f(N,N,VSIP_ROW,VSIP_MEM_NONE);
/* create a matrix to hold Q Q^t */
vsip_mview_f *I1 = vsip_mcreate_f(M,M,VSIP_ROW,VSIP_MEM_NONE);
vsip_mview_f *I_1NN = vsip_msubview_f(I1,0,0,N,N);
vsip_mview_f *I_1MN = vsip_msubview_f(I1,0,0,M,N);
vsip_mview_f *I_1NM = vsip_msubview_f(I1,0,0,N,M);
/* create a matrix to hold Q^t Q */
vsip_mview_f *I2 = vsip_mcreate_f(M,M,VSIP_ROW,VSIP_MEM_NONE);
vsip_mview_f *I_2NN = vsip_msubview_f(I2,0,0,N,N);
vsip_mview_f *I_2MN = vsip_msubview_f(I2,0,0,M,N);
vsip_mview_f *I_2NM = vsip_msubview_f(I2,0,0,N,M);
/* do decomposition */
vsip_qrd_f(qrd,A);
/* find Q */
vsip_qrdprodq_f(qrd,VSIP_MAT_NTRANS,VSIP_MAT_RSIDE,I);
printf("A = \n"); VU_mprintm_f("6.4",A0);
printf("Q = \n"); VU_mprintm_f("6.4",Q);
/* find R */
vsip_mcopy_f_f(A0,A1);
vsip_mprod_f(Qt,A1,R);
printf("From mprod R = \n"); VU_mprintm_f("6.4",R);
vsip_qrdprodq_f(qrd,VSIP_MAT_TRANS,VSIP_MAT_LSIDE,A1);
printf("From qrdprod R = \n"); VU_mprintm_f("6.4",R1);
/* find A from Q and R */
vsip_mprod_f(Q,R,A1);
printf("Q R = \n");VU_mprintm_f("6.4",A1);
/* find Q^t Q using mprod */
VU_mfillz_f(I1); VU_mfillz_f(I2);
vsip_mcopy_f_f(Qt,I_1NM);
vsip_mprod_f(I_1NM,Q,I_2NN);
printf("directly using mprod Q^t Q = \n"); VU_mprintm_f("6.4",I_2NN);
/* find Q^t Q using matprod on Rside */
VU_mfillz_f(I1);
vsip_mcopy_f_f(Qt,I_1NM);
vsip_qrdprodq_f(qrd,VSIP_MAT_NTRANS,VSIP_MAT_RSIDE,I_1NM);
printf("using qrdprodq Q^t Q Rside = \n"); VU_mprintm_f("6.4",I_1NN);
/* find Q^t Q using matprod on Lside */
VU_mfillz_f(I2);
vsip_mcopy_f_f(Q,I_2MN);
vsip_qrdprodq_f(qrd,VSIP_MAT_TRANS,VSIP_MAT_LSIDE,I2);
printf("using qrdprodq Q^t Q Lside = \n"); VU_mprintm_f("6.4",I_2NN);
/* find Q Q^t using Mprod */
VU_mfillz_f(I1); VU_mfillz_f(I2);
vsip_mcopy_f_f(Qt,I_1NM);
vsip_mprod_f(Q,I_1NM,I2);
printf("directly using mprod Q Q^t = \n"); VU_mprintm_f("6.4",I2);
/* find Q Q^t using matprod on Rside */
VU_mfillz_f(I1);
vsip_mcopy_f_f(Q,I_1MN);
vsip_qrdprodq_f(qrd,VSIP_MAT_TRANS,VSIP_MAT_RSIDE,I1);
printf("using qrdprodq Q Q^t Rside = \n"); VU_mprintm_f("6.4",I1);
/* find Q Q^t using matprod on Lside */
VU_mfillz_f(I2);
vsip_mcopy_f_f(Qt,I_2NM);
vsip_qrdprodq_f(qrd,VSIP_MAT_NTRANS,VSIP_MAT_LSIDE,I2);
printf("using qrdprodq Q Q^t Lside = \n"); VU_mprintm_f("6.4",I2);
}
}
}vsip_finalize((void*)0);return 0;
}
int main() {
vsip_init((void*)0);
{
int i,j;
vsip_mview_f *A = vsip_mcreate_f(M,N,VSIP_COL,0);
vsip_mview_f *X = vsip_mcreate_f(
(NN>= M)?NN:M,
(NB>=M)?NB:M,
VSIP_ROW,0);
/* put the appropriate row, col lengths of X */
X = vsip_mputcollength_f(X,NN);
X = vsip_mputrowlength_f(X,NB);
/* Initialise matrix A */
for (i=0; i<M; i++)
for (j = 0; j < N; j++)
if(i == j)
vsip_mput_f(A,i,j, (double)(M+1));
else
vsip_mput_f(A,i,j, -1.0);
{ int i,j;
printf("matrix\n A = [\n");
for(i=0; i<M; i++)
{
for(j=0; j< N; j++)
printf("%9.2f%s",vsip_mget_f(A,i,j),(j == N-1) ? "":",");
(i == M-1)? printf("]\n") : printf(";\n");
}
}
{ int j, k;
vsip_vview_f *y = NULL;
vsip_vview_f *x;
vsip_length L = NB;
for(k=0; k<L; k++)
{
x = vsip_mcolview_f(X,k);
for (j=0; j<vsip_vgetlength_f(x); j++)
{
y = vsip_mrowview_f(A,j);
vsip_vput_f(x,j,(double)(k+1)*(vsip_vsumval_f(y)));
vsip_vdestroy_f(y);
}
vsip_vdestroy_f(x);
}
}
{ int i,j;
printf("rhs matrix\n C = [\n");
for(i=0; i<NN; i++)
{
for(j=0; j<NB; j++)
printf("%9.2f%s",vsip_mget_f(X,i,j),(j == NB-1) ? "":",");
(i == NN - 1) ? printf("]\n") : printf(";\n");
}
}
{ vsip_qr_f* qrAop = vsip_qrd_create_f(M,N, QOPT);
if(qrAop == NULL) exit(1);
{ int i,j;
if(QOPT == VSIP_QRD_SAVEQ1)
{
printf("qrd returns %i\n",vsip_qrd_f(qrAop,A));
printf("matrix A after factorisation: skinny Q explicitly\n Q1 = [\n");
for(i= 0; i< M ; i++)
{
for(j=0; j< N; j++)
printf("%9.5f%s",vsip_mget_f(A,i,j),(j == N-1) ? "":",");
(i == M - 1) ? printf("]\n") : printf(";\n");
}
} else if(QOPT == VSIP_QRD_SAVEQ)
{
printf("qrd returns %i\n",vsip_qrd_f(qrAop,A));
printf("matrix A after factorisation: R + full Q implicitly\n Q/R = [\n");
for(i= 0; i<M ; i++)
{
for(j=0; j< N; j++)
printf("%9.2f%s",vsip_mget_f(A,i,j),(j == N-1) ? "":",");
(i == M-1)? printf("]\n") : printf(";\n");
}
} else if(QOPT == VSIP_QRD_NOSAVEQ)
{
printf("Q is not saved with this option. \n");
printf("Product with Q is invalid, exiting\n");
vsip_qrd_destroy_f(qrAop);
vsip_malldestroy_f(X);
vsip_malldestroy_f(A);
exit(1);
}
if (opQ == VSIP_MAT_TRANS || opQ == VSIP_MAT_HERM)
{
if(apQ == VSIP_MAT_RSIDE) /* C * Q^t */
{
printf(" This is a product of type C <- C * Q^t \n");
if(vsip_qrdprodq_f(qrAop,opQ,apQ,X))
{
printf("Size not conformal or invalid operation by Q: -- exiting\n");
vsip_qrd_destroy_f(qrAop);
vsip_malldestroy_f(X);
vsip_malldestroy_f(A);
exit(1);
}
else
{
X = vsip_mputrowlength_f(X,M);
}
}
else if(apQ == VSIP_MAT_LSIDE) /* Q^t * C */
{
if(QOPT == 1)
printf(" This is a product of type C <- Q^t * C \n");
if(QOPT == 2)
printf(" This is a product of type C <- Q_1^t * C \n");
if(vsip_qrdprodq_f(qrAop,opQ,apQ,X))
{
printf("Size not conformal or invalid operation by Q: -- exiting\n");
vsip_qrd_destroy_f(qrAop);
vsip_malldestroy_f(X);
vsip_malldestroy_f(A);
exit(1);
}
else
{
if(QOPT == 2)
X = vsip_mputcollength_f(X,N);
}
}
}
else if (opQ == VSIP_MAT_NTRANS)
{
if(apQ == VSIP_MAT_RSIDE) /* C * Q */
{
printf(" This is a product of type C <- C * Q \n");
if(vsip_qrdprodq_f(qrAop,opQ,apQ,X))
{
printf("Size not conformal or invalid operation by Q: -- exiting\n");
vsip_qrd_destroy_f(qrAop);
vsip_malldestroy_f(X);
vsip_malldestroy_f(A);
exit(1);
}
else
{
X = vsip_mputrowlength_f(X,N);
}
}
else if(apQ == VSIP_MAT_LSIDE) /* Q * C */
{
if(QOPT == 1)
printf(" This is a product of type C <- Q * C \n");
if(QOPT == 2)
printf(" This is a product of type C <- Q_1 * C \n");
if(vsip_qrdprodq_f(qrAop,opQ,apQ,X))
{
printf("Size not conformal or invalid operation by Q: -- exiting\n");
vsip_qrd_destroy_f(qrAop);
vsip_malldestroy_f(X);
vsip_malldestroy_f(A);
exit(1);
}
else
{
X = vsip_mputcollength_f(X,M);
}
}
}
}
vsip_qrd_destroy_f(qrAop);
}
{ int i,j;
printf("Soln Matrix\n C = [\n");
for(i=0; i< vsip_mgetcollength_f(X); i++)
{
for(j=0; j< vsip_mgetrowlength_f(X); j++)
printf("%8.4f%s",vsip_mget_f(X,i,j),
(j == vsip_mgetrowlength_f(X)-1) ? "":",");
(i == vsip_mgetcollength_f(X)-1) ?
printf("]\n") : printf(";\n");
}
}
vsip_malldestroy_f(X);
vsip_malldestroy_f(A);
}
vsip_finalize((void*)0);
return 1;
}
