apop_data *make_histo(char const *zila, int year) { apop_data *d = apop_data_calloc(65,1); for (int i=0; i< 64; i++) { char *col; asprintf(&col, "year_%i_num_intensity_%i", year, i); double val=apop_query_to_float("select %s from ppl where " "ADMName='%s'", col, zila); Apop_stopif(isnan(val), continue, 0, "couldn't find %s for %s", col, zila); apop_data_set(d, i+1, 0, val); free(col); } return d; }
static long double multinomial_constraint(apop_data *data, apop_model *b){ //constraint is that 0 < all elmts, and 1>all ps. int size = b->parameters->vector->size; static threadlocal apop_data *constr; if (constr && constr->matrix->size2 != size) apop_data_free(constr); if (!constr){ constr = apop_data_calloc(size*2-1, size*2-1, size); //top half: 0 < [param], including param 0 gsl_matrix_set_identity(Apop_subm(constr->matrix, 0, 0, size, size)); //bottom (almost) half: 1 >= [param], excluding param 0 for (int i=size; i < size*2-1; i++){ apop_data_set(constr, i, -1, -1); apop_data_set(constr, i, i-size+1, -1); } } return apop_linear_constraint(b->parameters->vector, constr); }
*/ void apop_estimate_parameter_tests (apop_model *est){ Nullcheck_p(est, ) if (!est->data) return; apop_data *ep = apop_data_add_page(est->info, apop_data_alloc(est->parameters->vector->size, 2), "<test info>"); apop_name_add(ep->names, "p value", 'c'); apop_name_add(ep->names, "confidence", 'c'); apop_name_stack(ep->names, est->parameters->names, 'r', 'r'); Get_vmsizes(est->data); //msize1, vsize int df = msize1 ? msize1 : vsize; df -= est->parameters->vector->size; df = df < 1 ? 1 : df; //some models aren't data-oriented. apop_data_add_named_elmt(est->info, "df", df); apop_data *one_elmt = apop_data_calloc(1, 1); gsl_vector *param_v = apop_data_pack(est->parameters); for (size_t i=0; i< est->parameters->vector->size; i++){ Apop_settings_add_group(est, apop_pm, .index=i); apop_model *m = apop_parameter_model(est->data, est); double zero = apop_cdf(one_elmt, m); apop_model_free(m); double conf = 2*fabs(0.5-zero); //parameter is always at 0.5 along a symmetric CDF apop_data_set(ep, i, .colname="confidence", .val=conf); apop_data_set(ep, i, .colname="p value", .val=1-conf); } gsl_vector_free(param_v); apop_data_free(one_elmt); }
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; }