/* buffered.c
********************************************************************************
* buffered.c -- Routines to buffer a statistical series objects
*
* User routines
*	Pro_BufferedStat()	creates a buffered statistical series object.
*
* A buffered statistical series duplicates the behavior of another statistical
* series.  However, it also retains an internal cache of series samples, and
* only accesses the original series if the requested sample is not in the cache.
* This can be very useful when working with statistical series for which it
* takes a significant computational effort to generate a series value.
*
* Version 1.0: Original release.
*              Mark Showalter, PDS Rings Node, March 1998.
* Version 1.1: Support for Pro_StatRange() function added.
*              Mark Showalter, January 2000.
*******************************************************************************/
#include 
#include "profile.h"
#include "fortran.h"

/********************
 * Type definitions *
 ********************/

typedef struct ZPRO_BUFFERED_STRUCT {
    XPRO_CLASS	class;
    PRO_OBJECT	*stat;
    RL_INT4	samples, mask;
    RL_BOOL	isdouble;
    RL_FLT8	*ddata;
    RL_FLT4	*sdata;
    RL_BOOL	*flags;
    RL_INT4	*index;
} ZPRO_BUFFERED;

/********************
 * Static variables *
 ********************/

static XPRO_CLASS buffered_class = {XPRO_BUFFERED_CLASS, "buffered", NULL};

/********************************
 * Internal function prototypes *
 ********************************/

static RL_FLT8 ZPro_BufferedValue RL_PROTO((RL_VOID *params, RL_INT4 k,
                                            RL_INT4 *flag));
static RL_FLT8 ZPro_BufferedCovar RL_PROTO((RL_VOID *params,
                                            RL_INT4 k1, RL_INT4 k2));
static void    ZPro_BufferedRange RL_PROTO((RL_VOID *params, RL_INT4 k,
                                            RL_INT4 *k1, RL_INT4 *k2));
static void    ZPro_FreeBuffered  RL_PROTO((RL_VOID *params));
static void    ZPro_PrintBuffered RL_PROTO((RL_VOID *params));

/*********************
 * Macro definitions *
 ********************/

#ifdef DEBUG
#define MIN_SAMPLES	1
#else
#define MIN_SAMPLES	1024
#endif

/*
********************************************************************************
* EXPORTED USER ROUTINES
********************************************************************************
*$ Component_name:
*	Pro_BufferedStat (buffered.c)
*$ Abstract:
*	This routine creates and returns a buffered statistical series.  A
*	buffered series duplicates the behavior of another series but saves
*	recently-accessed samples in memory so they do not have to be
*	re-calculated.
*$ Keywords:
*	PROFILE
*	C, PUBLIC, SUBROUTINE
*$ Declarations:
*	PRO_OBJECT	*Pro_BufferedStat(stat, samples, usedouble)
*	PRO_OBJECT	*stat;
*	RL_INT4		samples;
*	RL_BOOL		usedouble;
*$ Inputs:
*	stat		pointer to the statistical series to buffer.
*	samples		minimum number of samples to retain (rounded up to the
*			nearest power of two).
*	usedouble	TRUE to store double-precision values; FALSE to store
*			single-precision values.
*$ Outputs:
*	none
*$ Returns:
*	pointer to a new buffered statistical series, or NULL on non-fatal
*	error.
*$ Detailed_description:
*	This routine creates and returns a buffered statistical series.  A
*	buffered series duplicates the behavior of another series but saves
*	recently-accessed samples in memory so they do not have to be
*	re-calculated.
*
*	The series is implemented by retaining in memory an array consisting
*	of exactly 2^n samples.  When the kth sample is requested, the routine
*	first checks to see if the sample stored in array location (k mod 2^n)
*	is the one desired.  If so, it returns this value.  Otherwise, it
*	evaluates the original series (to which it has retained a link) and
*	updates the stored value in the array.
*
*	For efficiency, the number of samples held in memory should be at least
*	as large as the number of coefficients in the largest filter that might
*	be convolved with the series.
*$ External_references:
*	Profile toolkit
*$ Side_effects:
*	Memory is allocated.  A link to the original statistical series is
*	created.
*$ Examples:
*	This line of code creates a buffered series in which 2000 samples are
*	retained internally in double precision.  In every other respect, this
*	series behaves identically to the original series.
*
*	buffered_stat = Pro_BufferedStat(original_stat, 2000, TRUE);
*
*$ Error_handling:
*	Profile library error handling is in effect.
*
*	Conditions raised:
*	RL_MEMORY_ERROR		on memory allocation failure.
*	PRO_CLASS_ERROR		if stat is NULL or is not a stat series.
*$ Limitations:
*	None.  However, a substantial decrease in speed and efficiency occurs if
*	the user often requests series samples that are separated in index by
*	amounts larger than the size of the buffer.
*$ Author_and_institution:
*	Mark R. Showalter
*	NASA/Ames Research Center
*$ Version_and_date:
*	1.0: March 1998
*$ Change_history:
*	none
*******************************************************************************/

PRO_OBJECT	*Pro_BufferedStat(stat, samples, usedouble)
PRO_OBJECT	*stat;
RL_INT4		samples;
RL_BOOL		usedouble;
{
ZPRO_BUFFERED	*params;
PRO_OBJECT	*new;
RL_INT4		i, k1, k2;
RL_FLT8		x1, dx;

    /* Verify object type */
    if (XPro_StatPtr(stat) == NULL) return NULL;

    /* Create new buffered statistical series structure */
    params = (ZPRO_BUFFERED *) XRL_Malloc(sizeof(ZPRO_BUFFERED));
    if (params == NULL) return NULL;

    params->class = buffered_class;
    params->stat  = stat;
    params->isdouble = usedouble;
    params->ddata = NULL;
    params->sdata = NULL;
    params->flags = NULL;
    params->index = NULL;

    /* Determine samples to retain (must be a power of two) */
    params->samples = MIN_SAMPLES;
    while (params->samples < samples) {
	params->samples *= 2;
    }

    params->mask = params->samples - 1;

    /* Allocate buffers */
    if (usedouble) {
       params->ddata = (RL_FLT8 *) XRL_Malloc(params->samples*sizeof(RL_FLT8));
       if (params->ddata == NULL) goto FAILURE;
    }
    else {
       params->sdata = (RL_FLT4 *) XRL_Malloc(params->samples*sizeof(RL_FLT4));
       if (params->sdata == NULL) goto FAILURE;
    }

    params->index = (RL_INT4 *) XRL_Malloc(params->samples * sizeof(RL_INT4));
    if (params->index == NULL) goto FAILURE;

    params->flags = (RL_BOOL *) XRL_Malloc(params->samples * sizeof(RL_BOOL));
    if (params->index == NULL) goto FAILURE;

    /* Initialize index list to illegal values */
    (params->index)[0] = 1;
    for (i = 1; i < params->samples; i++) {
	(params->index)[i] = 0;
    }

    /* Create new statistical series */
    Pro_SeriesIndices(stat, &k1, &k2);
    Pro_SeriesSampling(stat, &x1, NULL, &dx);
    new = XPro_MakeStat(k1, k2, x1, dx,
                        ZPro_BufferedValue,
			ZPro_BufferedCovar, ZPro_BufferedRange,
                        ZPro_FreeBuffered, ZPro_PrintBuffered,
                        (RL_VOID *) params);

    /* Enslave old statistical series */
    if (new != NULL && XPro_EnslaveObject(new,stat)) {
	Pro_FreeObject(new);
	return NULL;
    }

    /* Transfer coordinate names to new function */
    Pro_RenameObject(new, 1, Pro_ObjectName(stat,1));
    Pro_RenameObject(new, 2, Pro_ObjectName(stat,2));

    return new;

FAILURE:
    ZPro_FreeBuffered((RL_VOID *) params);
    return NULL;
}

/*
********************************************************************************
* INTERNAL ROUTINES
********************************************************************************
* ZPro_BufferedValue(params, index, flag)
*
* This internal routine returns the value of a buffered statistical series.
* First it checks its internal buffer; if the sample is not found, it accesses
* the original seriers and saves the value in the cache.
*
* Inputs:
*	params		pointer to the ZPRO_BUFFERED structure.
*	k		series index.

* Outputs:
*	*flag		0 if returned value is valid; nonzero otherwise.
*
* Return:		sample value from series; 0 on error.
*******************************************************************************/

static RL_FLT8 ZPro_BufferedValue(params, k, flag)
RL_VOID		*params;
RL_INT4		k, *flag;
{
ZPRO_BUFFERED	*buffered;
RL_INT4		offset;
RL_FLT8		value;

    buffered = (ZPRO_BUFFERED *) params;

    offset = k & buffered->mask;
    if (k != buffered->index[offset]) {

#ifdef DEBUG
	printf("*");
#endif

	value = Pro_SeriesValue(buffered->stat, k, buffered->flags + offset);
	if (buffered->isdouble) (buffered->ddata)[offset] = value;
	else                    (buffered->sdata)[offset] = value;

	buffered->index[offset] = k;
    }

    *flag = (buffered->flags)[offset];

    if (buffered->isdouble) return (buffered->ddata)[offset];
    else                    return (buffered->sdata)[offset];
}

/*
********************************************************************************
* ZPro_BufferedCovar(params, k1, k2)
*
* This internal routine evaluates the covariance of a buffered statistical
* series.  It does so simply by calling the covariance function of the original
* series.
*
* Inputs:
*	params		pointer to the ZPRO_BUFFERED structure.
*	k1, k2		pair of new indices at which to evaluate covariance.
*
* Returns:		value of covariance between k1 and k2;
*******************************************************************************/

static RL_FLT8	ZPro_BufferedCovar(params, k1, k2)
RL_VOID		*params;
RL_INT4		k1, k2;
{
ZPRO_BUFFERED	*buffered;

    buffered = (ZPRO_BUFFERED *) params;

    return Pro_StatCovar(buffered->stat, k1, k2);
}

/*
********************************************************************************
* ZPro_BufferedRange(params, k, k1, k2)
*
* This internal routine evaluates the range of correlated samples in a buffered
* statistical series.  It does so simply by calling the corresponding function
* of the original series.
*
* Inputs:
*	pointer		pointer to the ZPRO_BUFFERED structure.
*	k		index at which to evaluate correlation range.
*
* Outputs:
*	k1, k2		range of indices within which samples are correlated.
*
* Returns:		none.
*******************************************************************************/

static void	ZPro_BufferedRange(pointer, k, k1, k2)
RL_VOID		*pointer;
RL_INT4		k, *k1, *k2;
{
ZPRO_BUFFERED	*buffered;

    buffered = (ZPRO_BUFFERED *) pointer;

    Pro_StatRange(buffered->stat, k, k1, k2);
}

/*
********************************************************************************
* ZPro_FreeBuffered(params)
*
* This internal routine deallocates the memory used by a buffered statistical
* series.
*
* Input:
*	params		pointer to the ZPRO_BUFFERED structure.
*******************************************************************************/

static void	ZPro_FreeBuffered(params)
RL_VOID		*params;
{
ZPRO_BUFFERED	*buffered;

    buffered = (ZPRO_BUFFERED *) params;

    XRL_Free((RL_VOID *) buffered->ddata);
    XRL_Free((RL_VOID *) buffered->sdata);
    XRL_Free((RL_VOID *) buffered->flags);
    XRL_Free((RL_VOID *) buffered->index);

    XRL_Free((RL_VOID *) buffered);
}

/*
********************************************************************************
* ZPro_PrintBuffered(params)
*
* This internal routine prints information about a buffered statistical series.
*
* Inputs:
*	params		pointer to the ZPRO_BUFFERED data structure.
*******************************************************************************/

static void	ZPro_PrintBuffered(params)
RL_VOID		*params;
{
ZPRO_BUFFERED	*buffered;

    buffered = (ZPRO_BUFFERED *) params;

    /* Make sure object is not NULL */
    if (buffered == NULL) {
	printf("PRINT ERROR: Buffered statistical series pointer is NULL\n");
	return;
    }

    /* Make sure object is a buffered statistical series */
    if (buffered->class.id != XPRO_BUFFERED_CLASS) {
	printf("PRINT ERROR: Object is not a buffered statistical series\n");
	return;
    }

    /* Print object info... */
    printf("\nBuffered statistical series parameters...\n");
    printf("stat series = "); XPro_PrintInfo(buffered->stat);
    printf("    samples = %d\n", buffered->samples);
    printf("  precision = %s\n", (buffered->isdouble ? "double" : "single"));
}

/*
********************************************************************************
* FORTRAN INTERFACE ROUTINES
********************************************************************************
*$ Component_name:
*	FPro_BufferedStat (buffered.c)
*$ Abstract:
*	This routine creates and returns a buffered statistical series.  A
*	buffered series duplicates the behavior of another series but saves
*	recently-accessed samples in memory so they do not have to be
*	re-calculated.
*$ Keywords:
*	PROFILE
*	C, PUBLIC, SUBROUTINE
*$ Declarations:
*	integer*4 function FPro_BufferedStat(stat, samples, usedouble)
*	integer*4	stat, samples
*	logical*4	usedouble
*$ Inputs:
*	stat		statistical series to buffer.
*	samples		minimum number of samples to retain (rounded up to the
*			nearest power of two).
*	usedouble	.TRUE. to store double-precision values; .FALSE. to
*			store single-precision values.
*$ Outputs:
*	none
*$ Returns:
*	FORTRAN pointer to a new buffered series object, or 0 on non-fatal
*	error.
*$ Detailed_description:
*	This routine creates and returns a buffered statistical series.  A
*	buffered series duplicates the behavior of another series but saves
*	recently-accessed samples in memory so they do not have to be
*	re-calculated.
*
*	The series is implemented by retaining in memory an array consisting
*	of exactly 2^n samples.  When the kth sample is requested, the routine
*	first checks to see if the sample stored in array location (k mod 2^n)
*	is the one desired.  If so, it returns this value.  Otherwise, it
*	evaluates the original series (to which it has retained a link) and
*	updates the stored value in the array.
*
*	For efficiency, the number of samples held in memory should be at least
*	as large as the number of coefficients in the largest filter that might
*	be convolved with the series.
*$ External_references:
*	Profile toolkit
*$ Side_effects:
*	Memory is allocated.  A link to the original statistical series is
*	created.
*$ Examples:
*	This line of code creates a buffered series in which 2000 samples are
*	retained internally in double precision.  In every other respect, this
*	series behaves identically to the original series.
*
*	buffered_stat = FPro_BufferedStat(original_stat, 2000, .TRUE.)
*
*$ Error_handling:
*	Profile library error handling is in effect.
*
*	Conditions raised:
*	RL_MEMORY_ERROR		on memory allocation failure.
*	PRO_CLASS_ERROR		if stat is NULL or is not a stat series.
*	FORTRAN_POINTER_ERROR	if stat is not a valid FORTRAN object pointer.
*$ Limitations:
*	None.  However, a substantial decrease in speed and efficiency occurs if
*	the user often requests series samples that are separated in index by
*	amounts larger than the size of the buffer.
*$ Author_and_institution:
*	Mark R. Showalter
*	NASA/Ames Research Center
*$ Version_and_date:
*	1.0: March 1998
*$ Change_history:
*	none
*******************************************************************************/

RL_INT4 FORTRAN_NAME(fpro_bufferedstat) (stat, samples, usedouble)
RL_INT4	*stat, *samples, *usedouble;
{
RL_VOID *ptr;
RL_INT4 index;

    /* Look up statistical series pointer */
    ptr = FORT_GetPointer(*stat);
    if (ptr == NULL) return 0;

    /* Create buffered statistical series */
    ptr = (RL_VOID *) Pro_BufferedStat((PRO_OBJECT *) ptr, *samples,
                                       (RL_BOOL) *usedouble);
    if (ptr == NULL) return 0;

    /* Return new pointer */
    index = FORT_AddPointer(ptr);
    if (index == 0) Pro_FreeObject((PRO_OBJECT *) ptr);

    return index;
}

/*******************************************************************************
*/