[BACK]Return to mh-r.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / hgm / mh / src

Annotation of OpenXM/src/hgm/mh/src/mh-r.c, Revision 1.12

1.12    ! takayama    1: /* $OpenXM: OpenXM/src/hgm/mh/src/mh-r.c,v 1.11 2017/04/01 12:01:25 takayama Exp $
1.1       takayama    2:  R interface module
                      3: */
                      4:
                      5: #include <stdio.h>
                      6: #include "sfile.h"
                      7: #include "mh.h"
                      8: #define WSIZE 1024
                      9:
1.2       takayama   10: int Rmh_cwishart_gen(int *mp,int *np,double *beta,double *x0p,
1.8       takayama   11:                      int *approxDegp,double *hp, int *dpp, double *xp,
                     12:                      int *modep,int *rankp,
                     13:                      int *automaticp,double *assigned_series_errorp,int *verbosep,
                     14:                      double *xy) {
1.1       takayama   15:   struct cWishart *cw;
                     16:   int rank;
                     17:   int i;
1.10      takayama   18:   reset_SAR_warning(1);
1.1       takayama   19:   rank = *rankp;
1.8       takayama   20:   cw = mh_cwishart_gen(*mp,*np,beta,*x0p,*approxDegp,*hp,*dpp,*xp,modep,
                     21:                        *automaticp,*assigned_series_errorp,*verbosep);
1.1       takayama   22:   xy[0] = cw->x;
1.3       takayama   23:   for (i=1; i<=rank; i++) xy[i] = (cw->f)[i-1];
1.5       takayama   24:
                     25:   if ((modep[2] > 0) && cw->aux) {
                     26:     struct SFILE *sfp3;
                     27:     char *s3;
                     28:     char str[1024];
                     29:     double x;
                     30:     s3 = (char *)cw->aux;
                     31:     sfp3 = mh_fopen(s3,"r",0);
                     32:     for (i=cw->rank+1; i<modep[2]+(cw->rank)+1; i++) xy[i] = 0.0;
                     33:     for (i=cw->rank+1; i<modep[2]+(cw->rank)+1; i++) {
                     34:       if (!mh_fgets(str,1024,sfp3)) break;
                     35:       sscanf(str,"%lg",&x);
                     36:       xy[i] = x;
                     37:     }
                     38:   }
1.6       takayama   39:   return(0);
1.1       takayama   40: }
1.7       takayama   41:
                     42: int Rmh_set_strategy(int *m,double *err,double *ans) {
                     43:   mh_set_strategy(*m,err);
                     44:   ans[0] = 0.0;
                     45:   return(0);
                     46: }
1.9       takayama   47:
                     48: int Rmh_pFq_gen(int *mp,
                     49:                 int *pp, double *a,
                     50:                 int *qp, double *b,
                     51:                 int *ef_typep,
                     52:                 double *beta,double *x0p,
                     53:                 int *approxDegp,double *hp, int *dpp, double *xp,
                     54:                 int *modep,int *rankp,
                     55:                 int *automaticp,double *assigned_series_errorp,int *verbosep,
                     56:                 double *xy) {
                     57:   struct cWishart *cw;
                     58:   int rank;
                     59:   int i;
1.10      takayama   60:   reset_SAR_warning(1);
1.9       takayama   61:   rank = *rankp;
                     62:   cw = mh_pFq_gen(*mp,
                     63:                   *pp,a,
                     64:                   *qp,b,
                     65:                   *ef_typep,
                     66:                   beta,*x0p,*approxDegp,*hp,*dpp,*xp,modep,
                     67:                   *automaticp,*assigned_series_errorp,*verbosep);
                     68:   xy[0] = cw->x;
                     69:   for (i=1; i<=rank; i++) xy[i] = (cw->f)[i-1];
                     70:
                     71:   if ((modep[2] > 0) && cw->aux) {
                     72:     struct SFILE *sfp3;
                     73:     char *s3;
                     74:     char str[1024];
                     75:     double x;
                     76:     s3 = (char *)cw->aux;
                     77:     sfp3 = mh_fopen(s3,"r",0);
                     78:     for (i=cw->rank+1; i<modep[2]+(cw->rank)+1; i++) xy[i] = 0.0;
                     79:     for (i=cw->rank+1; i<modep[2]+(cw->rank)+1; i++) {
                     80:       if (!mh_fgets(str,1024,sfp3)) break;
                     81:       sscanf(str,"%lg",&x);
                     82:       xy[i] = x;
                     83:     }
                     84:   }
                     85:   return(0);
                     86: }
1.11      takayama   87:
1.12    ! takayama   88: void so3_main(double *in1,double *in2,double *in3,double *t0p,int *quiet,int *deg,int *log,double *out);
1.11      takayama   89: void hgm_ko_orthant(int *, double *, double *, double *retv);
                     90: static const R_CMethodDef CallEntries[] = {
                     91:   {"Rmh_cwishart_gen", (DL_FUNC) &Rmh_cwishart_gen, 14},
                     92:   {"Rmh_set_strategy", (DL_FUNC) &Rmh_set_strategy, 3},
                     93:   {"Rmh_pFq_gen", (DL_FUNC) &Rmh_pFq_gen,18},
1.12    ! takayama   94:   {"so3_main", (DL_FUNC) &so3_main,8},
1.11      takayama   95:   {"hgm_ko_orthant", (DL_FUNC) &hgm_ko_orthant,4},
1.12    ! takayama   96:   {NULL}
1.11      takayama   97: };
                     98:   /* Sample.
                     99:   {"ggdmc_getAccumulatorMatrix", (DL_FUNC) &ggdmc_getAccumulatorMatrix, 4},
                    100:   {"ggdmc_ddmc", (DL_FUNC) &ggdmc_ddmc, 4},
                    101:   */
                    102: void R_init_hgm(DllInfo *dll) {
                    103:   R_registerRoutines(dll, CallEntries, NULL, NULL, NULL);
                    104:   R_useDynamicSymbols(dll, FALSE);
                    105: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>