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;
}
