SCM

SCM Repository

[matrix] Diff of /pkg/src/chm_common.c
ViewVC logotype

Diff of /pkg/src/chm_common.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2386, Wed May 27 20:54:45 2009 UTC revision 2387, Fri May 29 12:50:34 2009 UTC
# Line 103  Line 103 
103    
104      SEXP islot = GET_SLOT(x, Matrix_iSym);      SEXP islot = GET_SLOT(x, Matrix_iSym);
105    
106      if (ctype < 0) error("invalid class of object to as_cholmod_sparse");      if (ctype < 0) error(_("invalid class of object to as_cholmod_sparse"));
107      if (!isValid_Csparse(x))      if (!isValid_Csparse(x))
108          error("invalid object passed to as_cholmod_sparse");          error(_("invalid object passed to as_cholmod_sparse"))s;
109      memset(ans, 0, sizeof(cholmod_sparse)); /* zero the struct */      memset(ans, 0, sizeof(cholmod_sparse)); /* zero the struct */
110    
111      ans->itype = CHOLMOD_LONG;  /* characteristics of the system */      ans->itype = CHOLMOD_LONG;  /* characteristics of the system */
# Line 208  Line 208 
208      case CHOLMOD_COMPLEX:      case CHOLMOD_COMPLEX:
209          cls = uploT ? "ztCMatrix": ((a->stype) ? "zsCMatrix" : "zgCMatrix");          cls = uploT ? "ztCMatrix": ((a->stype) ? "zsCMatrix" : "zgCMatrix");
210          break;          break;
211      default: error("unknown xtype in cholmod_sparse object");      default: error(_("unknown xtype in cholmod_sparse object"));
212      }      }
213      ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cls)));      ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cls)));
214                                  /* allocate and copy common slots */                                  /* allocate and copy common slots */
# Line 233  Line 233 
233          }          }
234      }      }
235      else if (a->xtype == CHOLMOD_COMPLEX)      else if (a->xtype == CHOLMOD_COMPLEX)
236          error("complex sparse matrix code not yet written");          error(_("complex sparse matrix code not yet written"));
237  /*      Memcpy(COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, nnz)), */  /*      Memcpy(COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, nnz)), */
238  /*             (complex *) a->x, nnz); */  /*             (complex *) a->x, nnz); */
239      if (uploT) {                /* slots for triangularMatrix */      if (uploT) {                /* slots for triangularMatrix */
240          if (a->stype) error("Symmetric and triangular both set");          if (a->stype) error(_("Symmetric and triangular both set"));
241          SET_SLOT(ans, Matrix_uploSym, mkString((uploT > 0) ? "U" : "L"));          SET_SLOT(ans, Matrix_uploSym, mkString((uploT > 0) ? "U" : "L"));
242          SET_SLOT(ans, Matrix_diagSym, mkString(diag));          SET_SLOT(ans, Matrix_diagSym, mkString(diag));
243      }      }
# Line 279  Line 279 
279      SEXP islot;      SEXP islot;
280      Rboolean do_Udiag = (check_Udiag && ctype % 3 == 2 && (*diag_P(x) == 'U'));      Rboolean do_Udiag = (check_Udiag && ctype % 3 == 2 && (*diag_P(x) == 'U'));
281    
282      if (ctype < 0) error("invalid class of object to as_cholmod_triplet");      if (ctype < 0) error(_("invalid class of object to as_cholmod_triplet"));
283      memset(ans, 0, sizeof(cholmod_triplet)); /* zero the struct */      memset(ans, 0, sizeof(cholmod_triplet)); /* zero the struct */
284    
285      ans->itype = CHOLMOD_LONG;  /* characteristics of the system */      ans->itype = CHOLMOD_LONG;  /* characteristics of the system */
# Line 393  Line 393 
393          cl = uploT ? "ztTMatrix" :          cl = uploT ? "ztTMatrix" :
394              ((a->stype) ? "zsTMatrix" : "zgTMatrix");              ((a->stype) ? "zsTMatrix" : "zgTMatrix");
395          break;          break;
396      default: error("unknown xtype in cholmod_triplet object");      default: error(_("unknown xtype in cholmod_triplet object"));
397      }      }
398      ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));      ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));
399                                  /* allocate and copy common slots */                                  /* allocate and copy common slots */
# Line 421  Line 421 
421          }          }
422      }      }
423      else if (a->xtype == CHOLMOD_COMPLEX)      else if (a->xtype == CHOLMOD_COMPLEX)
424          error("complex sparse matrix code not yet written");          error(_("complex sparse matrix code not yet written"));
425  /*      Memcpy(COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, a->nnz)), */  /*      Memcpy(COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, a->nnz)), */
426  /*             (complex *) a->x, a->nz); */  /*             (complex *) a->x, a->nz); */
427      if (uploT) {                /* slots for triangularMatrix */      if (uploT) {                /* slots for triangularMatrix */
428          if (a->stype) error("Symmetric and triangular both set");          if (a->stype) error(_("Symmetric and triangular both set"));
429          SET_SLOT(ans, Matrix_uploSym, mkString((uploT > 0) ? "U" : "L"));          SET_SLOT(ans, Matrix_uploSym, mkString((uploT > 0) ? "U" : "L"));
430          SET_SLOT(ans, Matrix_diagSym, mkString(diag));          SET_SLOT(ans, Matrix_diagSym, mkString(diag));
431      }      }
# Line 474  Line 474 
474                   (isLogical(x) ? 2 : /* logical -> default to "l", not "n" */ \                   (isLogical(x) ? 2 : /* logical -> default to "l", not "n" */ \
475                    (isComplex(x) ? 6 : -1)));                            \                    (isComplex(x) ? 6 : -1)));                            \
476      } else Memcpy(dims, INTEGER(GET_SLOT(x, Matrix_DimSym)), 2);        \      } else Memcpy(dims, INTEGER(GET_SLOT(x, Matrix_DimSym)), 2);        \
477      if (ctype < 0) error("invalid class of object to as_cholmod_dense");\      if (ctype < 0) error(_("invalid class of object to as_cholmod_dense")); \
478      memset(ans, 0, sizeof(cholmod_dense)); /* zero the struct */        \      memset(ans, 0, sizeof(cholmod_dense)); /* zero the struct */        \
479                                                                          \                                                                          \
480      ans->dtype = CHOLMOD_DOUBLE; /* characteristics of the system */    \      ans->dtype = CHOLMOD_DOUBLE; /* characteristics of the system */    \
# Line 606  Line 606 
606          case -1: cl = "ngeMatrix"; break;          case -1: cl = "ngeMatrix"; break;
607          case 0:  cl = "dgeMatrix"; break;          case 0:  cl = "dgeMatrix"; break;
608          case 1:  cl = "lgeMatrix"; break;          case 1:  cl = "lgeMatrix"; break;
609          default: error("unknown 'Rkind'");          default: error(_("unknown 'Rkind'"));
610          }          }
611          break;          break;
612      case CHOLMOD_COMPLEX:      case CHOLMOD_COMPLEX:
613          cl = "zgeMatrix"; break;          cl = "zgeMatrix"; break;
614      default:      default:
615          error("unknown xtype");          error(_("unknown xtype"));
616      }      }
617    
618      ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));      ans = PROTECT(NEW_OBJECT(MAKE_CLASS(cl)));
# Line 639  Line 639 
639              }              }
640          }          }
641          else if (a->xtype == CHOLMOD_COMPLEX)          else if (a->xtype == CHOLMOD_COMPLEX)
642              error("complex sparse matrix code not yet written");              error(_("complex sparse matrix code not yet written"));
643  /*      Memcpy(COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, ntot)), */  /*      Memcpy(COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, ntot)), */
644  /*             (complex *) a->x, ntot); */  /*             (complex *) a->x, ntot); */
645      } else error("code for cholmod_dense with holes not yet written");      } else error(_("code for cholmod_dense with holes not yet written"));
646    
647      if (dofree > 0) cholmod_l_free_dense(&a, &c);      if (dofree > 0) cholmod_l_free_dense(&a, &c);
648      if (dofree < 0) Free(a);      if (dofree < 0) Free(a);
# Line 672  Line 672 
672      typ = (a->xtype == CHOLMOD_PATTERN) ? LGLSXP :      typ = (a->xtype == CHOLMOD_PATTERN) ? LGLSXP :
673          ((a->xtype == CHOLMOD_REAL) ? REALSXP :          ((a->xtype == CHOLMOD_REAL) ? REALSXP :
674           ((a->xtype == CHOLMOD_COMPLEX) ? CPLXSXP : NILSXP));           ((a->xtype == CHOLMOD_COMPLEX) ? CPLXSXP : NILSXP));
675      if (typ == NILSXP) error("unknown xtype");      if (typ == NILSXP) error(_("unknown xtype"));
676    
677      ans = PROTECT(allocMatrix(typ, a->nrow, a->ncol));      ans = PROTECT(allocMatrix(typ, a->nrow, a->ncol));
678      if (a->d == a->nrow) {      /* copy data slot if present */      if (a->d == a->nrow) {      /* copy data slot if present */
679          if (a->xtype == CHOLMOD_REAL)          if (a->xtype == CHOLMOD_REAL)
680              Memcpy(REAL(ans), (double *) a->x, a->nrow * a->ncol);              Memcpy(REAL(ans), (double *) a->x, a->nrow * a->ncol);
681          else if (a->xtype == CHOLMOD_COMPLEX)          else if (a->xtype == CHOLMOD_COMPLEX)
682              error("complex sparse matrix code not yet written");              error(_("complex sparse matrix code not yet written"));
683          else if (a->xtype == CHOLMOD_PATTERN)          else if (a->xtype == CHOLMOD_PATTERN)
684              error("don't know if a dense pattern matrix makes sense");              error(_("don't know if a dense pattern matrix makes sense"));
685  /*      Memcpy(COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, a->nnz)), */  /*      Memcpy(COMPLEX(ALLOC_SLOT(ans, Matrix_xSym, CPLXSXP, a->nnz)), */
686  /*             (complex *) a->x, a->nz); */  /*             (complex *) a->x, a->nz); */
687      } else error("code for cholmod_dense with holes not yet written");      } else error(_("code for cholmod_dense with holes not yet written"));
688    
689      if (dofree > 0) cholmod_l_free_dense(&a, &c);      if (dofree > 0) cholmod_l_free_dense(&a, &c);
690      if (dofree < 0) Free(a);      if (dofree < 0) Free(a);
# Line 725  Line 725 
725          ctype = Matrix_check_class_etc(x, valid);          ctype = Matrix_check_class_etc(x, valid);
726      SEXP tmp;      SEXP tmp;
727    
728      if (ctype < 0) error("invalid class of object to as_cholmod_factor");      if (ctype < 0) error(_("invalid class of object to as_cholmod_factor"));
729      memset(ans, 0, sizeof(cholmod_factor)); /* zero the struct */      memset(ans, 0, sizeof(cholmod_factor)); /* zero the struct */
730    
731      ans->itype = CHOLMOD_LONG;  /* characteristics of the system */      ans->itype = CHOLMOD_LONG;  /* characteristics of the system */

Legend:
Removed from v.2386  
changed lines
  Added in v.2387

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge