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