/* stat.c
********************************************************************************
* stat.c -- Routines for statistical series objects
*
* User routines
*	Pro_StatCovar()		returns the covariance of a pair of series
*				samples.
*	Pro_StatRange()		returns the range of samples correlated with a
*				a specified sample.
*
* Programmer routines
*	XPro_MakeStat()		used to create a new statistical series object.
*	XPro_StatPtr()		returns a pointer to the sub-object.
*
* Version 1.0: Original release.
*              Mark Showalter & Neil Heather, PDS Ring-Moon Systems Node, March 1998.
* Version 1.1: QUICK compilation mode and Pro_StatRange() function added.
*              Mark Showalter, January 2000
*******************************************************************************/
#include <stdio.h>
#include "profile.h"
#include "fortran.h"

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

typedef struct ZPRO_STAT_STRUCT {
    XPRO_CLASS	class;
    RL_FLT8	(*covarfunc) RL_PROTO((RL_VOID *pointer,
		                       RL_INT4 k1, RL_INT4 k2));
    void	(*rangefunc) RL_PROTO((RL_VOID *pointer, RL_INT4 k,
		                       RL_INT4 *k1, RL_INT4 *k2));
    RL_FLT8     (*evalfunc)  RL_PROTO((RL_VOID *pointer,
		                       RL_INT4 k, RL_INT4 *flag));
    void	(*freefunc)  RL_PROTO((RL_VOID *pointer));
    void	(*printfunc) RL_PROTO((RL_VOID *pointer));
} ZPRO_STAT;

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

static XPRO_CLASS stat_class = {XPRO_STAT_CLASS, "statistical", NULL};

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

static RL_FLT8    ZPro_EvalStat   RL_PROTO((RL_VOID *pointer, RL_INT4 k,
                                            RL_INT4 *flag));
static void       ZPro_FreeStat   RL_PROTO((RL_VOID *pointer));
static void       ZPro_PrintStat  RL_PROTO((RL_VOID *pointer));
static ZPRO_STAT *ZPro_GetStat    RL_PROTO((PRO_OBJECT *object));

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

#ifdef QUICK
#define ZPro_GetStat(object) ((ZPRO_STAT *) XPro_SeriesPtr(object))
#endif

/*
********************************************************************************
* EXPORTED USER ROUTINES
********************************************************************************
*$ Component_name:
*	Pro_StatCovar (stat.c)
*$ Abstract:
*	This routine returns the covariance between two samples in a statistical
*	series.
*$ Keywords:
*	PROFILE, SERIES
*	C, PUBLIC, SUBROUTINE
*$ Declarations:
*	RL_FLT8		Pro_StatCovar(object, k1, k2)
*	PRO_OBJECT	*object;
*	RL_INT4		k1, k2;
*$ Inputs:
*	object		pointer to a statistical series object.
*	k1, k2		sample indices for which to calculate covariance.
*$ Outputs:
*	none
*$ Returns:
*	value of the covariance between the given samples, or 0. on non-fatal
*	error.
*$ Detailed_description:
*	This routine returns the covariance between two samples in a statistical
*	series.  A statistical series extends the properties of a series by
*	the property that, given any pair of samples, it can evaluate the
*	statistical covariance between them.
*$ External_references:
*	Profile toolkit
*$ Side_effects:
*	none
*$ Examples:
*	Suppose stat is a statistical series comprising uncorrelated Poisson
*	random numbers of mean 100.
*
*	Then Pro_StatCovar(stat, k, k) returns 100. for k within the domain;
*	     Pro_StatCovar(stat, j, k) returns 0. for j != k.
*$ Error_handling:
*	Profile library error handling is in effect.
*
*	Conditions raised:
*	PRO_CLASS_ERROR		if object is NULL or is not a stat series.
*	PRO_DOMAIN_ERROR	if either sample index is outside the series'
*				domain.
*$ Limitations:
*	none
*$ Author_and_institution:
*	Mark R. Showalter
*	NASA/Ames Research Center
*$ Version_and_date:
*	1.0: March 1998
*	1.1: October 1999
*$ Change_history:
*	1.1: QUICK mode compile option added.
*******************************************************************************/

RL_FLT8		Pro_StatCovar(object, k1, k2)
PRO_OBJECT	*object;
RL_INT4		k1, k2;
{
ZPRO_STAT	*stat;
RL_INT4		klo, khi;

    stat = ZPro_GetStat(object);
#ifndef QUICK
    if (stat == NULL) return 0.;
#endif

    /* Make sure indices are inside domain */
    (void) Pro_SeriesIndices(object, &klo, &khi);
    if (k1 < klo || k1 > khi) {
	XPro_IDomainError("index #1", object, klo, khi, k1);
	return 0.;
    }

    if (k2 < klo || k2 > khi) {
	XPro_IDomainError("index #2", object, klo, khi, k2);
	return 0.;
    }

    /* Otherwise evaluate covariance */
    return (stat->covarfunc)(stat->class.pointer, k1, k2);
}

/*
********************************************************************************
*$ Component_name:
*	Pro_StatRange (stat.c)
*$ Abstract:
*	This routine returns the range of indices in a series where samples
*	might have a nonzero covariance with a given sample.
*$ Keywords:
*	PROFILE, SERIES
*	C, PUBLIC, SUBROUTINE
*$ Declarations:
*	RL_INT4		Pro_StatRange(object, k, k1, k2)
*	PRO_OBJECT	*object;
*	RL_INT4		k, *k1, *k2;
*$ Inputs:
*	object		pointer to a statistical series object.
*	k		index at which to evaluate range of correlated samples.
*$ Outputs:
*	k1, k2		range of sample indices for which the covariance might
*			be nonzero.
*$ Returns:
*	size of range returned, i.e. k2-k1+1, or zero on non-fatal error.
*$ Detailed_description:
*	This routine returns the range of indices in a series where samples
*	might have a nonzero covariance with a given sample.
*$ External_references:
*	Profile toolkit
*$ Side_effects:
*	none
*$ Examples:
*	Suppose stat is a statistical series comprising uncorrelated samples.
*
*	Then Pro_StatRange(stat, k, &k1, &k2) returns 1 and sets k1=k; k2=k.
*$ Error_handling:
*	Profile library error handling is in effect.
*
*	Conditions raised:
*	PRO_CLASS_ERROR		if object is NULL or is not a stat series.
*	PRO_DOMAIN_ERROR	if either sample index is outside the series'
*				domain.
*$ Limitations:
*	none
*$ Author_and_institution:
*	Mark R. Showalter
*	NASA/Ames Research Center
*$ Version_and_date:
*	1.1: January 2000
*$ Change_history:
*	none
*******************************************************************************/

RL_INT4		Pro_StatRange(object, k, k1, k2)
PRO_OBJECT	*object;
RL_INT4		k, *k1, *k2;
{
ZPRO_STAT	*stat;
RL_INT4		klo, khi;

    stat = ZPro_GetStat(object);
#ifndef QUICK
    if (stat == NULL) return 0;
#endif

    /* Make sure index is inside domain */
    (void) Pro_SeriesIndices(object, &klo, &khi);
    if (k < klo || k > khi) {
	XPro_IDomainError("index #1", object, klo, khi, k);
	return 0;
    }

    /* Otherwise evaluate covariance range */
    (stat->rangefunc)(stat->class.pointer, k, k1, k2);

    if (*k1 < klo) *k1 = klo;
    if (*k2 > khi) *k2 = khi;
    return (*k2 - *k1 + 1);
}

/*
*******************************************************************************
* PROGRAMMER ROUTINES
********************************************************************************
* XPro_MakeStat(k1, k2, x1, dx, evalfunc, covarfunc, rangefunc, freefunc,
*               printfunc, pointer)
*
* This routine creates and initializes a statistical series object.
*
* Inputs:
*	k1, k2		index limits.
*	x1		minimum X value, corresponding to first sample.
*	dx		x-interval between consecutive samples.
*	evalfunc	routine to evaluate series.
*	covarfunc	routine to evaluate covariance.
*	rangefunc	routine to evaluate nonzero covariance sample range.
*	freefunc	routine to free data structure.
*	printfunc	routine to print series data structure
*	pointer		pointer to an arbitrary data structure describing the
*			series.
*
* Returns:		new statistical series object.
*
* Errors:
*	RL_MEMORY_ERROR	on memory allocation failure.
*******************************************************************************/

PRO_OBJECT	*XPro_MakeStat(k1, k2, x1, dx, evalfunc, covarfunc, rangefunc,
		               freefunc, printfunc, pointer)
RL_INT4		k1, k2;
RL_FLT8		x1, dx;
RL_FLT8		(*evalfunc)  RL_PROTO((RL_VOID *pointer, RL_INT4 k,
		                       RL_INT4 *flag));
RL_FLT8		(*covarfunc) RL_PROTO((RL_VOID *pointer, RL_INT4 k1,
		                       RL_INT4 k2));
void		(*rangefunc) RL_PROTO((RL_VOID *pointer, RL_INT4 k,
		                       RL_INT4 *k1, RL_INT4 *k2));
void		(*freefunc)  RL_PROTO((RL_VOID *pointer));
void		(*printfunc) RL_PROTO((RL_VOID *pointer));
RL_VOID		*pointer;
{
ZPRO_STAT	*stat;
PRO_OBJECT	*new;

    /* Allocate new statistical series structure */
    stat = (ZPRO_STAT *) XRL_Malloc(sizeof(ZPRO_STAT));
    if (stat == NULL) return NULL;

    /* Initialize structure */
    stat->class = stat_class;
    stat->class.pointer = pointer;

    stat->evalfunc  = evalfunc;
    stat->covarfunc = covarfunc;
    stat->rangefunc = rangefunc;
    stat->freefunc  = freefunc;
    stat->printfunc = printfunc;

    /* Create new series object */
    new = XPro_MakeSeries(k1, k2, x1, dx,
		          ZPro_EvalStat, ZPro_FreeStat, ZPro_PrintStat,
                          (RL_VOID *) stat);
    return new;
}

/*
*******************************************************************************
* XPro_StatPtr(object)
*
* This routine returns a pointer to the statistical series sub-object.
*
* Inputs:
*	object		statistical series object.
*
* Return:		pointer field of the object; NULL on error.
*
* Errors:
*	PRO_CLASS_ERROR		if the object is NULL or not a stat series.
*******************************************************************************/

#ifndef QUICK	/* In QUICK mode, this is defined as a macro in profile.h */

RL_VOID        	*XPro_StatPtr(object)
PRO_OBJECT     	*object;
{
ZPRO_STAT	*stat;

    stat = ZPro_GetStat(object);
    if (stat == NULL) return NULL;

    if (stat->class.pointer == NULL)
	XPro_NullError("statistical series sub-object", object);

    return stat->class.pointer;
}

#endif

/*
*******************************************************************************
* INTERNAL ROUTINES
********************************************************************************
* ZPro_EvalStat(pointer, k, flag)
*
* This internal routine evaluates the value of a statistical series.  It serves
* as the standard "evalfunc" for the parent series object.
*
* Inputs:
*	pointer		pointer to the ZPRO_STAT structure.
*	k		index at which to evaluate series.
*
* Outputs:
*	*flag		flag value of series.
*
* Returns:		value of series at k.
*******************************************************************************/

static RL_FLT8	ZPro_EvalStat(pointer, k, flag)
RL_VOID		*pointer;
RL_INT4		k, *flag;
{
ZPRO_STAT	*stat;
RL_FLT8		value;

    stat = (ZPRO_STAT *) pointer;
    value = (stat->evalfunc)(stat->class.pointer, k, flag);

    return value;
}

/*
*******************************************************************************
* ZPro_FreeStat(pointer)
*
* This internal routine deallocates the memory used by a statistical series
* object.  It serves as the standard "freefunc" for the parent series object.
*
* Input:
*	pointer		pointer to the ZPRO_STAT structure.
*******************************************************************************/

static void	ZPro_FreeStat(pointer)
RL_VOID		*pointer;
{
ZPRO_STAT	*stat;

    stat = (ZPRO_STAT *) pointer;

    (stat->freefunc)(stat->class.pointer);
    XRL_Free(stat);
}

/*
*******************************************************************************
* ZPro_PrintStat(pointer)
*
* This internal routine prints information about a statistical series object.
* It serves as the standard "printfunc" for the parent function object.
*
* Input:
*	pointer		pointer to the ZPRO_STAT structure.
*******************************************************************************/

static void	ZPro_PrintStat(pointer)
RL_VOID		*pointer;
{
ZPRO_STAT	*stat;
RL_INT4		i;
RL_CHAR		*type;

    stat = (ZPRO_STAT *) pointer;

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

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

    /* No object info to print at this level */

    /* Print more detailed info */
    (stat->printfunc)(stat->class.pointer);

    return;
}

/*
*******************************************************************************
* ZPro_GetStat(object)
*
* This internal routine confirms that the given object is a statistical series
* and returns a pointer to the ZPRO_STAT data structure.
*
* Input:
*	object		statistical series object.
*
* Errors:
*	PRO_CLASS_ERROR		if object is NULL or is not a stat series.
*******************************************************************************/

#ifndef QUICK	/* In QUICK mode, this is defined as a macro above */

static ZPRO_STAT *ZPro_GetStat(object)
PRO_OBJECT	*object;
{
ZPRO_STAT	*stat;

    /* Find statistical series object pointer */
    stat = (ZPRO_STAT *) XPro_SeriesPtr(object);

    /* Make sure object is a statistical series */
    if (stat->class.id != XPRO_STAT_CLASS) {
	XPro_ClassError("statistical series", object);
	return NULL;
    }

    return stat;
}

#endif

/*
********************************************************************************
* FORTRAN INTERFACE ROUTINES
********************************************************************************
*$ Component_name:
*	FPro_StatCovar (stat.c)
*$ Abstract:
*	This routine returns the covariance between two samples in a statistical
*	series.
*$ Keywords:
*	PROFILE, SERIES
*	FORTRAN, PUBLIC, SUBROUTINE
*$ Declarations:
*	real*8 function FPro_StatCovar(object, k1, k2)
*	integer*4	object
*	integer*4	k1, k2
*$ Inputs:
*	object		FORTRAN pointer to a statistical series object.
*	k1, k2		sample indices for which to calculate covariance.
*$ Outputs:
*	none
*$ Returns:
*	value of the covariance between the given samples, or 0. on non-fatal
*	error.
*$ Detailed_description:
*	This routine returns the covariance between two samples in a statistical
*	series.  A statistical series extends the properties of a series by
*	the property that, given any pair of samples, it can evaluate the
*	statistical covariance between them.
*$ External_references:
*	Profile toolkit
*$ Side_effects:
*	none
*$ Examples:
*	Suppose stat is a statistical series comprising uncorrelated Poisson
*	random numbers of mean 100.
*
*	Then FPro_StatCovar(stat, k, k) returns 100.d0 for k within the domain;
*	     FPro_StatCovar(stat, j, k) returns 0.d0 for j != k.
*$ Error_handling:
*	Profile library error handling is in effect.
*
*	Conditions raised:
*	PRO_CLASS_ERROR		if object is NULL or is not a stat series.
*	PRO_DOMAIN_ERROR	if either sample index is outside the series'
*				domain.
*	FORTRAN_POINTER_ERROR	if object is not a valid FORTRAN object pointer.
*$ Limitations:
*	none
*$ Author_and_institution:
*	Mark R. Showalter
*	NASA/Ames Research Center
*$ Version_and_date:
*	1.0: March 1998
*	1.1: October 1999
*$ Change_history:
*	1.1: QUICK mode compile option added.
*******************************************************************************/

RL_FLT8 FORTRAN_NAME(fpro_statcovar) (object, k1, k2)
RL_INT4 *object;
RL_INT4 *k1, *k2;
{
RL_VOID	*ptr;

    /* Look up statistical series pointer */
    ptr = FORT_GetPointer(*object);
#ifndef QUICK
    if (ptr == NULL) return 0.;
#endif

    /* Call function */
    return Pro_StatCovar((PRO_OBJECT *) ptr, *k1, *k2);
}

/*
********************************************************************************
*$ Component_name:
*	FPro_StatRange (stat.c)
*$ Abstract:
*	This routine returns the range of indices in a series where samples
*	might have a nonzero covariance with a given sample.
*$ Keywords:
*	PROFILE, SERIES
*	FORTRAN, PUBLIC, SUBROUTINE
*$ Declarations:
*	real*4 function FPro_StatRange(object, k, k1, k2)
*	integer*4	object
*	integer*4	k1, k2
*$ Inputs:
*	object		FORTRAN pointer to a statistical series object.
*	k		index at which to evaluate range of correlated samples.
*$ Outputs:
*	k1, k2		range of sample indices for which the covariance might
*			be nonzero.
*$ Returns:
*	size of range returned, i.e. k2-k1+1, or zero on non-fatal error.
*$ Detailed_description:
*	This routine returns the range of indices in a series where samples
*	might have a nonzero covariance with a given sample.
*$ External_references:
*	Profile toolkit
*$ Side_effects:
*	none
*$ Examples:
*	Suppose stat is a statistical series comprising uncorrelated samples.
*
*	Then FPro_StatRange(stat, k, k1, k2) returns 1 and sets k1=k; k2=k.
*$ Error_handling:
*	Profile library error handling is in effect.
*
*	Conditions raised:
*	PRO_CLASS_ERROR		if object is NULL or is not a stat series.
*	PRO_DOMAIN_ERROR	if either sample index is outside the series'
*				domain.
*$ Limitations:
*	none
*$ Author_and_institution:
*	Mark R. Showalter
*	NASA/Ames Research Center
*$ Version_and_date:
*	1.1: January 2000
*$ Change_history:
*	none
*******************************************************************************/

RL_INT4 FORTRAN_NAME(fpro_statrange) (object, k, k1, k2)
RL_INT4 *object;
RL_INT4 *k, *k1, *k2;
{
RL_VOID	*ptr;

    /* Look up statistical series pointer */
    ptr = FORT_GetPointer(*object);
#ifndef QUICK
    if (ptr == NULL) return 0.;
#endif

    /* Call function */
    return Pro_StatRange((PRO_OBJECT *) ptr, *k, k1, k2);
}

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