コード例 #1
0
ファイル: pcholesky.c プロジェクト: ampl/gsl
static int
pcholesky_decomp (const int copy_uplo, gsl_matrix * A, gsl_permutation * p)
{
  const size_t N = A->size1;

  if (N != A->size2)
    {
      GSL_ERROR("LDLT decomposition requires square matrix", GSL_ENOTSQR);
    }
  else if (p->size != N)
    {
      GSL_ERROR ("permutation length must match matrix size", GSL_EBADLEN);
    }
  else
    {
      gsl_vector_view diag = gsl_matrix_diagonal(A);
      size_t k;

      if (copy_uplo)
        {
          /* save a copy of A in upper triangle (for later rcond calculation) */
          gsl_matrix_transpose_tricpy('L', 0, A, A);
        }

      gsl_permutation_init(p);

      for (k = 0; k < N; ++k)
        {
          gsl_vector_view w;
          size_t j;

          /* compute j = max_idx { A_kk, ..., A_nn } */
          w = gsl_vector_subvector(&diag.vector, k, N - k);
          j = gsl_vector_max_index(&w.vector) + k;
          gsl_permutation_swap(p, k, j);

          cholesky_swap_rowcol(A, k, j);

          if (k < N - 1)
            {
              double alpha = gsl_matrix_get(A, k, k);
              double alphainv = 1.0 / alpha;

              /* v = A(k+1:n, k) */
              gsl_vector_view v = gsl_matrix_subcolumn(A, k, k + 1, N - k - 1);

              /* m = A(k+1:n, k+1:n) */
              gsl_matrix_view m = gsl_matrix_submatrix(A, k + 1, k + 1, N - k - 1, N - k - 1);

              /* m = m - v v^T / alpha */
              gsl_blas_dsyr(CblasLower, -alphainv, &v.vector, &m.matrix);

              /* v = v / alpha */
              gsl_vector_scale(&v.vector, alphainv);
            }
        }

      return GSL_SUCCESS;
    }
}
コード例 #2
0
ファイル: permutation.c プロジェクト: davidrichards/rb-gsl
static VALUE rb_gsl_permutation_swap(VALUE obj, VALUE i, VALUE j)
{
  gsl_permutation *p = NULL;
  CHECK_FIXNUM(i); CHECK_FIXNUM(j);
  Data_Get_Struct(obj, gsl_permutation, p);
  gsl_permutation_swap(p, FIX2INT(i), FIX2INT(j));
  return obj;
}
コード例 #3
0
ファイル: gsl_linalg_ptlq.c プロジェクト: aadaa88/mldemos
int
gsl_linalg_PTLQ_decomp (gsl_matrix * A, gsl_vector * tau, gsl_permutation * p, int *signum, gsl_vector * norm)
{
  const size_t N = A->size1;
  const size_t M = A->size2;

  if (tau->size != GSL_MIN (M, N))
    {
      GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
    }
  else if (p->size != N)
    {
      GSL_ERROR ("permutation size must be N", GSL_EBADLEN);
    }
  else if (norm->size != N)
    {
      GSL_ERROR ("norm size must be N", GSL_EBADLEN);
    }
  else
    {
      size_t i;

      *signum = 1;

      gsl_permutation_init (p); /* set to identity */

      /* Compute column norms and store in workspace */

      for (i = 0; i < N; i++)
        {
          gsl_vector_view c = gsl_matrix_row (A, i);
          double x = gsl_blas_dnrm2 (&c.vector);
          gsl_vector_set (norm, i, x);
        }

      for (i = 0; i < GSL_MIN (M, N); i++)
        {
          /* Bring the column of largest norm into the pivot position */

          double max_norm = gsl_vector_get(norm, i);
          size_t j, kmax = i;

          for (j = i + 1; j < N; j++)
            {
              double x = gsl_vector_get (norm, j);

              if (x > max_norm)
                {
                  max_norm = x;
                  kmax = j;
                }
            }

          if (kmax != i)
            {
              gsl_matrix_swap_rows (A, i, kmax);
              gsl_permutation_swap (p, i, kmax);
              gsl_vector_swap_elements(norm,i,kmax);

              (*signum) = -(*signum);
            }

          /* Compute the Householder transformation to reduce the j-th
             column of the matrix to a multiple of the j-th unit vector */

          {
            gsl_vector_view c_full = gsl_matrix_row (A, i);
            gsl_vector_view c = gsl_vector_subvector (&c_full.vector, 
                                                      i, M - i);
            double tau_i = gsl_linalg_householder_transform (&c.vector);

            gsl_vector_set (tau, i, tau_i);

            /* Apply the transformation to the remaining columns */

            if (i + 1 < N)
              {
                gsl_matrix_view m = gsl_matrix_submatrix (A, i +1, i, N - (i+1), M - i);

                gsl_linalg_householder_mh (tau_i, &c.vector, &m.matrix);
              }
          }

          /* Update the norms of the remaining columns too */

          if (i + 1 < M) 
            {
              for (j = i + 1; j < N; j++)
                {
                  double x = gsl_vector_get (norm, j);

                  if (x > 0.0)
                    {
                      double y = 0;
                      double temp= gsl_matrix_get (A, j, i) / x;
                  
                      if (fabs (temp) >= 1)
                        y = 0.0;
                      else
                        y = x * sqrt (1 - temp * temp);
                      
                      /* recompute norm to prevent loss of accuracy */

                      if (fabs (y / x) < sqrt (20.0) * GSL_SQRT_DBL_EPSILON)
                        {
                          gsl_vector_view c_full = gsl_matrix_row (A, j);
                          gsl_vector_view c = 
                            gsl_vector_subvector(&c_full.vector,
                                                 i+1, M - (i+1));
                          y = gsl_blas_dnrm2 (&c.vector);
                        }
                  
                      gsl_vector_set (norm, j, y);
                    }
                }
            }
        }

      return GSL_SUCCESS;
    }
}
コード例 #4
0
ファイル: luc.c プロジェクト: ICML14MoMCompare/spectral-learn
int
gsl_linalg_complex_LU_decomp (gsl_matrix_complex * A, gsl_permutation * p, int *signum)
{
  if (A->size1 != A->size2)
    {
      GSL_ERROR ("LU decomposition requires square matrix", GSL_ENOTSQR);
    }
  else if (p->size != A->size1)
    {
      GSL_ERROR ("permutation length must match matrix size", GSL_EBADLEN);
    }
  else
    {
      const size_t N = A->size1;
      size_t i, j, k;

      *signum = 1;
      gsl_permutation_init (p);

      for (j = 0; j < N - 1; j++)
	{
	  /* Find maximum in the j-th column */

	  gsl_complex ajj = gsl_matrix_complex_get (A, j, j);
          double max = gsl_complex_abs (ajj);
	  size_t i_pivot = j;

	  for (i = j + 1; i < N; i++)
	    {
	      gsl_complex aij = gsl_matrix_complex_get (A, i, j);
              double ai = gsl_complex_abs (aij);

	      if (ai > max)
		{
		  max = ai;
		  i_pivot = i;
		}
	    }

	  if (i_pivot != j)
	    {
	      gsl_matrix_complex_swap_rows (A, j, i_pivot);
	      gsl_permutation_swap (p, j, i_pivot);
	      *signum = -(*signum);
	    }

	  ajj = gsl_matrix_complex_get (A, j, j);

	  if (!(GSL_REAL(ajj) == 0.0 && GSL_IMAG(ajj) == 0.0))
	    {
	      for (i = j + 1; i < N; i++)
		{
		  gsl_complex aij_orig = gsl_matrix_complex_get (A, i, j);
                  gsl_complex aij = gsl_complex_div (aij_orig, ajj);
		  gsl_matrix_complex_set (A, i, j, aij);

		  for (k = j + 1; k < N; k++)
		    {
		      gsl_complex aik = gsl_matrix_complex_get (A, i, k);
		      gsl_complex ajk = gsl_matrix_complex_get (A, j, k);
                      
                      /* aik = aik - aij * ajk */

                      gsl_complex aijajk = gsl_complex_mul (aij, ajk);
                      gsl_complex aik_new = gsl_complex_sub (aik, aijajk);

		      gsl_matrix_complex_set (A, i, k, aik_new);
		    }
		}
	    }
	}
      
      return GSL_SUCCESS;
    }
}