Ejemplo n.º 1
0
int main(int argc, char *argv[]) {
  int info;
  int m = 6;
  int n = 4;
  if (argc > 2) {
    m = boost::lexical_cast<int>(argv[1]);
    n = boost::lexical_cast<int>(argv[2]);
  }
  std::cout << "m = " << m << "\nn = " << n << std::endl;
  int k = std::min(m, n);

  // generate random martix
  matrix_t mat = matrix_t::Random(m, n);
  std::cout << "Input random matrix A:\n" << mat << std::endl;

  // singular value decomposition
  matrix_t a = mat; // 'a' will be destroyed by dgesvd
  vector_t s(k), superb(k);
  matrix_t u(m, k), vt(k, n);
  info = LAPACKE_zgesvd(LAPACK_COL_MAJOR, 'S', 'S', m, n, &a(0, 0), m, &s(0),
                         &u(0, 0), m, &vt(0, 0), k, &superb(0));
  std::cout << "U:\n" << u << std::endl;
  std::cout << "S:\n" << s << std::endl;
  std::cout << "Vt:\n" << vt << std::endl;

  // check correctness of SVD
  matrix_t smat = matrix_t::Zero(k, k);
  for (int i = 0; i < k; ++i) smat(i, i) = s(i);
  matrix_t check = u * smat * vt;
  std::cout << "U * S * Vt:\n" << check << std::endl;
  std::cout << "| A - U * S * Vt | = " << (mat - check).norm() << std::endl;
}
Ejemplo n.º 2
0
void
doit_in_col_major (const char * description,
		   const int M, const int N, const int minMN,
		   double complex A[N][M],
		   double         expected_S[1][N],
		   double complex expected_LSV[minMN][M],
		   double complex expected_VH[N][N])
{
  /* Option: return all the M columns of U in the matrix U. */
  const char	jobU	= 'A';
  /* Option: return all the N rows of V^T in the matrix VH. */
  const char	jobVH	= 'A';

  const int	Anrows	= M;
  const int	Ancols	= N;
  const int	ldA	= Anrows;

  /* Operand: a  copy of A  used as actual  parameter to ZGESVD.   It is
     needed because the  parameter is destroyed and we  want to preserve
     the original matrix in A. */
  double complex	A1[Ancols][Anrows];

  /* Result: the singular values of A.  This vector is equal to the main
     diagonal of SIGMA. */
  const int		Snrows = Ancols;
  const int		Sncols = 1;
  double		S[Sncols][Snrows];

  /* Result: orthogonal square matrix U.   The MIN(M,N) columns of U are
     the left singular vectors. */
  const int		Unrows	= Anrows;
  const int		Uncols	= Anrows;
  const int		ldU	= Unrows;
  double complex	U[Uncols][Unrows];

  /* Result:  orthogonal  square  matrix  V  transposed.   The  MIN(M,N)
     columns of V are the right singular vectors. */
  const int		VHnrows	= Ancols;
  const int		VHncols	= Ancols;
  const int		ldVH	= VHnrows;
  double complex	VH[VHncols][VHnrows];

  /* Result: first  superdiagonal of  an internal  work matrix,  see the
     source code of "LAPACKE_dgesvd()". */
  const int		superBnrows = MIN(Anrows,Ancols) - 1;
  const int		superBncols = 1;
  double		superB[superBncols][superBnrows];

  /* Reconstructed data: matrix  having the singular values  on the main
     diagonal. */
  const int		SIGMAnrows = Anrows;
  const int		SIGMAncols = Ancols;
  const int		ldSIGMA    = SIGMAnrows;
  double complex	SIGMA[SIGMAncols][SIGMAnrows];

  /* Reconstructed  data: left  singular  vector.  The  columns of  this
     matrix are the MIN(M,N) columns of U. */
  const int		LSVnrows = Anrows;
  const int		LSVncols = MIN(Anrows,Ancols);
  /* const int		ldLSV    = Unrows; */
  double complex	LSV[LSVncols][LSVnrows];

  /* Reconstructed data: matrix A recomputed using the results. */
  double complex	recomputed_A[Ancols][Anrows];

  lapack_int		info;

  /* Load the input matrix A into the working array A1. */
  memcpy(A1, A, sizeof(double complex) * Anrows * Ancols);

  info = LAPACKE_zgesvd(LAPACK_COL_MAJOR, jobU, jobVH, Anrows, Ancols,
			MREF(A1), ldA, MREF(S), MREF(U), ldU,
			MREF(VH), ldVH, MREF(superB));

  /* If something went wrong in the function call INFO is non-zero: exit
     with failure. */
  if (0 != info) {
    printf("Error computing solution with col-major operands: INFO=%d.\n", info);
    exit(EXIT_FAILURE);
  }

  /* Result validation by performing  the inverse operation.  We compute
     "recomputed_A" starting from U, S and VH. */
  {
    /* Put the singular values on the main diagonal of SIGMA. */
    for (int i=0; i<Anrows; ++i) {
      for (int j=0; j<Ancols; ++j) {
	SIGMA[j][i] = (i == j)? S[0][j] : CMPLX(+0.0,+0.0);
      }
    }

    /* Put the left singular vectors from U in LSV. */
    for (int i=0; i<LSVnrows; ++i) {
      for (int j=0; j<LSVncols; ++j) {
	LSV[j][i] = U[j][i];
      }
    }

    /* Multiply U  and SIGMA, then  right-multiply the result by  V^H to
     * verify that the result is indeed A; we need CBLAS for this.
     */
    /* In general ZGEMM does:
     *
     *   C = \alpha A B + \beta C
     *
     * where  A, B  and C  are matrices.   We need  to inspect  both the
     * header  file  "cblas.h"  and  the manual  page  "zgemm"  for  the
     * documentation of the parameters; the prototype of "cblas_gemm()"
     * is:
     *
     *    void cblas_dgemm(const enum CBLAS_ORDER Order,
     *                     const enum CBLAS_TRANSPOSE TransA,
     *                     const enum CBLAS_TRANSPOSE TransB,
     *                     const int M, const int N, const int K,
     *                     const void *alpha,
     *                     const void *A, const int lda,
     *                     const void *B, const int ldb,
     *                     const void *beta,
     *                     double *C, const int ldc);
     *
     * In  our case  all the  matrices are  in row-major  order and  the
     * representations in the  arrays A and B are not  transposed, so: M
     * is the number of rows of A and C; N is the number of columns of B
     * and C; K is  the number of columns of A and rows  of B.  In other
     * words:
     *
     *    A has dimensions M x K
     *    B has dimensions K x N
     *    C has dimensions M x N
     *
     * obviously the product AB has dimensions M x N.
     */
    /* Here we want to do (explicitating the dimensions):
     *
     *   R1[N][M] = 1.0 U[M][M] SIGMA[N][M] + 0.0 R1[N][M]
     *   R2[N][M] = 1.0 R1[N][M] VH[N][N]   + 0.0 R2[N][M]
     *
     * where R  is a matrix whose  contents at input are  not important,
     * and whose contents at output are the result of the operation.
     */
    {
      double complex	R1[Ancols][Anrows];
      double complex	R2[Ancols][Anrows];
      double complex	alpha = CMPLX(1.0,0.0);
      double complex	beta  = CMPLX(0.0,0.0);
      cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans,
		  Anrows, Ancols, Uncols,
		  &alpha, MREF(U),  ldU, MREF(SIGMA), ldSIGMA, &beta, MREF(R1), ldA);
      cblas_zgemm(CblasColMajor, CblasNoTrans, CblasNoTrans,
      		  Anrows, Ancols, VHnrows,
      		  &alpha, MREF(R1), ldA, MREF(VH),    ldVH,    &beta, MREF(R2), ldA);
      memcpy(recomputed_A, R2, sizeof(double complex) * Anrows * Ancols);
    }
  }

  printf("Results of col-major ZGESVD: %s:\n", description);

  /* Comparison between computed results and expected results. */
  if (1) {
    compare_real_col_major_result_and_expected_result ("S, singular values",
						       Snrows, Sncols, S, expected_S);
    compare_complex_col_major_result_and_expected_result ("recomputed A",
							  Anrows, Ancols, A, recomputed_A);
    compare_complex_col_major_result_and_expected_result ("LSV, matrix of left singular vectors",
							  LSVnrows, LSVncols, LSV, expected_LSV);
    compare_complex_col_major_result_and_expected_result ("V^H, conjugate-transposed matrix of right singular vectors",
							  VHnrows, VHncols, VH, expected_VH);
  }

  /* Result logging */
  {
    print_complex_col_major_matrix ("A, input matrix", Anrows, Ancols, A);
    print_complex_col_major_matrix ("recomputed A (must be equal to the original A)",
				    Anrows, Ancols, recomputed_A);
    if (0) {
      print_complex_col_major_matrix ("A1, output matrix", Anrows, Ancols, A1);
    }
    print_real_col_major_matrix ("S, computed singular values", Snrows, Sncols, S);
    print_complex_col_major_matrix ("SIGMA, matrix having singular values on the main diagonal",
				    SIGMAnrows, SIGMAncols, SIGMA);
    print_complex_col_major_matrix ("U, the MIN(M,N) columns are the left singular vectors",
				    Unrows, Uncols, U);
    print_complex_col_major_matrix ("V conjugate-transposed, the MIN(M,N) rows are the right singular vectors",
				    VHnrows, VHncols, VH);
    print_real_col_major_matrix ("superB", superBnrows, superBncols, superB);
  }
}
Ejemplo n.º 3
0
/* Main program */
int main(){
        /* not Locals */
        lapack_complex_double *a, *temp, * u, *vt;
        lapack_int m = M, n = N, lda = LDA, ldu = LDU, ldvt = LDVT, info;
		
        /* Local arrays */
		//void prtdat();
		double *s;
        double *superb; 
        int svd_count=0;
		int i, j ,ix ,iy, index, ii, jj ;    
		double  x_min,
				x_max,
				y_min,
				y_max,
				stepx,						/* step size for finding gridpoints coordinates in x and y dimension.*/
				stepy;
		double e=0.1;        
		/* Array used for the ploting of
		* grid, as an input to the 
		* draw_pseudospectra function. */
		double *plot;
		//double plot[n][n]; 
		COLOUR colour;
		BITMAP4 col,grey = {128,128,128,0};
		
		       
        /* Memory alocations*/
		temp = malloc((lda*m)*sizeof(lapack_complex_double));
		a = malloc((lda*m)*sizeof(lapack_complex_double));
		u = malloc((ldu*m)*sizeof(lapack_complex_double));
		vt = malloc((ldvt*n)*sizeof(lapack_complex_double));
		s = malloc(m*sizeof(double));
		superb = malloc(min(m,n)*sizeof(double));
		plot = malloc((NGRID*NGRID)*sizeof(double));
		z = malloc((NGRID*NGRID)*sizeof(double _Complex));
		
	
		//allocating the 2D array data.
	  if ((data = malloc(SCALE*NGRID*sizeof(double *))) == NULL) {
      fprintf(stderr,"Failed to malloc space for the data\n");
      exit(-1);
   }
   for (i=0;i<SCALE*NGRID;i++) {
      if ((data[i] = malloc(SCALE*NGRID*sizeof(double))) == NULL) {
         fprintf(stderr,"Failed to malloc space for the data\n");
         exit(-1);
      }
   }
   for (i=0;i<SCALE*NGRID;i++){
      for (j=0;j<SCALE*NGRID;j++){
         data[i][j] = 0;
	 //   printf("%f\t",data[i][j]);
	 }
		  }
		
/*
		printf("-------------------------------------------------\n");
		printf("        ---------------------------------           \n");
		printf ("Starting Computing Pseudopsecta of grcar Matrix\n");
		printf("Give the doundaries of the 2-dimenional domain\n");
		printf("Insert the minimum value of x-axis\n");
		clearerr(stdin);
		scanf("%lf",&x_min);
		//getchar();
		printf("Insert the maximum value of x-axis\n");
		scanf("%lf",&x_max);
		printf("Insert the minimum value of y-axis\n");
		scanf("%lf",&y_min);
		printf("Insert the maximun value of y-axis\n");
		scanf("%lf",&y_max);
		//printf("Give the grid size you want:\n");
		//scanf("%d",&n);
*/ 	  
		/*if (x_min==0.0)*/  x_min=XMIN;
		/*if (x_max==0.0)*/  x_max=XMAX;
		/*if (y_min==0.0)*/  y_min=YMIN;
		/*if (y_max==0.0)*/  y_max=YMAX;
	
		/* Initialize grid */
		printf("The size of the domain is: X=[%f-%f]  Y=[%f-%f] \n",x_min,x_max,y_min,y_max);
	  
		stepx=(double)abs(x_max-x_min)/(NGRID-1);
		stepy=(double)abs(y_max-y_min)/(NGRID-1);
		printf("To stepx einai %f\n",stepx);
		printf("To stepy einai %f\n",stepy);	
	   

	
	   for (i =0; i <NGRID*NGRID; i++){
			z[i]=x_min+(i/n * stepx)+(y_min + (i%n * stepy))*I;
		 // z[i]=lapack_make_complex_double( i/n,i%n); just for testing
		//**	printf( " (%6.2f,%6.2f)", lapack_complex_double_real(z[i]), lapack_complex_double_imag(z[i]) );
		}

	   memset(temp,0,(lda*m)*sizeof(*temp));
	   memset(a,0,(lda*m)*sizeof(*a));
	   memset(u,0,(ldu*m)*sizeof(*u));
	   memset(vt,0,(ldvt*m)*sizeof(*vt));
		
		
	   j=0;
	   for (i = 0; i < lda*m ; i=i+n ){	
			if(i==0){
				a[i]=lapack_make_complex_double( 1,0);
				a[i+1]=lapack_make_complex_double( 1,0);
				a[i+2]=lapack_make_complex_double( 1,0);
				a[i+3]=lapack_make_complex_double( 1,0);
			}
			else if(i == (n-3)*n ){
				a[i+j]=lapack_make_complex_double( -1,0);
				a[i+(j+1)]=lapack_make_complex_double( 1,0);
				a[i+(j+2)]=lapack_make_complex_double( 1,0);
				a[i+(j+3)]=lapack_make_complex_double( 1,0);
				j++;
			}
			else if(i == (n-2)*n ){
				a[i+j]=lapack_make_complex_double( -1,0);
				a[i+(j+1)]=lapack_make_complex_double( 1,0);
				a[i+(j+2)]=lapack_make_complex_double( 1,0);
				j++;
			}
			else if(i == (n-1)*n ){
				a[i+j]=lapack_make_complex_double( -1,0);
				a[i+(j+1)]=lapack_make_complex_double( 1,0);
				j++;
			}
			else{
				a[i+j]=lapack_make_complex_double( -1,0);
				a[i+(j+1)]=lapack_make_complex_double( 1,0);
				a[i+(j+2)]=lapack_make_complex_double( 1,0);
				a[i+(j+3)]=lapack_make_complex_double( 1,0);
				a[i+(j+4)]=lapack_make_complex_double( 1,0);
				j++;
			}
		} 

		//print_matrix("Entry Matrix A", m, n, a, lda );
		for (iy = 0; iy < NGRID*NGRID; iy++){   
			 //printf("temp size %d, a size %d",(lda*m)*sizeof(*temp),(lda*m)*sizeof(*a));
			memcpy(temp, a ,(lda*m)*sizeof(*temp));
			 //~ print_matrix( "Entry Matrix Temp just after memcopy", m, n, temp, lda );
			 //~ print_matrix( "Entry Matrix A just after memcopy", m, n, a, lda );
			// printf( "To  z[%d](%6.4f,%6.4f)\n",iy,lapack_complex_double_real(z[iy]),lapack_complex_double_imag(z[iy]) );
			for (i = 0; i < lda*m ; i=i+(n+1)){	
				//~ printf("%d",i);
				//~ printf( "To  a[%d](%6.2f,%6.2f)\t",i, lapack_complex_double_real(a[i]), lapack_complex_double_imag(a[i]) );
				//~ printf( "To  z[%d](%6.2f,%6.2f)\n",iy,lapack_complex_double_real(z[iy]),lapack_complex_double_imag(z[iy]) );
				
				temp[i]=a[i]-z[iy];
				//~ temp[index] = lapack_make_complex_double(lapack_complex_double_real(a[index])-lapack_complex_double_real(z[iy]),  lapack_complex_double_imag(a[index])-lapack_complex_double_imag(z[iy])    );
				//~ printf( " temp[%d](%6.2f,%6.2f)", i,lapack_complex_double_real(temp[i]), lapack_complex_double_imag(temp[i]) );
				//~ printf( "\n");
			}
			//printf("GRCAR MATRIX AFTER SUBSTRACTION (%d,%d)\n",iy/n,iy%n);
			//~ print_matrix( "Entry Matrix Temp just before", m, n, temp, lda );
	
			/* Executable statements */
			//~ print_matrix( "AT THE BEGINING OF THE FOR LOOP", m, n, a, lda );
			printf( "LAPACKE_zgesvd (row-major, high-level) Example Program Results(%d,%d)\n",iy/NGRID,iy%NGRID);
			/* Compute SVD */
			info = LAPACKE_zgesvd( LAPACK_ROW_MAJOR, 'N', 'N', m, n, temp, lda, s, NULL, ldu, NULL, ldvt, superb );
			svd_count++;
			//~ 
			//~ print_matrix( "IN THE MIDDLE OF THE FOR LOOP", m, n, a, lda );
			//~ print_matrix( "IN THE MIDDLE OF THE FOR LOOP-TEMP", m, n, temp, lda );
			/* Check for convergence */
			if( info > 0 ) {
				printf( "The algorithm computing SVD failed to converge.\n" );
				exit( 1 );
			}
			/* Print singular values */
			if( info == 0){
//				printf("Solution\n");	
				for ( i= 0; i< m; i++ ) {
//					printf(" s[ %d ] = %f\n", i, s[ i ] );
				}
			}
			
			if(s[m-1] <= e){
				printf("THIS ELEMENT BELONGS TO PSEUDOSPECTRA (%d,%d):%6.10f\n",(iy/NGRID+1),(iy%NGRID+1),s[m-1]);
				/*to index tis parapanw ektupwshs anaferetai sto index tou antistoixou mhtrwou apo thn synarthsh ths matlab grcar_example.m*/
				//~ plot[iy/n][iy%n]=s[m-1];
				plot[iy]=s[m-1];
			 }
			 //~ else   plot[iy/n][iy%n]=0;
				else plot[iy]=0;
		
	
		
	//~ print_rmatrix( "Singular values", 1, m, s, 1 );
	
	/* Print left singular vectors */
	// print_matrix( "Left singular vectors (stored columnwise)", m, m, u, ldu );
	/* Print right singular vectors */
	// print_matrix( "Right singular vectors (stored rowwise)", m, n, vt, ldvt );
		}
		
		
		prtdat(NGRID, NGRID, plot, "svd.data");
		printf("Total number of svd evaluations in the %d,%d grid is:\t %d\n",NGRID,NGRID,svd_count);
		
		//giving values to data from plot
		for (i = 0; i<NGRID*NGRID; i++)  data[SCALE*(i/NGRID)][SCALE*(i%NGRID)] = plot[i];
	   /////////////////
    BITMAP4 black = {0,0,0,0};
    Draw_Line(image,NGRID,NGRID,x_min,y_min,x_max,y_min,black);
   //////////////////	
		//~ contours[0] = 0.1;
		//~ contours[1] = 0.01;
		//~ contours[2] = 0.001;
		//~ contours[3] = 0.0001;
		//~ contours[4] = 0.00001;
		if ((image = Create_Bitmap(SCALE*NGRID,SCALE*NGRID)) == NULL) {
      fprintf(stderr,"Malloc of bitmap failed\n");
      exit(-1);
   }
 Erase_Bitmap(image,SCALE*NGRID,SCALE*NGRID,grey); /* Not strictly necessary */
   for (j=0;j<SCALE*NGRID;j++) {
      for (i=0;i<SCALE*NGRID;i++) {
         colour = GetColour(data[i][j],0,0.1,1);      /////////////////////////////////////////////
         col.r = colour.r * 255;
        // col.b = colour.b * 255;
       //  Draw_Pixel(image,SCALE*NGRID,SCALE*NGRID,(double)i,(double)j,col);
        //          colour = GetColour(data[i][j],0,0.0001,1);      /////////////////////////////////////////////
       //  col.g = colour.g * 255;
         Draw_Pixel(image,SCALE*NGRID,SCALE*NGRID,(double)i,(double)j,col);
      }
   }

   /* Finally do the contouring */
   CONREC(data,0,SCALE*NGRID-1,0,SCALE*NGRID-1,
      z,NCONTOUR,contours,drawline);
   fprintf(stderr,"Drew %d vectors\n",vectorsdrawn);

   /* 
      Write the image as a TGA file 
      See bitmaplib.c for more details, or write "image"
      in your own prefered format.
   */
   if ((fp = fopen("image.tga","w")) == NULL) {
      fprintf(stderr,"Failed to open output image\n");
      exit(-1);
   }
   Write_Bitmap(fp,image,SCALE*NGRID,SCALE*NGRID,12);
   fclose(fp);

		
		
		
		exit(0);
} /* End of LAPACKE_zgesvd Example */