CuFile *pp_create_file(const char *controlpath){
CuFile *file;
PPfile *ppfile;
/* get file structure */
file = CuCreateFile(CuPP);
if (file == (CuFile*)0) goto err1;
/* allocate internal structure - hang it off cu_file structure */
ppfile=pp_malloc(sizeof(PPfile), NULL);
if (ppfile==NULL) goto err2;
file->internp = ppfile;
ppfile->fh = NULL;
strncpy(file->controlpath, controlpath, CU_MAX_PATH);
ppfile->landmask = NULL;
ppfile->store_raw_headers = 0;
ppfile->basetime = 0;
/* initialise heap list */
ppfile->heaplist = pp_list_new(NULL);
if (ppfile->heaplist == NULL) goto err3;
return file;
err3:
pp_free(ppfile,NULL);
err2:
CuDeleteFile(file->id);
err1:
pp_error("pp_create_file");
return NULL;
}
void
GalliumContext::DestroyContext(context_id contextID)
{
// fMutex should be locked *before* calling DestoryContext
// See if context is used
if (!fContext[contextID])
return;
if (fContext[contextID]->st) {
fContext[contextID]->st->flush(fContext[contextID]->st, 0, NULL);
fContext[contextID]->st->destroy(fContext[contextID]->st);
}
if (fContext[contextID]->postProcess)
pp_free(fContext[contextID]->postProcess);
// Delete state tracker framebuffer objects
if (fContext[contextID]->read)
delete fContext[contextID]->read;
if (fContext[contextID]->draw)
delete fContext[contextID]->draw;
if (fContext[contextID]->stVisual)
hgl_destroy_st_visual(fContext[contextID]->stVisual);
if (fContext[contextID]->manager)
hgl_destroy_st_manager(fContext[contextID]->manager);
FREE(fContext[contextID]);
}
int pp_delete_file(CuFile *file){
PPfile *ppfile = file->internp;
int iatt,ivar;
CuVar *var;
/* Free the extra bits which cdunifpp allocated */
pp_free_all(ppfile->heaplist);
pp_free(ppfile,NULL);
/* Now set all the attribute value ptrs to NULL.
*
* Reason: CuDeleteAtt (called by CuDeleteFile)
* will assume that any non-NULL ptrs have to be freed.
* But we already freed them. Hence segfault. :-(
*/
if (file->atts != NULL)
for (iatt=0; iatt<file->ngatts; iatt++)
file->atts[iatt].val=NULL;
if (file->vars != NULL)
for (ivar=0; ivar<file->nvars; ivar++) {
var=&file->vars[ivar];
if (var->atts != NULL)
for (iatt=0; iatt<var->natts; iatt++)
var->atts[iatt].val=NULL;
}
/* CuDeleteFile commented out - CDMS seems to do that when calling cuclose
* and error if we do it twice.
*/
/* CuDeleteFile(file->id); */
return 0;
}
/**
* Destroy an Off-Screen Mesa rendering context.
*
* \param osmesa the context to destroy
*/
GLAPI void GLAPIENTRY
OSMesaDestroyContext(OSMesaContext osmesa)
{
if (osmesa) {
pp_free(osmesa->pp);
osmesa->stctx->destroy(osmesa->stctx);
FREE(osmesa);
}
}
void teardown_pp(void) {
int i;
pp_pp* pp;
ZCLEAR(&z_no_previous, "z_no_previous");
/* pp->wrh is not a clone (needing free()) iff pp is in pplist */
for (i = 0; i < pplistsize; ++i)
pplist[i]->wrh = (wrhp)0;
for (i = 0; i <= k0; ++i)
if (pppp[i].pp)
pp_free(&pppp[i]);
free(pplist);
free(pppp);
teardown_walker();
teardown_inverse();
}
void
dri_destroy_context(__DRIcontext * cPriv)
{
struct dri_context *ctx = dri_context(cPriv);
if (ctx->hud) {
hud_destroy(ctx->hud);
}
/* No particular reason to wait for command completion before
* destroying a context, but we flush the context here
* to avoid having to add code elsewhere to cope with flushing a
* partially destroyed context.
*/
ctx->st->flush(ctx->st, 0, NULL);
ctx->st->destroy(ctx->st);
if (ctx->pp)
pp_free(ctx->pp);
free(ctx);
}
void
dri_destroy_context(__DRIcontext * cPriv)
{
struct dri_context *ctx = dri_context(cPriv);
/* note: we are freeing values and nothing more because
* driParseConfigFiles allocated values only - the rest
* is owned by screen optionCache.
*/
FREE(ctx->optionCache.values);
/* No particular reason to wait for command completion before
* destroying a context, but we flush the context here
* to avoid having to add code elsewhere to cope with flushing a
* partially destroyed context.
*/
ctx->st->flush(ctx->st, 0, NULL);
ctx->st->destroy(ctx->st);
if (ctx->pp) pp_free(ctx->pp);
FREE(ctx);
}
int pp_calc_rot_grid(PProtgrid *rotgrid, PPdata **lons_return, PPdata **lats_return, PPlist *heaplist)
{
int nx, ny, i, j;
int offset, offset1;
PPgenaxis *xaxis;
PPgenaxis *yaxis;
PPdata *londata, *latdata, *rlondata, *rlatdata;
Freal *lons, *lats, *rlons, *rlats; /* "r" stands for rotated */
double latpole_rad, coslatpole, sinlatpole, cosrlat, sinrlat;
double *cosdrlon, *sindrlon;
double rlonN, lonpole, drlon_rad, dlon_rad, rlat_rad, lon;
double cycdx, sinlat;
const double dtor = M_PI / 180.;
CKP(rotgrid);
xaxis = rotgrid->xaxis;
yaxis = rotgrid->yaxis;
nx = pp_genaxis_len(xaxis);
ny = pp_genaxis_len(yaxis);
/* get input, output and workspace arrays */
CKP( rlondata = pp_genaxis_to_values(xaxis,0,heaplist) );
ERRIF(rlondata->type != realtype);
CKP( rlatdata = pp_genaxis_to_values(yaxis,0,heaplist) );
ERRIF(rlatdata->type != realtype);
CKP( londata = pp_data_new(realtype,nx*ny,heaplist) );
CKP( latdata = pp_data_new(realtype,nx*ny,heaplist) );
CKP( cosdrlon = pp_malloc(nx*sizeof(double),heaplist) );
CKP( sindrlon = pp_malloc(nx*sizeof(double),heaplist) );
/* some pointers for convenience (and speed?) */
rlons = (Freal*) rlondata->values;
rlats = (Freal*) rlatdata->values;
lons = londata->values;
lats = latdata->values;
latpole_rad = rotgrid->rotmap->pole_lat * dtor;
coslatpole = cos(latpole_rad);
sinlatpole = sin(latpole_rad);
rlonN = rotgrid->rotmap->truepole_gridlon;
lonpole = rotgrid->rotmap->pole_lon;
for (i=0; i<nx; i++) {
drlon_rad = (rlons[i] - rlonN) * dtor;
cosdrlon[i] = cos(drlon_rad);
sindrlon[i] = sin(drlon_rad);
}
for (j=0; j<ny; j++) {
rlat_rad = rlats[j] * dtor;
cosrlat = cos(rlat_rad);
sinrlat = sin(rlat_rad);
offset1 = j*nx;
for (i=0; i<nx; i++) {
offset = offset1 + i;
cycdx = cosrlat * cosdrlon[i];
dlon_rad = atan2( -cosrlat*sindrlon[i], sinrlat*coslatpole - cycdx*sinlatpole );
lon = (dlon_rad/dtor + lonpole);
/* put in range 0 <= lon < 360
* NOTE: This code previously put in range -180 to 180.
* The actual code was the following:
* lon -= lon_modulo * floor(lon / lon_modulo + 0.5);
* This was changed because the subsetting functions in CDAT
* didn't like the negative longitudes.
*/
lon -= lon_modulo * floor(lon / lon_modulo);
sinlat = cycdx * coslatpole + sinrlat * sinlatpole;
if (sinlat > 1.)
sinlat = 1.;
else if (sinlat < -1.)
sinlat = -1.;
lons[offset] = lon;
lats[offset] = asin(sinlat) / dtor;
}
}
/* free workspace arrays */
CKI( pp_free(rlondata, heaplist) );
CKI( pp_free(rlatdata, heaplist) );
CKI( pp_free(cosdrlon, heaplist) );
CKI( pp_free(sindrlon, heaplist) );
/* return pointers */
if (lons_return != NULL)
*lons_return = londata;
if (lats_return != NULL)
*lats_return = latdata;
return 0;
ERRBLKI("pp_calc_rot_grid");
}
int pp_read_all_headers(CuFile *file)
{
FILE *fh;
int rec, nrec, recsize, filerec, nlrec;
void *hdr;
PPfile *ppfile;
PPrec **recs,*recp;
PPlist *heaplist;
Fint start_lookup, nlookup1, nlookup2, lbbegin, dataset_type, start_data;
size_t hdr_start, hdr_size, lbbegin_offset, datapos;
int *valid;
PPhdr *hdrp;
int fieldsfile;
ppfile=file->internp;
fh=ppfile->fh;
heaplist=ppfile->heaplist;
switch(ppfile->type) {
case pp_type:
fseek(fh,0,SEEK_SET);
/* count the PP records in the file */
for (nrec=0; (recsize=pp_skip_fortran_record(ppfile)) != -1; nrec++) {
ERRIF(recsize==-2);
if (recsize != n_hdr * ppfile->wordsize) {
CuError(CU_EOPEN,"Opening PP file %s: unsupported header length: %d words",
file->controlpath, recsize / ppfile->wordsize);
ERR;
}
ERRIF( pp_skip_fortran_record(ppfile) <0); /* skip the data record */
}
/* now rewind, and read in all the PP header data */
fseek(fh,0,SEEK_SET);
ppfile->nrec=nrec;
CKP( recs=pp_malloc(nrec*sizeof(PPrec*),heaplist) );
ppfile->recs = recs;
for (rec=0; rec<nrec; rec++){
/* fill in the record information - for each record, read the header
* record into heap memory, copy out of it the elements we want to store
* then free the heap memory.
*/
/* just skip the fortran integers - we've already tested header length */
CKI( pp_skip_word(ppfile) );
CKP( hdr=pp_read_header(ppfile,heaplist) );
CKI( pp_skip_word(ppfile) );
CKP( recp=pp_malloc(sizeof(PPrec),heaplist) );
recs[rec]=recp;
hdrp=&recp->hdr;
pp_store_header(hdrp, hdr);
if (ppfile->store_raw_headers) {
CKI( pp_store_raw_header(hdrp, hdr, heaplist) );
}
else {
hdrp->rawhdr = NULL;
}
recp->recno = rec;
/* skip data record but store length */
recp->datapos = ftell(fh) + ppfile->wordsize;
recp->disklen = pp_skip_fortran_record(ppfile) / ppfile->wordsize;
/* work out datalen */
pp_evaluate_lengths(hdrp, ppfile, &recp->datalen, NULL);
CKI( pp_free(hdr,heaplist) );
}
break;
case um_type:
/* pick out certain information from the fixed length header */
CKI( fseek(fh,4*ppfile->wordsize,SEEK_SET) );
ERRIF( pp_read_words(&dataset_type, 1, convert_int, ppfile) !=1);
CKI( fseek(fh,149*ppfile->wordsize,SEEK_SET) );
ERRIF( pp_read_words(&start_lookup, 1, convert_int, ppfile) !=1);
ERRIF( pp_read_words(&nlookup1, 1, convert_int, ppfile) !=1);
ERRIF( pp_read_words(&nlookup2, 1, convert_int, ppfile) !=1);
CKI( fseek(fh,159*ppfile->wordsize,SEEK_SET) );
ERRIF( pp_read_words(&start_data, 1, convert_int, ppfile) !=1);
/* fieldsfiles includes ancillary files and initial dumps */
fieldsfile = (dataset_type == 1 || dataset_type == 3 || dataset_type == 4);
/* (first dim of lookup documented as being 64 or 128, so
* allow header longer than n_hdr (64) -- discarding excess -- but not shorter)
*/
if (nlookup1 < n_hdr) {
CuError(CU_EOPEN,"Opening UM file %s: unsupported header length: %d words",
file->controlpath, nlookup1);
ERR;
}
/* count the valid records in the file */
/* loop over all records and pick out the valid ones - test for LBBEGIN != -99 */
nrec=0;
hdr_start = (start_lookup - 1) * ppfile->wordsize;
hdr_size = nlookup1 * ppfile->wordsize;
lbbegin_offset = 28 * ppfile->wordsize;
CKP( valid = pp_malloc(nlookup2 * sizeof(int),heaplist) );
for (filerec=0; filerec<nlookup2; filerec++) {
valid[filerec]=0;
CKI( fseek(fh, hdr_start + filerec * hdr_size + lbbegin_offset, SEEK_SET) );
ERRIF( pp_read_words(&lbbegin, 1, convert_int, ppfile) !=1);
if (lbbegin != -99) {
/* valid record */
valid[filerec]=1;
nrec++;
} else {
#ifdef BREAKATFIRSTINVALID
break;
#endif
valid[filerec]=0;
}
}
/* now read in all the PP header data */
ppfile->nrec=nrec;
CKP( recs=pp_malloc(nrec*sizeof(PPrec*),heaplist) );
ppfile->recs = recs;
rec=0; /* valid record number, as opposed to
* filerec which is total record number */
datapos = (start_data-1) * ppfile->wordsize;
#ifdef BREAKATFIRSTINVALID
nlrec=nrec;
#else
nlrec=nlookup2;
#endif
for (filerec=0; filerec<nlrec ; filerec++) {
if (valid[filerec]) {
/* seek to correct position, read in header into tmp dynamic array,
* store wanted elements in record structure, free tmp array
*/
CKI( fseek(fh, hdr_start + filerec*hdr_size, SEEK_SET) );
CKP( hdr=pp_read_header(ppfile,heaplist) );
CKP( recp=pp_malloc(sizeof(PPrec),heaplist) );
recs[rec]=recp;
hdrp=&recp->hdr;
pp_store_header(hdrp,hdr);
/* Set this for UM fieldsfile, else testing an uninitialised variable
in pp_var_get_extra_atts later. */
hdrp->rawhdr = NULL;
CKI( pp_free(hdr,heaplist) );
/* work out datalen and disklen */
pp_evaluate_lengths(hdrp, ppfile, &recp->datalen, &recp->disklen);
/* use LBBEGIN if it is set - this will not work if LBBEGIN refers to
* start record rather than start address
*/
if (hdrp->LBBEGIN != 0) {
/* Extra cast to uint handles files with LBBEGIN up to 2^32 */
recp->datapos=(size_t)((uint)hdrp->LBBEGIN)*ppfile->wordsize;
} else {
recp->datapos = datapos;
}
/* If LBNREC and LBBEGIN are both non-zero and it's not a FIELDSfile,
* the file has well-formed records. In that case,
* LBBEGIN should be correct, so do an assertion
*/
if (!fieldsfile && hdrp->LBNREC != 0 && hdrp->LBBEGIN != 0) {
if (recp->datapos != hdrp->LBBEGIN * ppfile->wordsize) {
CuError(CU_EOPEN,"start of data record mismatch: %d %d",
recp->datapos, hdrp->LBBEGIN * ppfile->wordsize);
ERR;
}
}
datapos += recp->disklen * ppfile->wordsize;
rec++;
}
}
CKI( pp_free(valid,heaplist) );
break;
default:
pp_switch_bug("pp_read_all_headers");
ERR;
}
return 0;
ERRBLKI("pp_read_all_headers");
}
int pp_process(CuFile *file)
{
int rec, nrec, at_start_rec, at_end_rec;
PPfile *ppfile;
PPfieldvar *fvar;
PPrec *recp;
PPhdr *hdrp;
PPgenaxis *xaxis, *yaxis, *zaxis, *taxis; /* JAK 2005-01-05 */
PPlist *heaplist;
PPlist *fieldvars;
PPlisthandle handle, thandle;
PPlist *gatts, *catts;
int ndims, dimid;
int idim; /* dim number of given type */
int have_time_mean, tmdimid; /* dimensions used for meaning (CF cell methods) */
CuDim *cudims,*dim;
PPdim *ppdim;
int nvars, varid, cvarid;
int ncvars; /* coord vars */
int nfvars; /* field vars */
int nvrec;
PPrec **recs, **vrecs;
CuVar *cuvars, *var;
PPvar *ppvar;
PPlist *atts;
PPlist *axislist;
PPlist *xaxes, *yaxes, *taxes, *zaxes; /* JAK 2005-01-05 */
PPgenaxis *axis; /*JAK 2005-01-10 */
int have_hybrid_sigmap;
PPaxistype axistype;
int rotmapid, rotgridid;
PPlist *rotgrids, *rotmaps;
PProtmap *rotmap;
PProtgrid *rotgrid;
CuVar *lonvar, *latvar;
PPvar *lonppvar, *latppvar;
PPlandmask *landmask;
char *varnamea, *varnameb;
char dimnamestem[CU_MAX_NAME], units[CU_MAX_NAME];
char formulaterms[MAX_ATT_LEN+1];
int dont_free_horiz_axes;
int added;
int zindex,tindex,svindex;
/* ------------------------------------------------------ */
/* initialisation constants which matter */
ncvars = 0;
have_hybrid_sigmap = 0;
have_time_mean = 0;
svindex = 1;
/* initialisation constants just to avoid compiler warnings
* (rather than get accustomed to ignoring warnings)
* but flow logic should mean that these vars do actually get
* initialised elsewhere before use
*/
at_end_rec=0;
xaxis=yaxis=NULL;
fvar=NULL;
zaxis=NULL;
taxis=NULL;
axislist=NULL;
tmdimid=-1;
dont_free_horiz_axes=0;
/* ------------------------------------------------------ */
ppfile = file->internp;
heaplist=ppfile->heaplist;
nrec = ppfile->nrec;
recs = ppfile->recs;
/* initialise elements in the records before sorting */
CKI( pp_initialise_records(recs, nrec, heaplist) );
/* sort the records */
qsort(recs, nrec, sizeof(PPrec*), pp_compare_records);
/* now sort out the list of variables and dimensions */
CKP( fieldvars=pp_list_new(heaplist) );
CKP( xaxes=pp_list_new(heaplist) );
CKP( yaxes=pp_list_new(heaplist) );
CKP( zaxes=pp_list_new(heaplist) );
CKP( taxes=pp_list_new(heaplist) );
CKP( rotmaps=pp_list_new(heaplist) );
CKP( rotgrids=pp_list_new(heaplist) );
/* before main loop over records, look for land mask */
for (rec=0; rec<nrec ; rec++) {
recp = recs[rec];
hdrp = &recp->hdr;
if (pp_var_is_land_mask(hdrp)) {
CKP( landmask = pp_malloc(sizeof(PPlandmask),heaplist) );
CKI( pp_set_horizontal_axes(recp,ppfile,&xaxis,&yaxis,rotmaps,heaplist) );
CKP( landmask->data = pp_data_new(inttype,pp_genaxis_len(xaxis) * pp_genaxis_len(yaxis),heaplist) ); /* JAK 2005-01-05 */
/* read in land mask data values */
landmask->xaxis = xaxis;
landmask->yaxis = yaxis;
CKP( landmask->data->values=pp_read_data_record(recp,ppfile,heaplist) );
ppfile->landmask = landmask;
}
}
/* ====== START LOOP OVER RECORDS ====== */
for (rec=0; rec<nrec ; rec++) {
recp = recs[rec];
hdrp = &recp->hdr;
/* we are at start record of a variable at the very start, or if at we were at the
* end record last time
*/
at_start_rec = ( rec == 0 || at_end_rec );
/* we are at end record of a variable at the very end, or if the header shows a
* difference from the next record which constitutes a different variable
*/
at_end_rec = ( rec == nrec-1 ||
pp_records_from_different_vars(recs[rec+1],recp));
/*------------------------------*/
/* allow for variables which are unsupported for some reason */
if (at_start_rec)
if (pp_test_skip_var(hdrp, ppfile->landmask))
continue;
/* -------
if (at_start_rec)
puts("++++++ START OF VARIABLE +++++++++");
printf("processing record %d / %d\n",rec,nrec);
pp_dump_header(hdrp);
------ */
if (at_start_rec) {
/* ====== THINGS DONE ONLY AT START RECORD OF EACH VARIABLE ====== */
/* get PPvar structure, and initialise certain structure members for tidiness */
CKP( fvar=pp_malloc(sizeof(PPfieldvar), heaplist) );
CKP( fvar->axes=pp_list_new(heaplist) ); /* JAK 2005-01-05 */
fvar->firstrecno = rec;
fvar->firstrec = recp;
if (pp_get_var_compression(hdrp) == 2) {
/* land/sea mask compression: for horiz axes use those of LSM */
xaxis = ppfile->landmask->xaxis;
yaxis = ppfile->landmask->yaxis;
dont_free_horiz_axes = 1;
} else {
CKI( pp_set_horizontal_axes(recp,ppfile,&xaxis,&yaxis,rotmaps,heaplist) );
dont_free_horiz_axes = 0;
}
CKP( zaxis=pp_genaxis_new(zaxis_type,zdir,heaplist) );
CKI( pp_zaxis_set(zaxis,hdrp) );
CKP( taxis=pp_genaxis_new(taxis_type,tdir,heaplist) );
CKI( pp_taxis_set(taxis,hdrp) );
}
/* construct pp_lev struct, and add it to the z axis if not already present
* (could already be present if field has multiple times on each level)
*/
/* ====== THINGS DONE FOR EVERY PP RECORD ====== */
CKI( pp_zaxis_add(zaxis, recp->lev, &zindex, heaplist) );
recp->zindex = zindex;
CKI( pp_taxis_add(taxis, recp->time, &tindex, heaplist) );
recp->tindex = tindex;
/* ===================================================== */
if (at_end_rec) {
/* ====== THINGS DONE ONLY AT END RECORD OF EACH VARIABLE ====== */
fvar->lastrecno = rec;
nvrec = fvar->lastrecno - fvar->firstrecno + 1;
vrecs = recs + fvar->firstrecno;
/* now if the axes are not regular, free the axes, split the variable into a number of variables and try again... */
if (pp_set_disambig_index(zaxis, taxis, vrecs, nvrec, svindex)) {
/* increment the supervar index, used later to show the connection between
* the separate variables into which this one will be split
*/
svindex++;
/* now re-sort this part of the record list, now that we have set the disambig index */
qsort(vrecs, nvrec, sizeof(PPrec*), pp_compare_records);
/* now go back to the start record of the variable; set to one less because it
* will get incremented in the "for" loop reinitialisation
*/
rec = fvar->firstrecno - 1;
/* and free the stuff assoc with the var we won't be using */
if (!dont_free_horiz_axes) {
CKI( pp_genaxis_free(xaxis,heaplist) );
CKI( pp_genaxis_free(yaxis,heaplist) );
}
CKI( pp_genaxis_free(zaxis,heaplist) );
CKI( pp_genaxis_free(taxis,heaplist) );
CKI( pp_free(fvar,heaplist) );
continue;
}
/*------------------------------------------------------------*/
/*
* For each axis, see if it matches an axis which already exists from a previous
* variable.
*
* If so, then free the structure and point to the existing occurrence instead.
*
* If not, then add to the list.
*/
/* x */
CKI( added = pp_list_add_or_find(xaxes, &xaxis, pp_genaxis_compare, 0,
(dont_free_horiz_axes ? NULL : (free_func) pp_genaxis_free),
NULL, heaplist) );
if (added)
ncvars++;
/* y */
CKI( added = pp_list_add_or_find(yaxes, &yaxis, pp_genaxis_compare, 0,
(dont_free_horiz_axes ? NULL : (free_func) pp_genaxis_free),
NULL, heaplist) );
if (added)
ncvars++;
/* z */
CKI( added = pp_list_add_or_find(zaxes, &zaxis, pp_genaxis_compare, 0,
(free_func) pp_genaxis_free,
NULL, heaplist) );
if (added) {
ncvars++;
if (pp_zaxis_lev_type(zaxis) == hybrid_sigmap_lev_type) {
/* two more coord vars (a and b coeffs) */
ncvars+=2;
have_hybrid_sigmap=1;
}
if (pp_zaxis_lev_type(zaxis) == hybrid_height_lev_type) {
/* two more coord vars (a and b coeffs) */
ncvars+=2;
}
}
/* t */
CKI( added = pp_list_add_or_find(taxes, &taxis, pp_genaxis_compare, 0,
(free_func) pp_genaxis_free,
NULL, heaplist) );
if (added) {
ncvars++;
if (pp_taxis_is_time_mean(taxis)) {
/* need to make sure we have the mean dim (size 2),
* also one more coordinate var
*/
have_time_mean=1;
ncvars++;
}
}
/* associate var with these axes */
CKI( pp_list_add(fvar->axes,xaxis,heaplist) );
CKI( pp_list_add(fvar->axes,yaxis,heaplist) );
CKI( pp_list_add(fvar->axes,zaxis,heaplist) );
CKI( pp_list_add(fvar->axes,taxis,heaplist) );
/* get the rotated grid, if any
* (NB this is done *after* the pp_list_add_or_find stuff above, because
* otherwise the axis pointers could get orphaned if the axes are found to
* be duplicates)
*/
CKP( fvar->rotgrid = pp_get_rotgrid(xaxis,yaxis,rotgrids,heaplist) );
/* add the variable */
CKI( pp_list_add(fieldvars, fvar, heaplist) );
/* ===================================================== */
}
}
/* ====================================================================
* Having completed the loop over records, we now know the number of
* dimensions and variables, so we can finally do the relevant calls
* to allocate these arrays and populate them usefully.
* ====================================================================
*/
/* FIRST ALLOCATE THE ARRAYS, and initialise some values */
nfvars = pp_list_size(fieldvars);
if (nfvars <= 0) {
CuError(CU_EOPEN,"No valid fields in file\n");
ERR; /* not the most elegant dealing with this error - ideally would free this file */
}
ndims = pp_list_size(xaxes) + pp_list_size(yaxes) + pp_list_size(zaxes) + pp_list_size(taxes);
if (have_time_mean){
tmdimid=ndims;
ndims++;
}
if (have_hybrid_sigmap) {
/* will need a scalar variable called "p0" */
ncvars++;
}
CKP( cudims = CuCreateDims(file,ndims) );
/* need a grid_mapping variable for every rotation mapping,
* and need lon and lat variables for every rotated grid
*/
ncvars += pp_list_size(rotmaps) + 2*pp_list_size(rotgrids);
nvars = ncvars + nfvars;
CKP( cuvars = CuCreateVars(file,nvars) );
for (dimid=0; dimid<ndims; dimid++) {
dim=&cudims[dimid];
dim->var = (CuVar*)0;
dim->coord = (CuVar*)0;
dim->datatype = realtype;
dim->dimtype = CuGlobalDim;
/* uncomment if internal structure is to be used
* CKP( dim->internp = pp_malloc(sizeof(PPdim), heaplist) );
* ppdim=(PPdim*)dim->internp;
*/
}
for (varid=0; varid<nvars; varid++) {
var=&cuvars[varid];
var->datatype = realtype;
CKP( var->internp = pp_malloc(sizeof(PPvar), heaplist) );
ppvar=(PPvar*)var->internp;
ppvar->firstrecno=-1;
ppvar->lastrecno=-1;
ppvar->data=NULL;
CKP( ppvar->atts = pp_list_new(heaplist) );
}
/*
* NOW POPULATE THE STRUCTURES
*
* The procedure will be to loop over all the axes, adding dimensions and
* variables associated with those axes.
*
* Having done that, any dimensions not associated with axes will be added,
* and then the field variables will be added.
*/
dimid=0;
varid=0;
for (axistype=0; axistype<num_axistype; axistype++) {
switch(axistype){
case xaxistype: axislist=xaxes; break;
case yaxistype: axislist=yaxes; break;
case zaxistype: axislist=zaxes; break;
case taxistype: axislist=taxes; break;
default: pp_switch_bug("cdunifpp_process");
}
pp_list_startwalk(axislist,&handle);
idim=0;
while ((axis=pp_list_walk(&handle,0))!=NULL) {
dim=&cudims[dimid];
var=&cuvars[varid];
ppdim=(PPdim*) dim->internp;
ppvar=(PPvar*) var->internp;
dim->coord = var;
axis->dimid=dimid;
dim->len=pp_genaxis_len(axis);
CKP( ppvar->data=pp_genaxis_getCF(axis,dimnamestem,units,ppvar->atts,heaplist) );
sprintf(dim->name,dimnamestem,idim);
if (units != NULL) {
strncpy(dim->units,units,CU_MAX_NAME);
dim->units[CU_MAX_NAME]='\0';
}
strncpy(var->name,dim->name,CU_MAX_NAME);
var->name[CU_MAX_NAME]='\0';
var->ndims=1;
var->dims[0] = dimid;
varid++;
/* now add certain variables for hybrid_sigmap z axis */
if (axistype == zaxistype && pp_zaxis_lev_type(axis) == hybrid_sigmap_lev_type) {
catts=ppvar->atts; /* attribute list for the main coord var */
/* Hybrid sigma-p A coefficient */
var=&cuvars[varid];
ppvar=(PPvar*) var->internp;
sprintf(var->name,"z%d_hybrid_sigmap_acoeff",idim);
varnamea=var->name;
CKP( ppvar->data = pp_genaxis_to_values(axis,hybrid_sigmap_a_type,heaplist) );
CKI( pp_add_string_att(ppvar->atts,"units","Pa",heaplist) );
CKI( pp_add_string_att(ppvar->atts,"long_name",
"atmospheric hybrid sigma-pressure 'A' coefficient",heaplist) );
var->ndims=1;
var->dims[0] = dimid;
varid++;
/* Hybrid sigma-p B coefficient */
var=&cuvars[varid];
ppvar=(PPvar*) var->internp;
sprintf(var->name,"z%d_hybrid_sigmap_bcoeff",idim);
varnameb=var->name;
CKP( ppvar->data = pp_genaxis_to_values(axis,hybrid_sigmap_b_type,heaplist) );
CKI( pp_add_string_att(ppvar->atts,"long_name",
"atmospheric hybrid sigma-pressure 'B' coefficient",heaplist) );
var->ndims=1;
var->dims[0] = dimid;
varid++;
snprintf(formulaterms,MAX_ATT_LEN,"ap: %s b: %s ps: ps p0: p0",varnamea,varnameb);
CKI( pp_add_string_att(catts,"formula_terms",formulaterms,heaplist) );
CKI( pp_add_string_att(catts,"standard_name","atmosphere_hybrid_sigma_pressure_coordinate",heaplist) );
CKI( pp_add_string_att(catts,"comments",
"The \"ps\" term in formula_terms is set to \"ps\" variable. "
"This variable may or may not be provided.",heaplist) );
}
/* now add certain variables for hybrid_height z axis */
if (axistype == zaxistype && pp_zaxis_lev_type(axis) == hybrid_height_lev_type) {
catts=ppvar->atts; /* attribute list for the main coord var */
/* Hybrid height A coefficient */
var=&cuvars[varid];
ppvar=(PPvar*) var->internp;
sprintf(var->name,"z%d_hybrid_height_acoeff",idim);
varnamea=var->name;
CKP( ppvar->data = pp_genaxis_to_values(axis,hybrid_height_a_type,heaplist) );
CKI( pp_add_string_att(ppvar->atts,"units","m",heaplist) );
var->ndims=1;
var->dims[0] = dimid;
varid++;
/* Hybrid height B coefficient */
var=&cuvars[varid];
ppvar=(PPvar*) var->internp;
sprintf(var->name,"z%d_hybrid_height_bcoeff",idim);
varnameb=var->name;
CKP( ppvar->data = pp_genaxis_to_values(axis,hybrid_height_b_type,heaplist) );
var->ndims=1;
var->dims[0] = dimid;
varid++;
snprintf(formulaterms,MAX_ATT_LEN,"a: %s b: %s orog: orography",varnamea,varnameb);
CKI( pp_add_string_att(catts,"formula_terms",formulaterms,heaplist) );
CKI( pp_add_string_att(catts,"standard_name","atmosphere_hybrid_sigma_pressure_coordinate",heaplist) );
CKI( pp_add_string_att(catts,"comments",
"The \"orog\" term in formula_terms is set to \"orography\" variable. "
"This variable may or may not be provided.",heaplist) );
}
/* add the boundary variable for time mean */
if (axistype == taxistype && pp_taxis_is_time_mean(axis)) {
catts=ppvar->atts; /* attribute list for the main coord var */
var=&cuvars[varid];
ppvar=(PPvar*) var->internp;
sprintf(var->name,"time_bnd%d",idim);
CKP( ppvar->data = pp_taxis_to_boundary_values(axis->axis,heaplist) );
var->ndims=2;
var->dims[0]=dimid;
var->dims[1]=tmdimid;
CKI( pp_add_string_att(catts,"bounds",var->name,heaplist) );
varid++;
}
dimid++;
idim++;
} /* end loop over axes of given */
} /* end loop over axis types */
/* add nv dimension if we had time mean */
if (have_time_mean) {
dim=&cudims[dimid];
strcpy(dim->name,"nv");
dim->len=2;
/* Should have tmdimid=dimid, but actually we already set it above (it evaluates to ndims)
* as we needed it before we got here. So just do a check here.
*/
if ( tmdimid != dimid ) {
pp_error_mesg("cdunifpp_process","ID wrong for 'nv' dimension?");
ERR;
}
dimid++;
}
/* add p0 variable if we had hybrid_sigmap coords */
if (have_hybrid_sigmap) {
var=&cuvars[varid];
ppvar=(PPvar*) var->internp;
sprintf(var->name,"p0");
var->ndims=0;
CKI( pp_add_string_att(ppvar->atts,"long_name",
"reference pressure value for atmospheric hybrid sigma-pressure coordinates",
heaplist) );
/* single value consisting of p0 */
CKP( ppvar->data = pp_data_new(realtype,1,heaplist) );
((Freal*)(ppvar->data->values))[0]=reference_pressure;
varid++;
}
/* add any rotated_pole variables */
rotmapid=0;
pp_list_startwalk(rotmaps,&handle);
while ((rotmap=pp_list_walk(&handle,0))!=NULL) {
var=&cuvars[varid];
ppvar=(PPvar*) var->internp;
sprintf(var->name,"rotated_pole%d",rotmapid);
strncpy(rotmap->name,var->name,CU_MAX_NAME);
rotmap->name[CU_MAX_NAME]='\0';
/* single value of arbitrary type; set as integer = 0 */
var->datatype=inttype;
var->ndims=0;
CKP( ppvar->data = pp_data_new(inttype,1,heaplist) );
((Freal*)(ppvar->data->values))[0]=0;
/* and add attributes */
catts=ppvar->atts;
CKI( pp_add_string_att(catts,"grid_mapping_name","rotated_latitude_longitude",heaplist) );
CKI( pp_add_att(catts,"grid_north_pole_longitude",realtype,1,&rotmap->pole_lon,heaplist) );
CKI( pp_add_att(catts,"grid_north_pole_latitude",realtype,1,&rotmap->pole_lat,heaplist) );
CKI( pp_add_att(catts,"north_pole_grid_longitude",realtype,1,&rotmap->truepole_gridlon,heaplist) );
rotmapid++;
varid++;
}
/* and add any lon, lat variables for rotated grids */
rotgridid=0;
pp_list_startwalk(rotgrids,&handle);
while ((rotgrid=pp_list_walk(&handle,0))!=NULL) {
lonvar=&cuvars[varid];
lonppvar=(PPvar*) lonvar->internp;
varid++;
latvar=&cuvars[varid];
latppvar=(PPvar*) latvar->internp;
varid++;
xaxis = rotgrid->xaxis;
yaxis = rotgrid->yaxis;
sprintf(lonvar->name,"true_lon%d",rotgridid);
sprintf(latvar->name,"true_lat%d",rotgridid);
sprintf(rotgrid->coords,"%s %s",lonvar->name,latvar->name);
lonvar->ndims=2;
latvar->ndims=2;
lonvar->dims[0]=yaxis->dimid;
latvar->dims[0]=yaxis->dimid;
lonvar->dims[1]=xaxis->dimid;
latvar->dims[1]=xaxis->dimid;
CKI( pp_calc_rot_grid(rotgrid,&lonppvar->data,&latppvar->data,heaplist) );
CKI( pp_add_string_att(lonppvar->atts,"long_name","longitude",heaplist) );
CKI( pp_add_string_att(latppvar->atts,"long_name","latitude",heaplist) );
CKI( pp_add_string_att(lonppvar->atts,"standard_name","longitude",heaplist) );
CKI( pp_add_string_att(latppvar->atts,"standard_name","latitude",heaplist) );
CKI( pp_add_string_att(lonppvar->atts,"units","degrees_east",heaplist) );
CKI( pp_add_string_att(latppvar->atts,"units","degrees_north",heaplist) );
CKI( pp_add_att(lonppvar->atts,"modulo",realtype,1,&lon_modulo,heaplist) );
rotgridid++;
}
/* sanity check - the variable ID for the next variable to be added should
* now match the number of coordinate variables
*/
if ( varid != ncvars ) {
pp_error_mesg("cdunifpp_process","wrong number of coord vars?");
ERR;
}
/* add all the attributes for coord variables
* (didn't do inside the loop because more complicated
* for hybrid z coords / t mean)
*/
for (cvarid=0; cvarid<ncvars; cvarid++) {
var=&cuvars[cvarid];
ppvar=(PPvar*) var->internp;
CKI( pp_copy_and_free_atts(file,var,ppvar->atts,heaplist) );
}
/*========================================================
* Okay we've done all the variables related to dimensions
* Add the field variables.
*========================================================
*/
pp_list_startwalk(fieldvars,&handle);
while ((fvar=pp_list_walk(&handle,0))!=NULL) {
var=&cuvars[varid];
ppvar=(PPvar*) var->internp;
atts = ppvar->atts;
hdrp = &fvar->firstrec->hdr;
CKI( pp_var_lookup(hdrp, &fvar->stashmeta) );
CKI( pp_get_var_name(varid, fvar->stashmeta.shortname, cuvars) );
var->ndims=4; /* rpw axeslist len */
/*
* Axes in fvar->axes list are fastest varying first (lon,lat,lev,time)
* But require them in netCDF-like order (time,lev,lat,lon), so
* reverse the order while copying into var->dims.
*/
idim=var->ndims;
pp_list_startwalk(fvar->axes,&thandle);
while ((axis=pp_list_walk(&thandle,0)) != NULL) {
var->dims[--idim] = axis->dimid;
}
var->datatype = pp_get_var_type(hdrp);
ppvar->firstrecno = fvar->firstrecno;
ppvar->lastrecno = fvar->lastrecno;
CKI( pp_var_get_extra_atts(var, fvar, cudims, atts, heaplist) );
CKI( pp_copy_and_free_atts(file, var, atts, heaplist) );
varid++;
}
/* sanity check - the variable ID for the next variable to be added (if there was one,
* which there isn't), should now match the total number of variables
*/
if ( varid != nvars ) {
pp_error_mesg("cdunifpp_process","wrong number of vars?");
ERR;
}
/* set numbers in file structure */
file->ndims=ndims;
file->nvars=nvars;
file->recdim=-1;
/* set global attributes */
CKP( gatts = pp_get_global_attributes(file->controlpath, ppfile, heaplist) );
CKI( pp_copy_and_free_atts(file,NULL,gatts,heaplist) );
/*========================================================
* All done and ready for dimget / varget.
*========================================================
*/
/* free what memory we can */
CKI( pp_free_tmp_vars(xaxes, yaxes, zaxes, taxes, fieldvars, heaplist) );
return 0;
ERRBLKI("pp_process");
}
int pp_data_copy(const CuFile *file, const CuVar *var, const long start[], const long count[], void *values) {
const PPfile *ppfile;
PPlist *heaplist;
const PPvar *ppvar;
const PPdata *data;
const void *src;
int ndim,idim;
int *indices, *size;
int srcoffset, destoffset;
int carryout;
int is_int, is_real;
ppfile = file->internp;
ppvar = var->internp;
heaplist = ppfile->heaplist;
data = ppvar->data;
CKP( src=data->values );
ndim = var->ndims;
if (ndim > 0) {
CKP( size=pp_malloc(ndim*sizeof(int),heaplist) );
CKP( indices=pp_malloc(ndim*sizeof(int),heaplist) );
} else {
size = indices = NULL;
/* won't use these NULL values - only to suppress compiler warnings about uninitialised */
}
for (idim=0; idim<ndim; idim++) {
size[idim] = file->dims[var->dims[idim]].len;
indices[idim]=0;
if (start[idim]<0 || count[idim]<0 || start[idim]+count[idim]>size[idim])
return CU_EINVALCOORDS;
}
carryout=0;
is_int = (data->type == inttype);
is_real = (data->type == realtype);
ERRIF(!is_int && !is_real);
while (!carryout) {
/* indices loop from 0 to count-1 in each dimension: keep looping until
* carry-out from most slowly varying dimension
*/
/* locate hyperslab element within source and destination 1d arrays */
srcoffset=0;
destoffset=0;
for (idim=0; idim < ndim ; idim++) {
srcoffset *= size[idim];
destoffset *= count[idim];
srcoffset += indices[idim]+start[idim];
destoffset += indices[idim];
}
/* copy data */
if (is_int)
*((Fint *)values + destoffset) = *((Fint *)src + srcoffset);
else if (is_real)
*((Freal *)values + destoffset) = *((Freal *)src + srcoffset);
/* increment indices */
for (idim=ndim-1 ; idim>=0; idim--) {
indices[idim]++;
if (indices[idim]==count[idim])
indices[idim]=0; /* carry, so keep looping */
else
break; /* no internal carry */
}
if (idim<0)
carryout=1;
}
if (ndim > 0) {
CKI( pp_free(size,heaplist) );
CKI( pp_free(indices,heaplist) );
}
return CU_SUCCESS;
ERRBLK("pp_data_copy",CU_SERROR);
}
int pp_data_read(const CuFile *file, const CuVar *var, const long start[], const long count[], void *values)
{
const PPfile *ppfile;
PPlist *heaplist;
const PPvar *ppvar;
int startrec, endrec, nrec, recno;
int cx,cy,sx,sy,iy;
const void *src;
void *data, *ptr, *dest;
int nx,ny, ndim;
int idim;
int *indices, *size;
int carryout;
int destoffset;
ndim=var->ndims;
ERRIF(ndim < 2);
ppfile = file->internp;
ppvar = var->internp;
heaplist = ppfile->heaplist;
startrec = ppvar->firstrecno;
endrec = ppvar->lastrecno;
nrec = endrec - startrec + 1;
CKP( size=pp_malloc(ndim*sizeof(int),heaplist) );
/* last two items in indices aren't actually used but define for completeness */
CKP( indices=pp_malloc(ndim*sizeof(int),heaplist) );
for (idim=0; idim<ndim; idim++) {
size[idim] = file->dims[var->dims[idim]].len;
indices[idim]=0;
if (start[idim]<0 || count[idim]<0 || start[idim]+count[idim]>size[idim])
return CU_EINVALCOORDS;
}
/* some constants for use later */
nx=size[ndim-1];
ny=size[ndim-2];
cx=count[ndim-1];
cy=count[ndim-2];
sx=start[ndim-1];
sy=start[ndim-2];
/*
* JAK this needs moving to pp_process
* if (nrec != nz * nt) {
* CuError(CU_EINVALCOORDS,"refusing to read variable which has missing combinations of z,t");
* return CU_EINVALCOORDS;
*}
*/
/* we can now assume that the records loop over correct times and levels
* (loop over time is the more slowly varying dimension because that's
* how we sorted them)
*/
carryout=0;
while (!carryout) {
recno=0;
destoffset=0;
for (idim=0; idim < ndim-2 ; idim++) { /* treat inner 2 dim as record dims */
recno *= size[idim];
destoffset *= count[idim];
recno += indices[idim]+start[idim];
destoffset += indices[idim];
}
recno=startrec+recno;
ptr=(char*)values+destoffset*wordsize*cx*cy;
CKP( data=pp_read_data_record(ppfile->recs[recno],ppfile,heaplist) );
for (iy=0; iy<cy; iy++) {
src = (char*) data + ((sy+iy)*nx + sx) * wordsize;
dest = (char*) ptr + (iy*cx) * wordsize;
memcpy(dest,src,cx*wordsize);
}
CKI( pp_free(data,heaplist) );
/* increment indices */
for (idim=ndim-2-1 ; idim>=0; idim--) {
indices[idim]++;
if (indices[idim]==count[idim])
indices[idim]=0; /* carry, so keep looping */
else
break; /* no internal carry */
}
if (idim<0)
carryout=1;
}
return CU_SUCCESS;
ERRBLK("pp_data_read",CU_SERROR);
}
/** Initialize the post-processing queue. */
struct pp_queue_t *
pp_init(struct pipe_context *pipe, const unsigned int *enabled,
struct cso_context *cso)
{
unsigned int num_filters = 0;
unsigned int curpos = 0, i, tmp_req = 0;
struct pp_queue_t *ppq;
pp_debug("Initializing the post-processing queue.\n");
/* How many filters were requested? */
for (i = 0; i < PP_FILTERS; i++) {
if (enabled[i])
num_filters++;
}
if (num_filters == 0)
return NULL;
ppq = CALLOC(1, sizeof(struct pp_queue_t));
if (!ppq) {
pp_debug("Unable to allocate memory for ppq.\n");
goto error;
}
ppq->pp_queue = CALLOC(num_filters, sizeof(pp_func));
if (ppq->pp_queue == NULL) {
pp_debug("Unable to allocate memory for pp_queue.\n");
goto error;
}
ppq->shaders = CALLOC(num_filters, sizeof(void *));
ppq->filters = CALLOC(num_filters, sizeof(unsigned int));
if ((ppq->shaders == NULL) ||
(ppq->filters == NULL)) {
pp_debug("Unable to allocate memory for shaders and filter arrays.\n");
goto error;
}
ppq->p = pp_init_prog(ppq, pipe, cso);
if (ppq->p == NULL) {
pp_debug("pp_init_prog returned NULL.\n");
goto error;
}
/* Add the enabled filters to the queue, in order */
curpos = 0;
for (i = 0; i < PP_FILTERS; i++) {
if (enabled[i]) {
ppq->pp_queue[curpos] = pp_filters[i].main;
tmp_req = MAX2(tmp_req, pp_filters[i].inner_tmps);
ppq->filters[curpos] = i;
if (pp_filters[i].shaders) {
ppq->shaders[curpos] =
CALLOC(pp_filters[i].shaders + 1, sizeof(void *));
if (!ppq->shaders[curpos]) {
pp_debug("Unable to allocate memory for shader list.\n");
goto error;
}
}
/* Call the initialization function for the filter. */
if (!pp_filters[i].init(ppq, curpos, enabled[i])) {
pp_debug("Initialization for filter %u failed.\n", i);
goto error;
}
curpos++;
}
}
ppq->n_filters = curpos;
ppq->n_tmp = (curpos > 2 ? 2 : 1);
ppq->n_inner_tmp = tmp_req;
ppq->fbos_init = false;
for (i = 0; i < curpos; i++)
ppq->shaders[i][0] = ppq->p->passvs;
pp_debug("Queue successfully allocated. %u filter(s).\n", curpos);
return ppq;
error:
if (ppq) {
/* Assign curpos, since we only need to destroy initialized filters. */
ppq->n_filters = curpos;
/* Call the common free function which must handle partial initialization. */
pp_free(ppq);
}
return NULL;
}
int main() {
set_sample_method("metropolis-hastings");
set_sample_iterations(NSAMPLES);
set_mh_burn_in(BURN_IN);
set_mh_lag(LAG);
set_prompt_per_round(50);
pp_state_t* state;
struct pp_instance_t* instance;
pp_query_t* query;
pp_trace_store_t* traces;
state = pp_new_state();
pp_load_file(state, "parse/models/naive.model");
ModelNode* model = model_map_find(state->model_map, state->symbol_table, "naive_bayes");
if (!model) {
printf("error: model not found\n");
return 1;
}
printf(dump_model(model));
pp_variable_t* param[6] = {
new_pp_int(K), /* K : #classes */
new_pp_int(N), /* N : #docs */
new_pp_int(NWORDS), /* nwords: #words per doc */
new_pp_int(V), /* V: vocabulary size */
new_pp_float(ALPHA), /* alpha */
new_pp_float(BETA), /* beta*/
};
FILE* fin = fopen("test/naive_data.txt", "r");
if (!fin) {
printf("data not found\n");
return 1;
}
for (int i = 0; i < N; ++i) {
for (int j = 0; j < NWORDS; ++j) {
fscanf(fin, "%d", &X[i][j]);
}
}
fclose(fin);
fin = fopen("test/naive_class.txt", "r");
if (!fin) {
printf("data not found\n");
return 1;
}
for (int i = 0; i < N; ++i) {
fscanf(fin, "%d", &c[i]);
}
fclose(fin);
query = pp_query_composite(
pp_query_observe_int_array(state, "c", c, NTRAIN),
pp_query_observe_int_array_2D(state, "X", &X[0][0], N, NWORDS)
);
int result = pp_sample_f(state, "naive_bayes", param, query, stat_sample, 0);
pp_variable_destroy_all(param, 6);
pp_query_destroy(query);
pp_free(state);
FILE* fout = fopen("test/naive_inferred.txt", "w");
fprintf(fout, "%-8s%10s%10s%4s%4s\n", "no.", "p(0)", "p(1)", "tru", "inf");
int cnt[K][K];
memset(cnt, 0, sizeof(int) * K * K);
for (int i = 0; i < N; ++i) {
fprintf(fout, "%-8d", i);
int cat = 0;
for (int j = 0; j < K; ++j) {
if (num[i][j] > num[i][cat]) cat = j;
fprintf(fout, "%10f", num[i][j] / (float) NSAMPLES);
//printf("num[%d][%d] = %d\n", i, j, num[i][j]);
}
fprintf(fout, "%4d%4d\n", c[i], cat);
if (i >= NTRAIN) {
cnt[cat][c[i]]++;
}
}
fprintf(fout, "\ntp = %d, fp = %d, fn = %d\n", cnt[1][1], cnt[1][0], cnt[0][1]);
printf("tp = %d, fp = %d, fn = %d\n", cnt[1][1], cnt[1][0], cnt[0][1]);
float prec = ((float) cnt[1][1]) / (cnt[1][1] + cnt[1][0]);
float recall = ((float) cnt[1][1]) / (cnt[1][1] + cnt[0][1]);
float accuracy = ((float) cnt[0][0] + cnt[1][1]) / NTEST;
fprintf(fout, "accuracy = %f\n", accuracy);
printf("accuracy = %f\n", accuracy);
fprintf(fout, "precision = %f, recall = %f\n", prec, recall);
printf("precision = %f, recall = %f\n", prec, recall);
float f1_score = 2 * (prec * recall) / (prec + recall);
fprintf(fout, "f1 score = %f\n", f1_score);
printf("f1 score = %f\n", f1_score);
fclose(fout);
return 0;
}
int main()
{
#ifdef ENABLE_MEM_PROFILE
mem_profile_init();
#endif
set_sample_method("Metropolis-hastings");
set_sample_iterations(200);
set_mh_burn_in(200);
set_mh_lag(50);
set_mh_max_initial_round(2000);
/* use pointers to structs because the client doesn't need to know the struct sizes */
struct pp_state_t* state;
struct pp_instance_t* instance;
struct pp_query_t* query;
struct pp_trace_store_t* traces;
float result;
state = pp_new_state();
printf("> state created\n");
pp_load_file(state, "parse/models/lda.model");
printf("> file loaded\n");
ModelNode* model = model_map_find(state->model_map, state->symbol_table, "latent_dirichlet_allocation");
printf(dump_model(model));
//query = pp_compile_string_query("");
//printf("> condition compiled\n");
pp_variable_t** param = malloc(sizeof(pp_variable_t*) * 4);
param[0] = new_pp_int(2);
param[1] = new_pp_int(2);
param[2] = new_pp_vector(2);
PP_VARIABLE_VECTOR_LENGTH(param[2]) = 2;
for (int i = 0; i < 2; ++i) {
PP_VARIABLE_VECTOR_VALUE(param[2])[i] = new_pp_int(2);
}
param[3] = new_pp_int(3);
int X[2][2] = {
{0, 0},
{1, 1},
};
query = pp_query_observe_int_array_2D(state, "X", &X[0][0], 2, 2);
if (!query) return 1;
traces = pp_sample_v(state, "latent_dirichlet_allocation", param, query, 1, "topic");
printf("> traces sampled\n");
if (!traces) {
printf("ERROR encountered!!\n");
return 1;
}
char buffer[8096];
size_t max_index = 0;
for (size_t i = 1; i < traces->n; ++i) {
if (traces->trace[i]->logprob > traces->trace[max_index]->logprob) {
max_index = i;
}
}
printf("\nsample with max logprob:\n");
pp_trace_dump(buffer, 8096, traces->trace[max_index]);
printf(buffer);
printf("\nlast sample:\n");
pp_trace_dump(buffer, 8096, traces->trace[traces->n - 1]);
printf(buffer);
FILE* trace_dump_file = fopen("trace_dump.txt", "w");
for (size_t i = 0; i != traces->n; ++i) {
pp_trace_dump(buffer, 8096, traces->trace[i]);
fprintf(trace_dump_file, "[trace %u]\n", i);
fprintf(trace_dump_file, buffer);
}
fclose(trace_dump_file);
int nwords[] = {2, 2};
/* parameter estimation */
estimate_parameters(traces, 1.0, 1.0, 2, 2, nwords, 3, &X[0][0], 2);
// pp_free is broken
pp_free(state); /* free memory, associated models, instances, queries, and trace stores are deallocated */
pp_trace_store_destroy(traces);
pp_query_destroy(query);
for (int i = 0; i < 4; ++i)
pp_variable_destroy(param[i]);
free(param);
#ifdef ENABLE_MEM_PROFILE
mem_profile_print();
mem_profile_destroy();
#endif
return 0;
}
int pp_get_fvars(int nrec, PPrec **recs, PPfile *ppfile,
PPlist *fieldvars,
PPlist *xaxes, PPlist *yaxes, PPlist *zaxes, PPlist *taxes,
PPlist *rotmaps, PPlist *rotgrids,
int *ncvarsp, int *have_time_mean_p, int *have_hybrid_sigmap_p,
PPlist *heaplist)
{
int rec;
int at_start_rec, at_end_rec = 0;
PPrec *recp, **vrecs;
PPhdr *hdrp;
PPgenaxis *xaxis, *yaxis, *zaxis, *taxis; /* JAK 2005-01-05 */
PPfieldvar *fvar;
int zindex, tindex;
int nvrec;
int dont_free_horiz_axes = 0;
int svindex = 1;
xaxis = yaxis = NULL;
fvar = NULL;
zaxis = NULL;
taxis = NULL;
*ncvarsp = 0;
*have_hybrid_sigmap_p = 0;
*have_time_mean_p = 0;
/* ====== START LOOP OVER RECORDS ====== */
for (rec=0; rec < nrec ; rec++) {
recp = recs[rec];
hdrp = &recp->hdr;
/* Some fieldsfiles have header fields with missing values */
if (pp_var_is_missing(hdrp)) {
CuError(CU_EOPEN, "skipping variable stash code=%d, %d, %d because of %s",
pp_get_var_stash_model(hdrp),
pp_get_var_stash_section(hdrp),
pp_get_var_stash_item(hdrp),
"missing header data");
continue;
}
/* we are at start record of a variable at the very start, or if at we were at the
* end record last time
*/
at_start_rec = ( rec == 0 || at_end_rec );
/* we are at end record of a variable at the very end, or if the header shows a
* difference from the next record which constitutes a different variable
*/
at_end_rec = ( rec == nrec-1 ||
pp_records_from_different_vars(recs[rec+1], recp));
/*------------------------------*/
/* allow for variables which are unsupported for some reason */
if (at_start_rec)
if (pp_test_skip_var(hdrp, ppfile->landmask))
continue;
/* -------
if (at_start_rec)
puts("++++++ START OF VARIABLE +++++++++");
printf("processing record %d / %d\n", rec, nrec);
pp_dump_header(hdrp);
------ */
if (at_start_rec)
CKI( pp_get_new_fvar(rec, recp, ppfile, rotmaps,
&fvar, &xaxis, &yaxis, &zaxis, &taxis,
&dont_free_horiz_axes, heaplist) );
/* ====== THINGS DONE FOR EVERY PP RECORD ====== */
CKI( pp_zaxis_add(zaxis, recp->lev, &zindex, heaplist) );
recp->zindex = zindex;
CKI( pp_taxis_add(taxis, recp->time, &tindex, heaplist) );
recp->tindex = tindex;
/* ===================================================== */
if (at_end_rec) {
/* ====== THINGS DONE ONLY AT END RECORD OF EACH VARIABLE ====== */
fvar->lastrecno = rec;
nvrec = fvar->lastrecno - fvar->firstrecno + 1;
vrecs = recs + fvar->firstrecno;
/* now if the axes are not regular, free the axes, split the variable into a number of variables and try again... */
if (pp_set_disambig_index(zaxis, taxis, vrecs, nvrec, svindex)) {
/* increment the supervar index, used later to show the connection between
* the separate variables into which this one will be split
*/
svindex++;
/* now re-sort this part of the record list, now that we have set the disambig index */
qsort(vrecs, nvrec, sizeof(PPrec*), pp_compare_records);
/* now go back to the start record of the variable; set to one less because it
* will get incremented in the "for" loop reinitialisation
*/
rec = fvar->firstrecno - 1;
/* and free the stuff assoc with the var we won't be using */
if (!dont_free_horiz_axes) {
CKI( pp_genaxis_free(xaxis, heaplist) );
CKI( pp_genaxis_free(yaxis, heaplist) );
}
CKI( pp_genaxis_free(zaxis, heaplist) );
CKI( pp_genaxis_free(taxis, heaplist) );
CKI( pp_free(fvar, heaplist) );
continue;
}
/* add these axes to the field variable */
CKI( pp_add_axes_to_fvar(fvar, xaxis, yaxis, zaxis, taxis,
xaxes, yaxes, zaxes, taxes, rotgrids,
dont_free_horiz_axes,
ncvarsp, have_hybrid_sigmap_p, have_time_mean_p,
heaplist) );
/*------------------------------------------------------------*/
/* add the variable */
CKI( pp_list_add(fieldvars, fvar, heaplist) );
}
}
/* finally, as one of the outputs from this routine is the number of coordinate variables,
* allow for a couple of possible additions (FIXME: is this the best place for this code?)
*/
/* (1) if have hybrid coords, will need a scalar variable called "p0" */
if (*have_hybrid_sigmap_p)
(*ncvarsp)++;
/* (2) need a grid_mapping variable for every rotation mapping,
* and need lon and lat variables for every rotated grid
*/
*ncvarsp += pp_list_size(rotmaps) + 2 * pp_list_size(rotgrids);
return 0;
ERRBLKI("pp_get_fvars");
}
void *pp_read_data_record(const PPrec *rec, const PPfile *ppfile, PPlist *heaplist)
{
size_t bytes, packed_bytes, nread;
FILE *fh;
PPconvert conv;
void *data, *data_expanded, *packed_data;
CuType vartype;
const PPhdr *hdrp;
int pack;
int nint;
int ipt, npoint, npoint_used;
Fint valid_landmask_value, *landmask_vals;
Freal mdi;
const void *fill_ptr;
const char *srcptr; /* points to compressed data; this could be of type Fint or Freal;
* use char* instead of void* to allow ptr arithmetic
*/
char *destptr; /* uncompressed data */
CKP(ppfile);
CKP(rec);
CKP(heaplist);
fh = ppfile->fh;
fseek(fh, rec->datapos, SEEK_SET);
hdrp=&rec->hdr;
pack = pp_get_var_packing(hdrp);
vartype=pp_get_var_type(hdrp);
if (pack==0) {
/* unpacked data -- read and convert according to type */
bytes = rec->datalen * wordsize;
CKP( data = pp_malloc(bytes,heaplist) );
if (vartype==inttype)
conv = convert_int;
else if (vartype==realtype)
conv = convert_real;
else {
conv=convert_none;
pp_switch_bug("pp_read_data_record"); ERR;
}
nread = pp_read_words(data, rec->datalen, conv, ppfile);
ERRIF(nread != rec->datalen);
}
else {
/* PACKING IN USE */
/* first allocate array and read in packed data */
packed_bytes = rec->disklen * ppfile->wordsize;
CKP( packed_data = pp_malloc(packed_bytes,heaplist) );
nread = pp_read_words(packed_data, rec->disklen, convert_none, ppfile);
ERRIF(nread != rec->disklen);
/* and allocate array for unpacked data*/
bytes = rec->datalen * wordsize;
CKP( data = pp_malloc(bytes,heaplist) );
/* NOW UNPACK ACCORDING TO PACKING TYPE: */
switch(pack) {
case 1:
/* WGDOS */
/* for this case we will use unwgdos routine */
/* unwgdos routine wants to know number of native integers in input.
* input type might not be native int, so calculate:
*/
nint = rec->disklen * ppfile->wordsize / sizeof(int);
mdi = *(Freal*)pp_get_var_fill_value(hdrp);
CKI( pp_unwgdos_wrap(packed_data, nint, data, rec->datalen, mdi, heaplist) );
break;
case 2:
/* CRAY 32-bit method */
if (vartype != realtype) {
CuError(CU_EINTERN,"Cray 32-bit unpacking supported only for REAL type data");
ERR;
}
/*
* in the event of a 64-bit file (which it probably is, else 32-bit packing is
* redundant), and if we're on a little-endian machine, the file was written on
* a cray, so the 64-bit byte swapping (whether done by cdunifpp or previously)
* will have had the side-effect of swapping pairs of 32-bit words and we need
* to swap them back again.
*
* NB LITTLE_ENDIAN_MACHINE is defined (if at all) in cdunifpp.h
*/
#ifdef LITTLE_ENDIAN_MACHINE
if (ppfile->wordsize == 8)
pp_swap32couplets(packed_data,packed_bytes);
#endif
for (ipt=0; ipt < rec->datalen ; ipt++)
*(((Freal*) (data)) + ipt) = *(((Freal4*) (packed_data)) + ipt);
break;
case 3:
CuError(CU_EINTERN,"GRIB unpacking not supported");
ERR;
/* break; */
default:
pp_switch_bug("pp_read_data_record"); ERR;
}
/* Okay - data unpacked - free up packed data */
CKI( pp_free(packed_data,heaplist) );
}
/* if land or sea mask compression, then allocate another array, and
* copy the relevant data across, filling the gaps with missing data
*/
if (pp_get_var_compression(hdrp) == 2) {
npoint = pp_genaxis_len(ppfile->landmask->xaxis) * pp_genaxis_len(ppfile->landmask->yaxis);
bytes = npoint * wordsize;
CKP( data_expanded = pp_malloc(bytes,heaplist) );
switch ((hdrp->LBPACK/100)%10) {
case 1:
/* land mask compression */
valid_landmask_value = 1;
break;
case 2:
/* sea mask compression */
valid_landmask_value = 0;
break;
default:
pp_switch_bug("pp_read_data_record"); ERR;
}
landmask_vals = ppfile->landmask->data->values;
srcptr = data;
destptr = data_expanded;
CKP( fill_ptr = pp_get_var_fill_value(hdrp) );
npoint_used = 0;
for (ipt = 0; ipt < npoint; ipt++) {
if (abs(landmask_vals[ipt]) == valid_landmask_value) {
if (npoint_used >= rec->datalen) {
CuError(CU_EINTERN,"Uncompressing tried to use more compressed data than available");
ERR;
}
memcpy(destptr,srcptr,wordsize);
srcptr += wordsize;
npoint_used++;
}
else {
memcpy(destptr,fill_ptr,wordsize);
}
destptr += wordsize;
}
if (npoint_used != rec->datalen) {
CuError(CU_EINTERN,"Uncompressing did not use all the compressed data");
ERR;
}
CKI( pp_free(data,heaplist) );
data = data_expanded;
}
return data;
ERRBLKP("pp_read_data_record");
}
