Exemple #1
0
static VALUE rb_cqp_data_set_Q(VALUE obj, VALUE mm)
{
  gsl_cqp_data *d;
  gsl_matrix *m;
  Data_Get_Struct(obj, gsl_cqp_data, d);
  CHECK_MATRIX(mm);
  Data_Get_Struct(mm, gsl_matrix, m);
  d->Q = m;
  return Qtrue;
}
Exemple #2
0
static VALUE rb_gsl_blas_dsyrk(VALUE obj, VALUE u, VALUE t, VALUE a, VALUE aa,
			       VALUE b, VALUE cc)
{
  gsl_matrix *A = NULL, *C = NULL;
  double alpha, beta;
  CBLAS_UPLO_t Uplo;
  CBLAS_TRANSPOSE_t Trans;
  CHECK_FIXNUM(u);  CHECK_FIXNUM(t);
  Need_Float(a);  Need_Float(b);
  CHECK_MATRIX(aa);  CHECK_MATRIX(cc);
  Uplo = FIX2INT(u);
  Trans = FIX2INT(t);
  alpha = NUM2DBL(a);
  beta = NUM2DBL(b);
  Data_Get_Struct(aa, gsl_matrix, A);
  Data_Get_Struct(cc, gsl_matrix, C);
  gsl_blas_dsyrk(Uplo, Trans, alpha, A, beta, C);
  return cc;
}
Exemple #3
0
static VALUE rb_gsl_blas_dsyrk2(VALUE obj, VALUE u, VALUE t, VALUE a, VALUE aa,
             VALUE b, VALUE cc)
{
  gsl_matrix *A = NULL, *C = NULL, *Cnew = NULL;
  double alpha, beta;
  CBLAS_UPLO_t Uplo;
  CBLAS_TRANSPOSE_t Trans;
  CHECK_FIXNUM(u);  CHECK_FIXNUM(t);
  Need_Float(a);  Need_Float(b);
  CHECK_MATRIX(aa);  CHECK_MATRIX(cc);
  Uplo = FIX2INT(u);
  Trans = FIX2INT(t);
  alpha = NUM2DBL(a);
  beta = NUM2DBL(b);
  Data_Get_Struct(aa, gsl_matrix, A);
  Data_Get_Struct(cc, gsl_matrix, C);
  Cnew = gsl_matrix_alloc(C->size1, C->size2);
  gsl_matrix_memcpy(Cnew, C);
  gsl_blas_dsyrk(Uplo, Trans, alpha, A, beta, Cnew);
  return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, Cnew);
}
Exemple #4
0
static VALUE rb_gsl_blas_dtrsm(VALUE obj, VALUE s, VALUE u, VALUE ta,
             VALUE d, VALUE a, VALUE aa, VALUE bb)
{
  gsl_matrix *A = NULL, *B = NULL;
  double alpha;
  CBLAS_SIDE_t Side;
  CBLAS_UPLO_t Uplo;
  CBLAS_TRANSPOSE_t TransA;
  CBLAS_DIAG_t Diag;
  CHECK_FIXNUM(s);  CHECK_FIXNUM(u);  CHECK_FIXNUM(ta);  CHECK_FIXNUM(d);
  Need_Float(a);
  CHECK_MATRIX(aa);  CHECK_MATRIX(bb);
  Side = FIX2INT(s);
  Uplo = FIX2INT(u);
  TransA = FIX2INT(ta);
  Diag = FIX2INT(d);
  alpha = NUM2DBL(a);
  Data_Get_Struct(aa, gsl_matrix, A);
  Data_Get_Struct(bb, gsl_matrix, B);
  gsl_blas_dtrsm(Side, Uplo, TransA, Diag, alpha, A, B);
  return bb;
}
Exemple #5
0
static VALUE rb_gsl_linalg_complex_LU_svx(int argc, VALUE *argv, VALUE obj)
{
  gsl_matrix_complex *m = NULL, *mtmp = NULL;
  gsl_permutation *p = NULL;
  gsl_vector_complex *x = NULL;
  int flagm = 0, itmp, signum;
  
  switch (TYPE(obj)) {
  case T_MODULE:
  case T_CLASS:
  case T_OBJECT:
    CHECK_MATRIX(argv[0]);
    Data_Get_Struct(argv[0], gsl_matrix_complex, m);
    if (CLASS_OF(argv[0]) != cgsl_matrix_complex_LU) {
      flagm = 1;
      mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
      gsl_matrix_complex_memcpy(mtmp, m);
    } else {
      mtmp = m;
    }
    itmp = 1;
    break;
  default:
    Data_Get_Struct(obj, gsl_matrix_complex, m);
    if (CLASS_OF(obj) != cgsl_matrix_complex_LU) {
      flagm = 1;
      mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
      gsl_matrix_complex_memcpy(mtmp, m);
    } else {
      mtmp = m;
    }
    itmp = 0;
  }
  if (flagm == 1) {
    if (itmp != argc-1) rb_raise(rb_eArgError, "Usage: m.LU_solve(b)");
    Data_Get_Struct(argv[itmp], gsl_vector_complex, x);
    p = gsl_permutation_alloc(x->size);
    gsl_linalg_complex_LU_decomp(mtmp, p, &signum);
  } else {
    Data_Get_Struct(argv[itmp], gsl_permutation, p);
    itmp++;
    Data_Get_Struct(argv[itmp], gsl_vector_complex, x);
    itmp++;
  }
  gsl_linalg_complex_LU_svx(mtmp, p, x);
  if (flagm == 1) {
    gsl_matrix_complex_free(mtmp);
    gsl_permutation_free(p);
  }
  return argv[argc-1];
}
Exemple #6
0
static VALUE rb_gsl_blas_dtrsm2(VALUE obj, VALUE s, VALUE u, VALUE ta,
             VALUE d, VALUE a, VALUE aa, VALUE bb)
{
  gsl_matrix *A = NULL, *B = NULL, *Bnew = NULL;
  double alpha;
  CBLAS_SIDE_t Side;
  CBLAS_UPLO_t Uplo;
  CBLAS_TRANSPOSE_t TransA;
  CBLAS_DIAG_t Diag;
  CHECK_FIXNUM(s);  CHECK_FIXNUM(u);  CHECK_FIXNUM(ta);  CHECK_FIXNUM(d);
  Need_Float(a);
  CHECK_MATRIX(aa);  CHECK_MATRIX(bb);
  Side = FIX2INT(s);
  Uplo = FIX2INT(u);
  TransA = FIX2INT(ta);
  Diag = FIX2INT(d);
  alpha = NUM2DBL(a);
  Data_Get_Struct(aa, gsl_matrix, A);
  Data_Get_Struct(bb, gsl_matrix, B);
  Bnew = gsl_matrix_alloc(B->size1, B->size2);
  gsl_matrix_memcpy(Bnew, B);
  gsl_blas_dtrsm(Side, Uplo, TransA, Diag, alpha, A, Bnew);
  return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, Bnew);
}
Exemple #7
0
static VALUE rb_gsl_multifit_ndlinear_est(int argc, VALUE *argv, VALUE obj)
{
  gsl_multifit_ndlinear_workspace *w;
  gsl_vector *x = NULL, *c = NULL;
  gsl_matrix *cov = NULL;
  double y, yerr;
  int argc2;
  switch (TYPE(obj)) {
  case T_MODULE:
  case T_CLASS:
  case T_OBJECT:
    if (!rb_obj_is_kind_of(argv[argc-1], cWorkspace)) {
      rb_raise(rb_eTypeError, "Wrong argument type %s (GSL::MultiFit::Ndlinear::Workspace expected)",
        rb_class2name(CLASS_OF(argv[argc-1])));
    }
    Data_Get_Struct(argv[argc-1], gsl_multifit_ndlinear_workspace, w);    
    argc2 = argc-1;
    break;
  default:
    Data_Get_Struct(obj, gsl_multifit_ndlinear_workspace, w);
    argc2 = argc;  
  }
  switch (argc2) {
  case 3:
    CHECK_VECTOR(argv[0]);
    CHECK_VECTOR(argv[1]);
    CHECK_MATRIX(argv[2]);
    Data_Get_Struct(argv[0], gsl_vector, x);
    Data_Get_Struct(argv[1], gsl_vector, c);
    Data_Get_Struct(argv[2], gsl_matrix, cov);   
    break;
  default:
    rb_raise(rb_eArgError, "Wrong number of arguments.");  
  }
  gsl_multifit_ndlinear_est(x, c, cov, &y, &yerr, w);
  return rb_ary_new3(2, rb_float_new(y), rb_float_new(yerr));
}
Exemple #8
0
static VALUE rb_gsl_linalg_complex_LU_solve(int argc, VALUE *argv, VALUE obj)
{
  gsl_matrix_complex *m = NULL, *mtmp = NULL;
  gsl_permutation *p = NULL;
  gsl_vector_complex *b = NULL, *x = NULL;
  int flagm = 0, flagx = 0, itmp, signum;
  
  switch (TYPE(obj)) {
  case T_MODULE:
  case T_CLASS:
  case T_OBJECT:
    if (argc < 2 || argc > 4) 
      rb_raise(rb_eArgError, "Usage: solve(m, b), solve(m, b, x), solve(lu, p, b), solve(lu, p, b, x)");

    CHECK_MATRIX(argv[0]);
    Data_Get_Struct(argv[0], gsl_matrix_complex, m);
    if (CLASS_OF(argv[0]) != cgsl_matrix_complex_LU) {
      flagm = 1;
      mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
      gsl_matrix_complex_memcpy(mtmp, m);
    } else {
      mtmp = m;
    }
    itmp = 1;
    break;
  default:
    if (argc < 1 || argc > 3) 
      rb_raise(rb_eArgError, "Usage: LU_solve(b), LU_solve(p, b), LU_solve(b, x), solve(p, b, x)");
    Data_Get_Struct(obj, gsl_matrix_complex, m);
    if (CLASS_OF(obj) != cgsl_matrix_complex_LU) {
      flagm = 1;
      mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
      gsl_matrix_complex_memcpy(mtmp, m);
    } else {
      mtmp = m;
    }
    itmp = 0;
  }
  if (flagm == 1) {
    if (itmp != argc-1) rb_raise(rb_eArgError, "Usage: m.LU_solve(b)");
    Data_Get_Struct(argv[itmp], gsl_vector_complex, b);
    x = gsl_vector_complex_alloc(b->size);
    p = gsl_permutation_alloc(b->size);
    gsl_linalg_complex_LU_decomp(mtmp, p, &signum);
  } else {
    Data_Get_Struct(argv[itmp], gsl_permutation, p);
    itmp++;
    Data_Get_Struct(argv[itmp], gsl_vector_complex, b);
    itmp++;
    if (itmp == argc-1) {
      Data_Get_Struct(argv[itmp], gsl_vector_complex, x);
      flagx = 1;
    } else {
      x = gsl_vector_complex_alloc(m->size1);
    }
  }
  gsl_linalg_complex_LU_solve(mtmp, p, b, x);
  if (flagm == 1) {
    gsl_matrix_complex_free(mtmp);
    gsl_permutation_free(p);
  }
  if (flagx == 0) return Data_Wrap_Struct(cgsl_vector_complex, 0, gsl_vector_complex_free, x);
  else return argv[argc-1];
}
Exemple #9
0
static void
do_direct_scrolling (struct frame *frame, struct glyph_matrix *current_matrix,
		     struct matrix_elt *cost_matrix, int window_size,
		     int unchanged_at_top)
{
  struct matrix_elt *p;
  int i, j;
  USE_SAFE_ALLOCA;

  /* A queue of deletions and insertions to be performed.  */
  struct alt_queue { int count, pos, window; };
  struct alt_queue *queue_start;
  SAFE_NALLOCA (queue_start, 1, window_size);
  struct alt_queue *queue = queue_start;

  /* True if a terminal window has been set with set_terminal_window.  */
  bool terminal_window_p = 0;

  /* If true, a write has been selected, allowing either an insert or a
     delete to be selected next.  If false, a delete cannot be selected
     unless j < i, and an insert cannot be selected unless i < j.
     This corresponds to a similar restriction (with the ordering
     reversed) in calculate_direct_scrolling, which is intended to
     ensure that lines marked as inserted will be blank. */
  bool write_follows_p = 1;

  /* For each row in the new matrix what row of the old matrix it is.  */
  int *copy_from;
  SAFE_NALLOCA (copy_from, 1, window_size);

  /* Non-zero for each row in the new matrix that is retained from the
     old matrix.  Lines not retained are empty.  */
  char *retained_p = SAFE_ALLOCA (window_size);

  memset (retained_p, 0, window_size * sizeof (char));

  /* Perform some sanity checks when GLYPH_DEBUG is on.  */
  CHECK_MATRIX (current_matrix);

  /* We are working on the line range UNCHANGED_AT_TOP ...
     UNCHANGED_AT_TOP + WINDOW_SIZE (not including) in CURRENT_MATRIX.
     We step through lines in this range from the end to the start.  I
     is an index into new lines, j an index into old lines.  The cost
     matrix determines what to do for ranges of indices.

     If i is decremented without also decrementing j, this corresponds
     to inserting empty lines in the result.  If j is decremented
     without also decrementing i, this corresponds to omitting these
     lines in the new rows, i.e. rows are deleted.  */
  i = j = window_size;

  while (i > 0 || j > 0)
    {
      p = cost_matrix + i * (window_size + 1) + j;

      if (p->insertcost < p->writecost
	  && p->insertcost < p->deletecost
	  && (write_follows_p || i < j))
	{
	  /* Insert is cheaper than deleting or writing lines.  Leave
	     a hole in the result display that will be filled with
	     empty lines when the queue is emptied.  */
	  queue->count = 0;
	  queue->window = i;
	  queue->pos = i - p->insertcount;
	  ++queue;

	  i -= p->insertcount;
	  write_follows_p = 0;
	}
      else if (p->deletecost < p->writecost
	       && (write_follows_p || i > j))
	{
	  /* Deleting lines is cheaper.  By decrementing J, omit
	     deletecount lines from the original.  */
	  write_follows_p = 0;
	  j -= p->deletecount;
	}
      else
	{
	  /* One or more lines should be written.  In the direct
	     scrolling method we do this by scrolling the lines to the
	     place they belong.  */
	  int n_to_write = p->writecount;
	  write_follows_p = 1;
	  eassert (n_to_write > 0);

	  if (i > j)
	    {
	      /* Immediately insert lines */
	      set_terminal_window (frame, i + unchanged_at_top);
	      terminal_window_p = 1;
	      ins_del_lines (frame, j - n_to_write + unchanged_at_top, i - j);
	    }
	  else if (i < j)
	    {
	      /* Queue the deletion of a group of lines */
	      queue->pos = i - n_to_write + unchanged_at_top;
	      queue->window = j + unchanged_at_top;
	      queue->count = i - j;
	      ++queue;
	    }

	  while (n_to_write > 0)
	    {
	      --i, --j, --n_to_write;
	      copy_from[i] = j;
	      retained_p[j] = 1;
	    }
	}
    }

  /* Do queued operations.  */
  if (queue > queue_start)
    {
      int next = -1;

      do
	{
	  --queue;
	  if (queue->count)
	    {
	      set_terminal_window (frame, queue->window);
	      terminal_window_p = 1;
	      ins_del_lines (frame, queue->pos, queue->count);
	    }
	  else
	    {
	      for (j = queue->window - 1; j >= queue->pos; --j)
		{
		  while (retained_p[++next])
		    ;
		  copy_from[j] = next;
		}
	    }
	}
      while (queue > queue_start);
    }

  /* Now, for each row I in the range of rows we are working on,
     copy_from[i] gives the original line to copy to I, and
     retained_p[copy_from[i]] is zero if line I in the new display is
     empty.  */
  mirrored_line_dance (current_matrix, unchanged_at_top, window_size,
		       copy_from, retained_p);

  if (terminal_window_p)
    set_terminal_window (frame, 0);
  SAFE_FREE ();
}
Exemple #10
0
static void
do_scrolling (struct frame *frame, struct glyph_matrix *current_matrix,
              struct matrix_elt *matrix, int window_size,
              int unchanged_at_top)
{
  struct matrix_elt *p;
  int i, j, k;
  USE_SAFE_ALLOCA;

  /* True if we have set a terminal window with set_terminal_window.  */
  bool terminal_window_p = 0;

  /* A queue for line insertions to be done.  */
  struct queue { int count, pos; };
  struct queue *queue_start;
  SAFE_NALLOCA (queue_start, 1, current_matrix->nrows);
  struct queue *queue = queue_start;

  char *retained_p = SAFE_ALLOCA (window_size);
  int *copy_from;
  SAFE_NALLOCA (copy_from, 1, window_size);

  /* Zero means line is empty.  */
  memset (retained_p, 0, window_size * sizeof (char));
  for (k = 0; k < window_size; ++k)
    copy_from[k] = -1;

#ifdef GLYPH_DEBUG
# define CHECK_BOUNDS							\
  do									\
    {									\
      int ck;								\
      for (ck = 0; ck < window_size; ++ck)				\
	eassert (copy_from[ck] == -1					\
		 || (copy_from[ck] >= 0 && copy_from[ck] < window_size)); \
    }									\
  while (0);
#endif

  /* When j is advanced, this corresponds to deleted lines.
     When i is advanced, this corresponds to inserted lines.  */
  i = j = window_size;
  while (i > 0 || j > 0)
    {
      p = matrix + i * (window_size + 1) + j;

      if (p->insertcost < p->writecost && p->insertcost < p->deletecost)
	{
	  /* Insert should be done at vpos i-1, plus maybe some before.
	     Queue the screen operation to be performed.  */
	  queue->count = p->insertcount;
	  queue->pos = i + unchanged_at_top - p->insertcount;
	  ++queue;

	  /* By incrementing I, we leave room in the result rows
	     for the empty rows opened up.  */
	  i -= p->insertcount;
	}
      else if (p->deletecost < p->writecost)
	{
	  /* Old line at vpos j-1, and maybe some before it, should be
	     deleted.  By decrementing J, we skip some lines in the
	     temp_rows which is equivalent to omitting these lines in
	     the result rows, thus deleting them.  */
	  j -= p->deletecount;

	  /* Set the terminal window, if not done already.  */
 	  if (! terminal_window_p)
	    {
	      set_terminal_window (frame, window_size + unchanged_at_top);
	      terminal_window_p = 1;
	    }

	  /* Delete lines on the terminal.  */
	  ins_del_lines (frame, j + unchanged_at_top, - p->deletecount);
	}
      else
	{
	  /* Best thing done here is no insert or delete, i.e. a write.  */
	  --i, --j;
	  eassert (i >= 0 && i < window_size);
	  eassert (j >= 0 && j < window_size);
	  copy_from[i] = j;
	  retained_p[j] = 1;

#ifdef GLYPH_DEBUG
	  CHECK_BOUNDS;
#endif
	}
    }

  /* Now do all insertions queued above.  */
  if (queue > queue_start)
    {
      int next = -1;

      /* Set the terminal window if not yet done.  */
      if (!terminal_window_p)
	{
	  set_terminal_window (frame, window_size + unchanged_at_top);
	  terminal_window_p = 1;
	}

      do
	{
	  --queue;

	  /* Do the deletion on the terminal.  */
	  ins_del_lines (frame, queue->pos, queue->count);

	  /* All lines in the range deleted become empty in the glyph
	     matrix.  Assign to them glyph rows that are not retained.
	     K is the starting position of the deleted range relative
	     to the window we are working in.  */
	  k = queue->pos - unchanged_at_top;
	  for (j = 0; j < queue->count; ++j)
	    {
	      /* Find the next row not retained.  */
	      while (retained_p[++next])
		;

	      /* Record that this row is to be used for the empty
		 glyph row j.  */
	      copy_from[k + j] = next;
	    }
	}
      while (queue > queue_start);

    }

  for (k = 0; k < window_size; ++k)
    eassert (copy_from[k] >= 0 && copy_from[k] < window_size);

  /* Perform the row swizzling.  */
  mirrored_line_dance (current_matrix, unchanged_at_top, window_size,
		       copy_from, retained_p);

  /* Some sanity checks if GLYPH_DEBUG is defined.  */
  CHECK_MATRIX (current_matrix);

  if (terminal_window_p)
    set_terminal_window (frame, 0);
  SAFE_FREE ();
}
Exemple #11
0
static VALUE rb_gsl_math_eval2(double (*func)(const double, const double), VALUE xx,
                               VALUE yy)
{
  VALUE x, y, ary;
  size_t i, j, size;
  gsl_vector *v = NULL, *v2 = NULL, *vnew = NULL;
  gsl_matrix *m = NULL, *m2 = NULL, *mnew = NULL;
  if (CLASS_OF(xx) == rb_cRange) xx = rb_gsl_range2ary(xx);
  switch (TYPE(xx)) {
  case T_FIXNUM:
  case T_BIGNUM:
  case T_FLOAT:
    Need_Float(yy);
    return rb_float_new((*func)(NUM2DBL(xx), NUM2DBL(yy)));
    break;
  case T_ARRAY:
    Check_Type(yy, T_ARRAY);
    size = RARRAY_LEN(xx);
    //    if (size != RARRAY(yy)->len) rb_raise(rb_eRuntimeError, "array sizes are different.");
    if ((int) size != RARRAY_LEN(yy)) rb_raise(rb_eRuntimeError, "array sizes are different.");
    ary = rb_ary_new2(size);
    for (i = 0; i < size; i++) {
      x = rb_ary_entry(xx, i);
      y = rb_ary_entry(yy, i);
      Need_Float(x); Need_Float(y);
      //      rb_ary_store(ary, i, rb_float_new((*func)(RFLOAT(x)->value, RFLOAT(y)->value)));
      rb_ary_store(ary, i, rb_float_new((*func)(NUM2DBL(x), NUM2DBL(y))));
    }
    return ary;
    break;
  default:
#ifdef HAVE_NARRAY_H
    if (NA_IsNArray(xx)) {
      struct NARRAY *nax, *nay;
      double *ptr1, *ptr2, *ptr3;
      GetNArray(xx, nax);
      GetNArray(yy, nay);
      ptr1 = (double*) nax->ptr;
      ptr2 = (double*) nay->ptr;
      size = nax->total;
      ary = na_make_object(NA_DFLOAT, nax->rank, nax->shape, CLASS_OF(xx));
      ptr3 = NA_PTR_TYPE(ary, double*);
      for (i = 0; i < size; i++) ptr3[i] = (*func)(ptr1[i], ptr2[i]);
      return ary;
    }
#endif
    if (VECTOR_P(xx)) {
      CHECK_VECTOR(yy);
      Data_Get_Struct(xx, gsl_vector, v);
      Data_Get_Struct(yy, gsl_vector, v2);
      vnew = gsl_vector_alloc(v->size);
      for (i = 0; i < v->size; i++) {
        gsl_vector_set(vnew, i, (*func)(gsl_vector_get(v, i), gsl_vector_get(v2, i)));
      }
      return Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, vnew);
    } else if (MATRIX_P(xx)) {
      CHECK_MATRIX(yy);
      Data_Get_Struct(xx, gsl_matrix, m);
      Data_Get_Struct(yy, gsl_matrix, m2);
      mnew = gsl_matrix_alloc(m->size1, m->size2);
      for (i = 0; i < m->size1; i++) {
        for (j = 0; j < m->size2; j++) {
          gsl_matrix_set(mnew, i, j, (*func)(gsl_matrix_get(m, i, j), gsl_matrix_get(m2, i, j)));
        }
      }
      return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, mnew);
    } else {
      rb_raise(rb_eTypeError,
               "wrong argument type %s "
               "(Array or Vector or Matrix expected)", rb_class2name(CLASS_OF(xx)));
    }
    break;
  }
  /* never reach here */
  return Qnil;
}
Exemple #12
0
static VALUE rb_gsl_blas_dsymm(int argc, VALUE *argv, VALUE obj)
{
  gsl_matrix *A = NULL, *B = NULL, *C = NULL;
  double alpha, beta;
  CBLAS_SIDE_t Side;
  CBLAS_UPLO_t Uplo;
  int flag = 0;
  switch (argc) {
  case 2:
    CHECK_MATRIX(argv[0]);
    CHECK_MATRIX(argv[1]);
    Data_Get_Struct(argv[0], gsl_matrix, A);
    Data_Get_Struct(argv[1], gsl_matrix, B);
    C = gsl_matrix_calloc(A->size1, B->size2);
    alpha = 1.0;
    beta = 0.0;
    Side = CblasLeft;  Uplo = CblasUpper;
    flag = 1;
    break;
  case 5:
    CHECK_FIXNUM(argv[0]);
    CHECK_FIXNUM(argv[1]);
    Need_Float(argv[2]);
    CHECK_MATRIX(argv[3]);
    CHECK_MATRIX(argv[4]);
    Side = FIX2INT(argv[0]);
    Uplo = FIX2INT(argv[1]);
    alpha = NUM2DBL(argv[2]);
    Data_Get_Struct(argv[3], gsl_matrix, A);
    Data_Get_Struct(argv[4], gsl_matrix, B);
    C = gsl_matrix_calloc(A->size1, B->size2);
    beta = 0.0;
    flag = 1;
    break;
  case 6:
    CHECK_FIXNUM(argv[0]);
    CHECK_FIXNUM(argv[1]);
    Need_Float(argv[2]);
    CHECK_MATRIX(argv[3]);
    CHECK_MATRIX(argv[4]);
    Need_Float(argv[5]);
    CHECK_MATRIX(argv[6]);
    Side = FIX2INT(argv[0]);
    Uplo = FIX2INT(argv[1]);
    alpha = NUM2DBL(argv[2]);
    Data_Get_Struct(argv[3], gsl_matrix, A);
    Data_Get_Struct(argv[4], gsl_matrix, B);
    beta = NUM2DBL(argv[5]);
    C = gsl_matrix_calloc(A->size1, B->size2);
    flag = 1;
    break;
  case 7:
    CHECK_FIXNUM(argv[0]);
    CHECK_FIXNUM(argv[1]);
    Need_Float(argv[2]);
    CHECK_MATRIX(argv[3]);
    CHECK_MATRIX(argv[4]);
    Need_Float(argv[5]);
    CHECK_MATRIX(argv[6]);
    Side = FIX2INT(argv[0]);
    Uplo = FIX2INT(argv[1]);
    alpha = NUM2DBL(argv[2]);
    Data_Get_Struct(argv[3], gsl_matrix, A);
    Data_Get_Struct(argv[4], gsl_matrix, B);
    beta = NUM2DBL(argv[5]);
    Data_Get_Struct(argv[6], gsl_matrix, C);
    break;
  default:
    rb_raise(rb_eArgError, "wrong number of arguments (%d for 2 or 7)", argc);
    break;
  }
  gsl_blas_dsymm(Side, Uplo, alpha, A, B, beta, C);
  if (flag == 1) return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, C);
  else return argv[6];
}
Exemple #13
0
static VALUE rb_gsl_blas_dgemm(int argc, VALUE *argv, VALUE obj)
{
  gsl_matrix *A = NULL, *B = NULL, *C = NULL;
  double alpha, beta;
  CBLAS_TRANSPOSE_t TransA, TransB;
  int flag = 0;
  switch (argc) {
  case 2:
    CHECK_MATRIX(argv[0]);
    CHECK_MATRIX(argv[1]);
    Data_Get_Struct(argv[0], gsl_matrix, A);
    Data_Get_Struct(argv[1], gsl_matrix, B);
    C = gsl_matrix_calloc(A->size1, B->size2);
    alpha = 1.0;
    beta = 0.0;
    TransA = CblasNoTrans;  TransB = CblasNoTrans;
    flag = 1;
    break;
  case 5:
    CHECK_FIXNUM(argv[0]);
    CHECK_FIXNUM(argv[1]);
    Need_Float(argv[2]);
    CHECK_MATRIX(argv[3]);
    CHECK_MATRIX(argv[4]);
    TransA = FIX2INT(argv[0]);
    TransB = FIX2INT(argv[1]);
    alpha = NUM2DBL(argv[2]);
    Data_Get_Struct(argv[3], gsl_matrix, A);
    Data_Get_Struct(argv[4], gsl_matrix, B);
    C = gsl_matrix_calloc(A->size1, B->size2);
    beta = 0.0;
    flag = 1;
    break;
  case 6:
    CHECK_FIXNUM(argv[0]);
    CHECK_FIXNUM(argv[1]);
    Need_Float(argv[2]);
    CHECK_MATRIX(argv[3]);
    CHECK_MATRIX(argv[4]);
    Need_Float(argv[5]);
    TransA = FIX2INT(argv[0]);
    TransB = FIX2INT(argv[1]);
    alpha = NUM2DBL(argv[2]);
    Data_Get_Struct(argv[3], gsl_matrix, A);
    Data_Get_Struct(argv[4], gsl_matrix, B);
    beta = NUM2DBL(argv[5]);
    C = gsl_matrix_calloc(A->size1, B->size2);
    flag = 1;
    break;
  case 7:
    CHECK_FIXNUM(argv[0]);
    CHECK_FIXNUM(argv[1]);
    Need_Float(argv[2]);
    CHECK_MATRIX(argv[3]);
    CHECK_MATRIX(argv[4]);
    Need_Float(argv[5]);
    CHECK_MATRIX(argv[6]);
    TransA = FIX2INT(argv[0]);
    TransB = FIX2INT(argv[1]);
    alpha = NUM2DBL(argv[2]);
    Data_Get_Struct(argv[3], gsl_matrix, A);
    Data_Get_Struct(argv[4], gsl_matrix, B);
    beta = NUM2DBL(argv[5]);
    Data_Get_Struct(argv[6], gsl_matrix, C);
    break;
  default:
    rb_raise(rb_eArgError, "wrong number of arguments (%d for 2, 5, 6, or 7)", argc);
    break;
  }
  gsl_blas_dgemm(TransA, TransB, alpha, A, B, beta, C);
  if (flag == 1) return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, C);
  else return argv[6];
}