static apop_data *colmeans(apop_data *in){ Get_vmsizes(in); //maxsize apop_data *sums = apop_data_summarize(in); Apop_col_tv(sums, "mean", means); apop_data *out = apop_matrix_to_data(apop_vector_to_matrix(means, 'r')); apop_name_stack(out->names, in->names, 'c', 'c'); apop_data *cov = apop_data_add_page(out, apop_data_covariance(in), "<Covariance>"); gsl_matrix_scale(cov->matrix, 1/sqrt(maxsize)); return out; }
static long double wishart_ll(apop_data *in, apop_model *m){ Nullcheck_mpd(in, m, GSL_NAN); wishartstruct_t ws = { .paraminv = apop_matrix_inverse(m->parameters->matrix), .len = sqrt(in->matrix->size2), .df = m->parameters->vector->data[0] }; double paramdet = apop_matrix_determinant(m->parameters->matrix); if (paramdet < 1e-3) return GSL_NEGINF; double ll = apop_map_sum(in, .fn_vp = one_wishart_row, .param=&ws, .part='r'); double k = log(ws.df)*ws.df/2.; k -= M_LN2 * ws.len* ws.df/2.; k -= log(paramdet) * ws.df/2.; k -= apop_multivariate_lngamma(ws.df/2., ws.len); return ll + k*in->matrix->size1; } static int apop_wishart_draw(double *out, gsl_rng *r, apop_model *m){ /* Translated from the Fortran by BK. Fortran comments: C SUBROUTINE DWSHRT(D, N, NP, NNP, SB, SA) C C ALGORITHM AS 53 APPL. STATIST. (1972) VOL.21, NO.3 C C Wishart variate generator. On output, SA is an upper-triangular C matrix of size NP * NP [...] C whose elements have a Wishart(N, SIGMA) distribution. */ Nullcheck_mp(m, ); int np = m->parameters->matrix->size1; int n = m->parameters->vector->data[0]; if (!m->more) { gsl_matrix *ccc = apop_matrix_copy(m->parameters->matrix); gsl_linalg_cholesky_decomp(ccc); for (int i=0; i < ccc->size1; i++) //zero out the upper diagonal for (int j=i+1; j < ccc->size2; j++) gsl_matrix_set(ccc, i, j, 0); m->more = apop_matrix_to_data(ccc); m->more_size = sizeof(apop_data); } apop_data *Chol = m->more; apop_data *rmatrix = apop_data_calloc(np, np); Staticdef(apop_model *, std_normal, apop_model_set_parameters(apop_normal, 0, 1)); //C Load diagonal elements with square root of chi-square variates for(int i = 0; i< np; i++){ int DF = n - i; apop_data_set(rmatrix, i, i, sqrt(gsl_ran_chisq(r, DF))); } for(int i = 1; i< np; i++) //off-diagonal triangles: Normals. for(int j = 0; j< i; j++){ double ndraw; apop_draw(&ndraw, r, std_normal); assert (!gsl_isnan(ndraw)); apop_data_set(rmatrix, i, j, ndraw); } //Now find C * rand * rand' * C' apop_data *cr = apop_dot(Chol, rmatrix); apop_data *crr = apop_dot(cr, rmatrix, .form2='t'); apop_data *crrc = apop_dot(crr, Chol, .form2='t'); memmove(out, crrc->matrix->data, sizeof(double)*np*np); apop_data_free(rmatrix); apop_data_free(cr); apop_data_free(crrc); apop_data_free(crr); return 0; }