static gsl_poly_int* mygsl_poly_laguerre(int n) { size_t m, k; int val; gsl_vector_int *p0; if (n < 0) rb_raise(rb_eArgError, "order must be >= 0"); p0 = gsl_vector_int_calloc(n + 1); switch (n) { case 0: gsl_vector_int_set(p0, 0, 1); break; case 1: gsl_vector_int_set(p0, 0, 1); gsl_vector_int_set(p0, 1, -1); break; default: k = gsl_sf_fact(n); for (m = 0; m <= n; m++) { val = k*k/gsl_sf_fact(n-m)/gsl_pow_2(gsl_sf_fact(m)); if (m%2 == 1) val *= -1; gsl_vector_int_set(p0, m, val); } break; } return p0; }
static gsl_poly_int* mygsl_poly_bessel(int n) { size_t k; gsl_vector_int *p0; if (n < 0) rb_raise(rb_eArgError, "order must be >= 0"); p0 = gsl_vector_int_calloc(n + 1); for (k = 0; k <= n; k++) { gsl_vector_int_set(p0, k, gsl_sf_fact(n+k)/gsl_sf_fact(n-k)/gsl_sf_fact(k)/((int) pow(2, k))); } return p0; }
static gsl_poly_int* mygsl_poly_hermite(int n1) { size_t n; gsl_vector_int *p1, *p2, *p0; int coef1[2] = {0, 2}; int coef2[3] = {-2, 0, 4}; if (n1 < 0) rb_raise(rb_eArgError, "order must be >= 0"); p0 = gsl_vector_int_calloc(n1 + 1); switch (n1) { case 0: gsl_vector_int_set(p0, 0, 1); break; case 1: memcpy(p0->data, coef1, 2*sizeof(int)); break; case 2: memcpy(p0->data, coef2, 3*sizeof(int)); break; default: p1 = gsl_vector_int_calloc(n1 + 1); p2 = gsl_vector_int_calloc(n1 + 1); memcpy(p1->data, coef2, 3*sizeof(int)); memcpy(p2->data, coef1, 2*sizeof(int)); for (n = 2; n < n1; n++) { gsl_vector_int_memcpy(p0, p1); mygsl_vector_int_shift_scale2(p0, n); gsl_vector_int_scale(p2, 2*n); gsl_vector_int_sub(p0, p2); /* save for the next iteration */ gsl_vector_int_memcpy(p2, p1); gsl_vector_int_memcpy(p1, p0); } gsl_vector_int_free(p2); gsl_vector_int_free(p1); break; } return p0; }
static gsl_poly_int* mygsl_poly_bell(int n1) { size_t n, j; gsl_vector_int *p1, *p0; int coef1[2] = {0, 1}; int coef2[3] = {0, 1, 1}; if (n1 < 0) rb_raise(rb_eArgError, "order must be >= 0"); p0 = gsl_vector_int_calloc(n1 + 1); switch (n1) { case 0: gsl_vector_int_set(p0, 0, 1); break; case 1: memcpy(p0->data, coef1, 2*sizeof(int)); break; case 2: memcpy(p0->data, coef2, 3*sizeof(int)); break; default: p1 = gsl_vector_int_calloc(n1 + 1); memcpy(p1->data, coef2, 3*sizeof(int)); for (n = 2; n < n1; n++) { gsl_vector_int_memcpy(p0, p1); mygsl_vector_int_shift(p0, n); for (j = 0; j < n; j++) { gsl_vector_int_set(p1, j, gsl_vector_int_get(p1, j+1)*(j+1)); } gsl_vector_int_set(p1, n, 0); mygsl_vector_int_shift(p1, n); gsl_vector_int_add(p0, p1); /* save for the next iteration */ gsl_vector_int_memcpy(p1, p0); } gsl_vector_int_free(p1); break; } return p0; }
int DPMHC_S_smplr(struct str_DPMHC *ptr_DPMHC_data) { int i_K = ptr_DPMHC_data->i_K; gsl_vector *v_y = ptr_DPMHC_data->v_y; gsl_vector *v_w = ptr_DPMHC_data->v_w; gsl_vector *v_u = ptr_DPMHC_data->v_u; gsl_vector_int *vi_S = ptr_DPMHC_data->vi_S; gsl_vector_int *vi_n = ptr_DPMHC_data->vi_n; gsl_matrix *m_DPtheta = ptr_DPMHC_data->m_DPtheta; size_t i_n=v_y->size; gsl_vector *v_p = gsl_vector_calloc (i_K); gsl_vector_int *vi_cnt = gsl_vector_int_calloc (i_K); int i,j,st,ism; double sm,dn; double d_yi,d_muj,d_xij,d_tauj; gsl_vector_int_set_zero ( vi_cnt ); gsl_vector_int_set_zero ( vi_n ); for(i=0;i<i_n;i++){ //printf("i=%d\n",i); d_yi = v_y->data[i]; sm=0.0; for(j=0;j<i_K;j++){ if( vget(v_w,j) <= vget(v_u,i) ){ vset(v_p,j,0.0); // printf("w_j,u_i %g %g",vget(w,j),vget(u,i)); }else{ // printf("K=%d\n",i_K); // dn = den_norm_prec ( vget(y,i), mget(theta,j,0), mget(theta,j,1) ); d_muj = mget(m_DPtheta,j,0); d_xij = mget(m_DPtheta,j,1); d_tauj = mget(m_DPtheta,j,2); dn = exp( log_nor(d_yi, d_muj, fabs(d_xij) * fabs(d_xij) / d_tauj )); vset(v_p,j,dn); sm+=dn; //printf("p>0\n"); } } /* standardize */ gsl_vector_scale( v_p, 1.0/sm ); // pvec(p); /* take draw */ st = (int)ran_multinomial( v_p, i_K-1 ); vset_int(vi_S,i,st); vset_int(vi_cnt,st,1); (vi_n->data[st])++; } /* find number of clusters with at least one observation assigned to it */ ism=0; for(j=0;j<i_K;j++){ if( vget_int(vi_cnt,j) == 1)ism++; } ptr_DPMHC_data->i_m = ism; gsl_vector_free (v_p); gsl_vector_int_free (vi_cnt); return 0; }