static long double multinomial_log_likelihood(apop_data *d, apop_model *params){
Nullcheck_mpd(d, params, GSL_NAN);
double *pv = params->parameters->vector->data;
double n = pv[0];
Apop_assert_c(params->parameters->vector->size>=2, GSL_NAN, 0, "I need two or more input parameters "
"representing [n, p_1, (...)].");
Apop_assert_c(pv[1] <=1, GSL_NAN, 1, "The input parameters should be [n, p_1, (...)], but "
"element 1 of the parameter vector is >1."); //mostly makes sense for the binomial.
if (n==2) return apop_map_sum(d, .fn_vp=binomial_ll, .param=params->parameters->vector);
pv[0] = 1 - (apop_sum(params->parameters->vector)-n);//making the params a p-vector. Put n back at the end.
double out = apop_map_sum(d, .fn_vp=multinomial_ll, .param=params);
pv[0]=n;
return out;
}
/** Calculate \f$\sum_{n=1}^N {1\over n^s}\f$
\li There are no doubt efficient shortcuts do doing this, but I use brute force. [Though Knuth's Art of Programming v1 doesn't offer anything, which is strong indication of nonexistence.] To speed things along, I save the results so that they can just be looked up should you request the same calculation.
\li If \c N is zero or negative, return NaN. Notify the user if <tt>apop_opts.verbosity >=1</tt>
For example:
\include test_harmonic.c
*/
double apop_generalized_harmonic(int N, double s){
/*
Each row in the saved-results structure is an \f$s\f$, and each column is \f$1\dots n\f$, up to the largest \f$n\f$ calculated to date.
When reading the code, remember that the zeroth element holds the value for N=1, and so on.
*/
Apop_assert_c(N>0, GSL_NAN, 1, "N is %i, but most be greater than 0.", N);
static double * eses = NULL;
static int * lengths= NULL;
static int count = 0;
static double ** precalced=NULL;
int j, old_len, i;
for (i=0; i< count; i++)
if (eses == NULL || eses[i] == s)
break;
if (i == count){ //you need to build the vector from scratch.
count ++;
i = count - 1;
precalced = realloc(precalced, sizeof (double*) * count);
lengths = realloc(lengths, sizeof (int*) * count);
eses = realloc(eses, sizeof (double) * count);
precalced[i] = malloc(sizeof(double) * N);
lengths[i] = N;
eses[i] = s;
precalced[i][0] = 1;
old_len = 1;
}
else { //then you found it.
old_len = lengths[i];
}
if (N-1 >= old_len){ //It's there, but you need to extend what you have.
precalced[i] = realloc(precalced[i], sizeof(double) * N);
for (j=old_len; j<N; j++)
precalced[i][j] = precalced[i][j-1] + 1/pow((j+1),s);
}
return precalced[i][N-1];
}
/** Create a histogram from data by putting data into bins of fixed width.
\param indata The input data that will be binned. This is copied and the copy will be modified.
\param close_top_bin Normally, a bin covers the range from the point equal to its minimum to points strictly less than
the minimum plus the width. if \c 'y', then the top bin includes points less than or equal to the upper bound. This solves the problem of displaying histograms where the top bin is just one point.
\param binspec This is an \ref apop_data set with the same number of columns as \c indata.
If you want a fixed size for the bins, then the first row of the bin spec is the bin width for each column.
This allows you to specify a width for each dimension, or specify the same size for all with something like:
\param bin_count If you don't provide a bin spec, I'll provide this many evenly-sized bins. Default: \f$\sqrt(N)\f$. \code
Apop_data_row(indata, 0, firstrow);
apop_data *binspec = apop_data_copy(firstrow);
gsl_matrix_set_all(binspec->matrix, 10); //bins of size 10 for all dim.s
apop_data_to_bins(indata, binspec);
\endcode
The presumption is that the first bin starts at zero in all cases. You can add a second row to the spec to give the offset for each dimension. Default: NULL. if no binspec and no binlist, then a grid with offset equal to the min of the column, and bin size such that it takes \f$\sqrt{N}\f$ bins to cover the range to the max element.
\return A pointer to a binned \ref apop_data set. If you didn't give me a binspec, then I attach one to the output set as a page named \c \<binspec\>, so you can snap a second data set to the same grid using
\code
apop_data_to_bins(first_set, NULL);
apop_data_to_bins(second_set, apop_data_get_page(first_set, "<binspec>"));
\endcode
The text segment, if any, is not binned. I use \ref apop_data_pmf_compress as the final step in the binning,
and that does respect the text segment.
Here is a sample program highlighting the difference between \ref apop_data_to_bins and \ref apop_data_pmf_compress .
\include binning.c
*/
APOP_VAR_HEAD apop_data *apop_data_to_bins(apop_data *indata, apop_data *binspec, int bin_count, char close_top_bin){
apop_data *apop_varad_var(indata, NULL);
Apop_assert_c(indata, NULL, 1, "NULL input data set, so returning NULL output data set.");
apop_data *apop_varad_var(binspec, NULL);
char apop_varad_var(close_top_bin, 'n');
int apop_varad_var(bin_count, 0);
APOP_VAR_ENDHEAD
Get_vmsizes(indata); //firstcol, vsize, msize1, msize2
double binwidth, offset, max=0;
apop_data *out = apop_data_copy(indata);
apop_data *bs = binspec ? binspec
: apop_data_add_page(out,
apop_data_alloc(vsize? 2: 0, msize1? 2: 0, indata->matrix ? msize2: 0),
"<binspec>");
for (int j= firstcol; j< msize2; j++){
Apop_col(out, j, onecol);
if (binspec){
binwidth = apop_data_get(binspec, 0, j);
offset = ((binspec->vector && binspec->vector->size==2 )
||(binspec->matrix && binspec->matrix->size1==2)) ? apop_data_get(binspec, 1, j) : 0;
} else {
Apop_col(bs, j, abin);
max = gsl_vector_max(onecol);
offset = abin->data[1] = gsl_vector_min(onecol);
binwidth = abin->data[0] = (max - offset)/(bin_count ? bin_count : sqrt(onecol->size));
}
for (int i=0; i< onecol->size; i++){
double val = gsl_vector_get(onecol, i);
if (close_top_bin=='y' && val == max && val!=offset)
val -= 2*GSL_DBL_EPSILON;
gsl_vector_set(onecol, i, (floor((val -offset)/binwidth))*binwidth+offset);
}
}
apop_data_pmf_compress(out);
return out;
}
apop_data* multiple_imputation_variance_base(multiple_imputation_variance_t in){
/*The first half of this is filling in the values. In an attempt at versatility, I allow users to
give any named column, be it numeric or text, for every piece of input info. That means a whole lot
of checking around to determine what goes where---and a macro. */
Apop_assert_c(in.base_data,NULL, 1, "It doesn't make sense to impute over a NULL data set.");
Apop_assert_c(in.fill_ins, NULL, 1, "Didn't receive a fill-in table. Returning NULL.");
data_to_data stat = in.stat? in.stat : colmeans;
//At the end of this macro, you've got rowcol and rowtype, valuecol and valuetype, &c.
#define apop_setup_one_colthing(c) \
int c##col = apop_name_find(in.fill_ins->names, in.c##_name, 'c'); \
int c##type = 'd'; \
if (c##col==-2){ \
c##col = apop_name_find(in.fill_ins->names, in.c##_name, 't'); \
c##type = 't'; \
Apop_assert(c##col!=-2, "I couldn't find the c##_name %s in the column/text names of your fill_in table.", in.c##_name); \
}
apop_setup_one_colthing(row)
apop_setup_one_colthing(col)
apop_setup_one_colthing(value)
apop_setup_one_colthing(imputation)
Apop_assert(!(rowtype=='t' && !in.base_data->names->rowct),
"the rowname you gave refers to text, so I will be searching for a row name in the base data."
" But the base_data set has no row names.");
Apop_assert(!(coltype=='t' && !in.base_data->names->colct),
"the colname you gave refers to text, so I will be searching for a column name in the base data."
" But the base_data set has no column names.");
//get a list of unique imputation markers.
gsl_vector *imps = NULL;
apop_data *impt = NULL;
if (imputationtype == 'd'){
Apop_col_v(in.fill_ins, imputationcol, ic);
imps = apop_vector_unique_elements(ic);
} else impt = apop_text_unique_elements(in.fill_ins, imputationcol);
int len = imps ? imps->size : impt->textsize[0];
int thisimp=-2; char *thisimpt=NULL;
apop_data *estimates[len];
for (int impctr=0; impctr< len; impctr++){
if (imps) thisimp = gsl_vector_get(imps, impctr);
else thisimpt = impt->text[impctr][0];
Get_vmsizes(in.fill_ins); //masxize
int fillsize = maxsize ? maxsize : in.fill_ins->textsize[0];
for (int i=0; i< fillsize; i++){
if (!(thisimpt && apop_strcmp(in.fill_ins->text[i][imputationcol], thisimpt))
&& !(imps && thisimp==apop_data_get(in.fill_ins, i, imputationcol)))
continue;
int thisrow = (rowtype=='d') ?
apop_data_get(in.fill_ins, i, rowcol)
:apop_name_find(in.base_data->names, in.fill_ins->text[i][rowcol], 'r');
int thiscol = (coltype=='d') ?
apop_data_get(in.fill_ins, i, colcol)
:apop_name_find(in.base_data->names, in.fill_ins->text[i][colcol], 'c');
if (valuetype=='d') apop_data_set(in.base_data, thisrow, thiscol,
apop_data_get(in.fill_ins, i, valuecol));
else apop_text_add(in.base_data, rowcol, colcol, in.fill_ins->text[i][valuecol]);
}
//OK, base_data is now filled in. Estimate the statistic for it.
estimates[impctr] = stat(in.base_data);
}
//Part II: find the mean of the statistics and the total variance of the cov matrix.
gsl_vector *vals = gsl_vector_alloc(len);
apop_data *out = apop_data_copy(estimates[0]);
//take the simple mean of the main data set.
{ //this limits the scope of the Get_vmsizes macro.
Get_vmsizes(estimates[0]);
for (int j=0; j < msize2; j++)
for (int i=0; i < (vsize ? vsize : msize1); i++){
for (int k=0; k< len; k++)
gsl_vector_set(vals, k, apop_data_get(estimates[k], i, j));
apop_data_set(out, i, j, apop_vector_mean(vals));
}
}
apop_data *out_var = apop_data_get_page(estimates[0], "<Covariance>");
int cov_is_labelled = out_var !=NULL;
if (!cov_is_labelled){
asprintf(&out->more->names->title, "<Covariance>");
out_var = estimates[0]->more;
}
Get_vmsizes(out_var);
for (int i=0; i < msize1; i++)
for (int j=i; j < msize2; j++){
for (int k=0; k< len; k++){
apop_data *this_p = cov_is_labelled ? apop_data_get_page(estimates[k], "<Covariance>")
: estimates[k]->more;
gsl_vector_set(vals, k, apop_data_get(this_p, i, j));
}
double total_var = apop_vector_mean(vals) + apop_var(vals)/(1+1./len);
apop_data_set(out_var, i, j, total_var);
if (j != i)
apop_data_set(out_var, j, i, total_var);
}
return out;
}
