Return to hgm.cwishart.R CVS log

Up to [local] / OpenXM / src / R / r-packages / hgm / R

Annotation of OpenXM/src/R/r-packages/hgm/R/hgm.cwishart.R, Revision 1.8

1.8     ! takayama    1: # $OpenXM: OpenXM/src/R/r-packages/hgm/R/hgm.cwishart.R,v 1.7 2014/03/22 00:15:40 takayama Exp $
1.7       takayama    2: "hgm.tk.pwishart" <-
1.5       takayama    3: function(m=3,n=5,beta=c(1,2,3),q0=0.2,approxdeg=-1,h=0.01,dp=20,q=10,
1.6       takayama    4:          mode=c(1,1,0),method="a-rk4",err=c(-1.0,-1.0),
                      5:          automatic=1,assigned_series_error=0.00001,verbose=0) {
1.5       takayama    6:   x<-q; x0<-q0;
1.3       takayama    7:   nstrategy<-0;
                      8:   mm<-charmatch(method,c("rk4","a-rk4","a-rk4-m"));
                      9:   if (!is.na(mm)) nstrategy<- (mm-1);
                     10:
1.4       takayama   11:   if ((m>=200) || (m<=0)) stop("Invalid size of m."); #200 is M_m_MAX in jack-n.c
                     12:
1.1       takayama   13:   if (!is.loaded("hgm")) library.dynam("hgm",package="hgm",lib.loc=NULL);
1.3       takayama   14:
                     15:   .C("Rmh_set_strategy",as.integer(nstrategy),as.double(err),retv=double(1),
                     16:      package="hgm")$retv ;
                     17:
1.1       takayama   18:   if (m<1) m=1;
                     19:   rank <- 2^m;
1.2       takayama   20:   rsize <- rank+1;
                     21:   if (mode[3] > 0) rsize <- rsize+mode[3];
1.8     ! takayama   22:   if (approxdeg < 0) approxdeg <- 6;
        !            23: ##argchecks
        !            24:   if (class(beta) != "numeric") stop("beta must be a vector.");
        !            25:   if (length(beta) != m) stop("The length beta must be equal to m.");
        !            26:   for (i in 1:m) {
        !            27:     if (beta[i] <= 0) stop("beta[i] must be positive.");
        !            28:   }
        !            29:   if (m != 1) {
        !            30:    for (i in 1:(m-1)) {
        !            31:     for (j in  (i+1):m) {
        !            32:        if (beta[i] == beta[j]) stop("beta's must be different.");
        !            33:     }
        !            34:    }
        !            35:   }
        !            36:   if (class(mode) != "numeric") stop("mode must be a vector of length 3.");
        !            37:   if (length(mode) != 3) stop("mode must be a vector of length 3.");
        !            38: ##end of argchecks
        !            39:
1.1       takayama   40:   .C("Rmh_cwishart_gen",as.integer(m),as.integer(n),as.double(beta),as.double(x0),
                     41:      as.integer(approxdeg),
                     42:      as.double(h),
                     43:      as.integer(dp),as.double(x),
                     44:      as.integer(mode),as.integer(rank),
1.6       takayama   45:      as.integer(automatic),as.double(assigned_series_error),as.integer(verbose),
1.2       takayama   46:      retv=double(rsize),PACKAGE="hgm")$retv
1.1       takayama   47: }