apop_model* apop_fdist_estimate(apop_data *d, apop_model *m){
Apop_assert(d, "No data with which to count df. (the default estimation method)");
apop_name_add(m->parameters->names, "df", 'r');
apop_name_add(m->parameters->names, "df2", 'r');
apop_data_set(m->parameters, 0, -1, d->vector->size -1);
apop_data_set(m->parameters, 1, -1, d->matrix->size1 * d->matrix->size2 -1);
apop_data_add_named_elmt(m->info, "log likelihood", apop_f_distribution.log_likelihood(d, m));
return m;
}
int main(){
apop_data *d = apop_data_falloc((8,3),
1, 0, 0,
.8, .1, 0,
.9, 0, .1,
12, 4, 1,
0, 1, 0,
1, 2, 2,
2, 1, 2,
2, 2, 1);
apop_name_add(d->names, "first", 'c');
apop_name_add(d->names, "second", 'c');
apop_name_add(d->names, "third", 'c');
apop_plot_triangle(d, "out.gnup");
}
/** Append one list of names to another.
If the first list is empty, then this is a copy function.
\param n1 The first set of names (no default, must not be \c NULL)
\param nadd The second set of names, which will be appended after the first. (no default. If \c NULL, a no-op.)
\param type1 Either 'c', 'r', 't', or 'v' stating whether you are merging the
columns, rows, text, or vector. If 'v', then ignore \c typeadd and just overwrite the
target vector name with the source name. (default: 'r')
\param typeadd Either 'c', 'r', 't', or 'v' stating whether you are merging the columns, rows, or text. If 'v', then overwrite the target with the source vector name. (default: type1)
*/
APOP_VAR_HEAD void apop_name_stack(apop_name * n1, apop_name *nadd, char type1, char typeadd){
apop_name * apop_varad_var(nadd, NULL);
if (!nadd) return;
apop_name * apop_varad_var(n1, NULL);
Apop_stopif(!n1, return, 0, "Can't stack onto a NULL set of names (which n1 is).");
char apop_varad_var(type1, 'r');
char apop_varad_var(typeadd, type1);
APOP_VAR_ENDHEAD
int i;
apop_name counts = (apop_name){.rowct=nadd->rowct, .textct = nadd->textct, .colct = nadd->colct};//Necessary when stacking onto self.;
if (typeadd == 'v')
apop_name_add(n1, nadd->vector, 'v');
else if (typeadd == 'r')
for (i=0; i< counts.rowct; i++)
apop_name_add(n1, nadd->row[i], type1);
else if (typeadd == 't')
for (i=0; i< counts.textct; i++)
apop_name_add(n1, nadd->text[i], type1);
else if (typeadd == 'c')
for (i=0; i< counts.colct; i++)
apop_name_add(n1, nadd->col[i], type1);
else Apop_notify(1, "'%c' sent to apop_name_stack, but the only "
"valid options are r t c v. Doing nothing.", typeadd);
}
/** Copy one \ref apop_name structure to another. That is, all data is duplicated.
Used internally by \ref apop_data_copy, but sometimes useful by itself. For example,
say that we have an \ref apop_data struct named \c d and a \ref gsl_matrix of the same
dimensions named \c m; we could give \c m the labels from \c d for printing:
\code
apop_data *wrapped = &(apop_data){.matrix=m, .names=apop_name_copy(d)};
apop_data_print(wrapped);
apop_name_free(wrapped->names); //wrapped itself is auto-allocated; do not free.
\endcode
\param in The input names
\return A \ref apop_name struct with copies of all input names.
*/
apop_name * apop_name_copy(apop_name *in){
apop_name *out = apop_name_alloc();
apop_name_stack(out, in, 'v');
apop_name_stack(out, in, 'c');
apop_name_stack(out, in, 'r');
apop_name_stack(out, in, 't');
Asprintf(&out->title, "%s", in->title);
return out;
}
void FishModel::AddTiles(const FishHookTiles& f) {
size_t nrows = f.size();
size_t ncols = f.NumCovariates();
// one for data, one for intercept
mat = apop_data_alloc(0, nrows, (int)ncols+2); //vec, nrow, ncol
// add the observed counts
size_t i = 0; // row id (tile)
for (i = 0; i < nrows; ++i) {
float scaled_events = f.at(i).events;
//scaled_events = f.at(i).covered > 0 ? scaled_events / f.at(i).covered : 0;
apop_data_set(mat, i, (int)(ncols+1), scaled_events, NULL, NULL, NULL);
}
// set the covariates
i = 0; // row id (tile)
int j = 1; // column id (covariate) (0 is obs counts)
for (const auto& r : f) { // loop the bins
if (i == nrows) break;//debug, to break early
j = 1;
for (const auto& c : r) { // loop the covariates
apop_data_set(mat, i, j++, c.second, NULL, NULL, NULL);
}
++i; // update row interator
}
// add the intercept term
for (i = 0; i < nrows; ++i)
apop_data_set(mat, i, 0, 1.0, NULL, NULL, NULL);
// add column names
apop_name_add(mat->names, "events", 'c');
for (const auto& c : f[0])
apop_name_add(mat->names, c.first.c_str(), 'c');
apop_name_add(mat->names, "intercept", 'c');
// add row names
std::stringstream ss;
for (const auto& r : f) {
ss << r.ChrName(SeqLib::BamHeader()) << ":" << r.pos1 << "-" << r.pos2;
apop_name_add(mat->names, ss.str().c_str(), 'r');
ss.str(std::string());
}
}
static void * process_result_set_data (MYSQL *conn, MYSQL_RES *res_set) {
MYSQL_ROW row;
unsigned int j=0;
unsigned int num_fields = mysql_num_fields(res_set);
apop_data *out =apop_data_alloc(0, mysql_num_rows (res_set), num_fields);
while ((row = mysql_fetch_row (res_set)) ) {
for (size_t i = 0; i < mysql_num_fields (res_set); i++)
apop_data_set(out, j , i, atof(row[i]));
j++;
}
MYSQL_FIELD *fields = mysql_fetch_fields(res_set);
for(size_t i = 0; i < num_fields; i++)
apop_name_add(out->names, fields[i].name, 'c');
check_and_clean(apop_data_free(out))
}
apop_data *apop_data_from_frame(SEXP in){
apop_data *out;
if (TYPEOF(in)==NILSXP) return NULL;
PROTECT(in);
assert(TYPEOF(in)==VECSXP); //I should write a check for this on the R side.
int total_cols=LENGTH(in);
int total_rows=LENGTH(VECTOR_ELT(in,0));
int char_cols = 0;
for (int i=0; i< total_cols; i++){
SEXP this_col = VECTOR_ELT(in, i);
char_cols += (TYPEOF(this_col)==STRSXP);
}
SEXP rl, cl;
//const char *rn, *cn;
//GetMatrixDimnames(in, &rl, &cl, &rn, &cn);
PROTECT(cl = getAttrib(in, R_NamesSymbol));
PROTECT(rl = getAttrib(in, R_RowNamesSymbol));
int current_numeric_col=0, current_text_col=0, found_vector=0;
if(cl !=R_NilValue && TYPEOF(cl)==STRSXP) //just check for now.
for (int ndx=0; ndx < LENGTH(cl) && !found_vector; ndx++)
if (!strcmp(translateChar(STRING_ELT(cl, ndx)), "Vector")) found_vector++;
int matrix_cols= total_cols-char_cols-found_vector;
out= apop_data_alloc((found_vector?total_rows:0), (matrix_cols?total_rows:0), matrix_cols);
if (char_cols) out=apop_text_alloc(out, total_rows, char_cols);
if(rl !=R_NilValue)
for (int ndx=0; ndx < LENGTH(rl); ndx++)
if (TYPEOF(rl)==STRSXP)
apop_name_add(out->names, translateChar(STRING_ELT(rl, ndx)), 'r');
else //let us guess that it's a numeric list and hope the R Project one day documents this stuff.
{char *ss; asprintf(&ss, "%i", ndx); apop_name_add(out->names, ss, 'r'); free(ss);}
for (int i=0; i< total_cols; i++){
const char *colname = NULL;
if(cl !=R_NilValue)
colname = translateChar(STRING_ELT(cl, i));
SEXP this_col = VECTOR_ELT(in, i);
if (TYPEOF(this_col) == STRSXP){
//could this be via aliases instead of copying?
//printf("col %i is chars\n", i);
if(colname) apop_name_add(out->names, colname, 't');
for (int j=0; j< total_rows; j++)
apop_text_add(out, j, current_text_col,
(STRING_ELT(this_col,j)==NA_STRING ? apop_opts.nan_string : translateChar(STRING_ELT(this_col, j))));
current_text_col++;
continue;
} else { //plain old matrix data.
int col_in_question = current_numeric_col;
if (colname && !strcmp(colname, "Vector")) {
out->vector = gsl_vector_alloc(total_rows);
col_in_question = -1;
} else {current_numeric_col++;}
Apop_col_v(out, col_in_question, onecol);
if (TYPEOF(this_col) == INTSXP){
//printf("col %i is ints\n", i);
int *vals = INTEGER(this_col);
for (int j=0; j< onecol->size; j++){
//printf("%i\n",vals[j]);
gsl_vector_set(onecol, j, (vals[j]==NA_INTEGER ? GSL_NAN : vals[j]));
}
} else {
double *vals = REAL(this_col);
for (int j=0; j< onecol->size; j++)
gsl_vector_set(onecol, j, (ISNAN(vals[j])||ISNA(vals[j]) ? GSL_NAN : vals[j]));
}
if(colname && col_in_question > -1) apop_name_add(out->names, colname, 'c');
else apop_name_add(out->names, colname, 'v'); //which is "vector".
}
//Factors
SEXP ls = getAttrib(this_col, R_LevelsSymbol);
if (ls){
apop_data *end;//find last page for adding factors.
for(end=out; end->more!=NULL; end=end->more);
end->more = get_factors(ls, colname);
}
}
UNPROTECT(3);
return out;
}
