/* inverse.c
********************************************************************************
* inverse.c -- routines for inverse curve objects
*
* User routines:
*	Pro_InverseCurve()	creates a new curve object that returns the
*				inverse of another curve object.
*
* Mark Showalter, PDS Ring-Moon Systems Node, March 1998
*******************************************************************************/
#include <math.h>
#include <stdio.h>
#include <string.h>
#include "profile.h"
#include "fortran.h"

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

typedef struct ZPRO_INVERSE_STRUCT {
    XPRO_CLASS	class;
    PRO_OBJECT	*curve;
    RL_INT4	segment;
    RL_FLT8	x1, x2, y1, y2, xmin, xmax, ymin, ymax;
} ZPRO_INVERSE;

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

static XPRO_CLASS inverse_class = {XPRO_INVERSE_CLASS, "inverse", NULL};

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

static RL_FLT8 ZPro_EvalInverse	  RL_PROTO((RL_VOID *pointer, RL_FLT8 x,
                                            RL_FLT8 *slope));
static RL_FLT8 ZPro_InvertInverse RL_PROTO((RL_VOID *pointer, RL_FLT8 y,
                                            RL_FLT8 x1, RL_FLT8 x2));
static void    ZPro_FreeInverse   RL_PROTO((RL_VOID *pointer));
static void    ZPro_PrintInverse  RL_PROTO((RL_VOID *pointer));

/*
********************************************************************************
* EXPORTED USER ROUTINES
********************************************************************************
*$ Component_name:
*	Pro_InverseCurve (inverse.c)
*$ Abstract:
*	This routine generates a new curve function that returns the inverse of
*	a given curve.
*$ Keywords:
*	PROFILE, FUNCTION, CURVE
*	C, PUBLIC, SUBROUTINE
*$ Declarations:
*	PRO_OBJECT	*Pro_InverseCurve(object, segment)
*	PRO_OBJECT	*object;
*	RL_INT4		segment;
*$ Inputs:
*	object		pointer to the curve object to invert.
*	segment		index of segment to invert.
*$ Outputs:
*	none
*$ Returns:
*	pointer to a new inverse curve object, or NULL on non-fatal error.
*$ Detailed_description:
*	This routine generates a new curve function that returns the inverse of
*	a given curve.
*$ External_references:
*	Profile toolkit
*$ Side_effects:
*	Memory is allocated.  The new inverse curve retains a link to the old.
*$ Examples:
*	Suppose square is a curve that returns x squared between -4. and 4.
*	Then Pro_InverseCurve(square, 1) returns a curve that does the
*	following:
*		0. <= x <= 16.		return -(square root of x);
*		x < 0.			raise PRO_DOMAIN_ERROR and return 0.;
*		x > 16.			raise PRO_DOMAIN_ERROR and return -4.
*$ Error_handling:
*	Profile library error handling is in effect.
*
*	Conditions raised:
*	PRO_CLASS_ERROR		if object is NULL or is not a curve.
*	PRO_DOMAIN_ERROR	if the segment index is out of range.
*	RL_MEMORY_ERROR		on memory allocation error.
*$ Limitations:
*	none
*$ Author_and_institution:
*	Mark R. Showalter
*	NASA/Ames Research Center
*$ Version_and_date:
*	1.0: March 1998
*$ Change_history:
*	none
*******************************************************************************/

PRO_OBJECT	*Pro_InverseCurve(object, segment)
PRO_OBJECT	*object;
RL_INT4		segment;
{
PRO_OBJECT	*new;
ZPRO_INVERSE	*inverse;
RL_INT4		nsegments;

    /* Check curve and segment index */
    nsegments = Pro_CurveSegments(object);
    if (nsegments < 1) return NULL;

    if (segment < 1 || segment > nsegments) {
	XPro_IDomainError("segment index", object, 1, nsegments, segment);
	return NULL;
    }

    /* Allocate data structure */
    inverse = (ZPRO_INVERSE *) XRL_Malloc(sizeof(ZPRO_INVERSE));
    if (inverse == NULL) return NULL;

    /* Initialize data structure */
    inverse->class   = inverse_class;
    inverse->curve   = object;
    inverse->segment = segment;

    /* Locate range endpoints
     * xmin = x-value at segment minimum; ymin = minimum value;
     * xmax = x-value at segment maximum; ymax = maximum value;
     */
    inverse->ymin = Pro_CurveExtremum(object, segment-1, &(inverse->xmin),
                                      NULL);
    inverse->ymax = Pro_CurveExtremum(object, segment,   &(inverse->xmax),
                                      NULL);

    /* Locate domain end points
     * x1 = minimum x; y1 = func(x1)
     * x2 = maximum x; y2 = func(x2)
     */
    if (inverse->xmin < inverse->xmax) {
	inverse->x1 = inverse->xmin; inverse->y1 = inverse->ymin;
	inverse->x2 = inverse->xmax; inverse->y2 = inverse->ymax;
    }
    else {
	inverse->x1 = inverse->xmax; inverse->y1 = inverse->ymax;
	inverse->x2 = inverse->xmin; inverse->y2 = inverse->ymin;
    }

    /* Create object */
    new = XPro_MakeCurve(inverse->x1, inverse->x2,
		0, NULL,					/* no extrema */
		ZPro_EvalInverse, ZPro_InvertInverse, ZPro_FreeInverse,
		ZPro_PrintInverse, (RL_VOID *) inverse);

    /* Enslave original curve and check for errors */
    if (new != NULL && XPro_EnslaveObject(new, object)) {
	Pro_FreeObject(new);
	new = NULL;
    }

    /* Transfer coordinate names to new inverse curve */
    Pro_RenameObject(new, 1, Pro_ObjectName(object,2));
    Pro_RenameObject(new, 2, Pro_ObjectName(object,1));

    return new;
}

/*
********************************************************************************
* INTERNAL ROUTINES
********************************************************************************
* ZPro_EvalInverse(pointer, x, slope)
*
* This internal routine calculates the value of an inverse curve.
*
* Inputs:
*	pointer		pointer to the ZPRO_INVERSE data structure.
*	x		location at which to evaluate inverse curve.
*	*slope		slope of inverse curve at x.
*
* Return:		value of inverse curve at x.
*
* Errors:
*	PRO_EVALUATION_FAILURE	if curve could not be inverted.
*******************************************************************************/

static RL_FLT8	ZPro_EvalInverse(pointer, x, slope)
RL_VOID		*pointer;
RL_FLT8		x, *slope;
{
ZPRO_INVERSE	*inverse;
RL_FLT8		value, temp;

    inverse = (ZPRO_INVERSE *) pointer;
    value = Pro_CurveInverse(inverse->curve, inverse->segment, x);

    if (slope != NULL) {
	(void) Pro_CurveValue(inverse->curve, value, &temp);
	if (temp != 0.)                     *slope =  1. / temp;
	else if (inverse->y2 > inverse->y1) *slope =  HUGE_VAL;
	else                                *slope = -HUGE_VAL;
    }

    return value;
}

/*
********************************************************************************
* ZPro_InvertInverse(pointer, y, x1, x2)
*
* This internal routine calculates the inverse of an inverse curve.
*
* Inputs:
*	pointer		pointer to the ZPRO_INVERSE data structure.
*	y		location at which to evaluate inverse curve's inverse.
*	x1, x2		limits on the search for the inverse.
*
* Return:		location at which the value of the inverse curve is y.
*
* Errors:
*	PRO_EVALUATION_FAILURE	if inverse value could not be found.  In this
*				situation, the nearest endpoint is returned.
*******************************************************************************/

static RL_FLT8	ZPro_InvertInverse(pointer, y, x1, x2)
RL_VOID		*pointer;
RL_FLT8		y, x1, x2;
{
ZPRO_INVERSE	*inverse;
RL_FLT8		value, slope;

    inverse = (ZPRO_INVERSE *) pointer;

    /* Check that solution may exist */
    if (y < inverse->ymin || y > inverse->ymax) {
	(void) sprintf(xpro_message, "function evalation failure\n\
unable to invert curve\n\
seeking f(x) = %#g where x is in [%#g,%#g]", y, x1, x2);
	RL_RaiseError("PRO_EVALUATION_FAILURE", xpro_message);

	if (y < inverse->ymin) return inverse->xmin;
	else                   return inverse->xmax;
    }

    /* Evaluate curve */
    value = Pro_CurveValue(inverse->curve, y, &slope);

    /* Check that solution is within desired interval */
    if (value < x1 || value > x2) {
	(void) sprintf(xpro_message, "function evaluation failure\n\
unable to invert curve\n\
seeking f(x) = %#g where x is in [%#g,%#g]", y, x1, x2);
	RL_RaiseError("PRO_EVALUATION_FAILURE", xpro_message);

	if (value < x1) return x1;
	else            return x2;
    }

    return value;
}

/*
********************************************************************************
* ZPro_FreeInverse(pointer)
*
* This internal routine frees the memory used by a ZPRO_INVERSE structure.
*
* Inputs:
*	pointer		pointer to the ZPRO_INVERSE data structure.
*******************************************************************************/

static void	ZPro_FreeInverse(pointer)
RL_VOID		*pointer;
{
    XRL_Free((RL_VOID *) pointer);
}

/*
********************************************************************************
* ZPro_PrintInverse(pointer)
*
* This internal routine prints out information about an inverse curve.  It is
* called by Pro_PrintInverse() and is used mainly for debugging.
*
* Input:
*	pointer		pointer to the ZPRO_INVERSE structure.
*******************************************************************************/

static void	ZPro_PrintInverse(pointer)
RL_VOID        	*pointer;
{
ZPRO_INVERSE	*inverse;

    inverse = (ZPRO_INVERSE *) pointer;

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

    /* Make sure object is an inverse curve */
    if (inverse->class.id != XPRO_INVERSE_CLASS) {
	printf("PRINT ERROR: Object is not an inverse function\n");
	return;
    }

    /* Print object info... */
    printf("\nInverse curve parameters...\n");

    printf("    curve = ");  XPro_PrintInfo(inverse->curve);
    printf("  segment = %1d\n", inverse->segment);
    printf("   domain = [%#g,%#g]\n", inverse->x1, inverse->x2);
    printf("    range = [%#g,%#g]\n", inverse->y1, inverse->y2);
}

/*
********************************************************************************
*$ Component_name:
*	FPro_InverseCurve (inverse.c)
*$ Abstract:
*	This routine generates a new curve function that returns the inverse of
*	a given curve.
*$ Keywords:
*	PROFILE, FUNCTION, CURVE
*	C, PUBLIC, SUBROUTINE
*$ Declarations:
*	integer*4 function FPro_InverseCurve(object, segment)
*	integer*4	object, segment
*$ Inputs:
*	object		FORTRAN pointer to curve to invert.
*	segment		index of segment to invert.
*$ Outputs:
*	none
*$ Returns:
*	FORTRAN pointer to a new curve object, or 0 on non-fatal error.
*$ Detailed_description:
*	This routine generates a new curve function that returns the inverse of
*	a given curve.
*$ External_references:
*	Profile toolkit
*$ Side_effects:
*	Memory is allocated.  The new inverse curve retains a link to the old.
*$ Examples:
*	Suppose square is a curve that returns x squared between -4.d0 and 4.d0.
*	Then FPro_InverseCurve(square, 1) returns a curve that does the
*	following:
*		0.d0 <= x <= 16.d0	return -(square root of x);
*		x < 0.d0		raise PRO_DOMAIN_ERROR and return 0.d0;
*		x > 16.d0		raise PRO_DOMAIN_ERROR and return -4.d0.
*$ Error_handling:
*	Profile library error handling is in effect.
*
*	Conditions raised:
*	PRO_CLASS_ERROR		if object is NULL or is not a curve.
*	PRO_DOMAIN_ERROR	if the segment index is out of range.
*	RL_MEMORY_ERROR		on memory allocation error.
	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
*$ Change_history:
*	none
*******************************************************************************/

RL_INT4 FORTRAN_NAME(fpro_inversecurve) (object, segment)
RL_INT4 *object, *segment;
{
RL_VOID *ptr1, *ptr2;
RL_INT4 index;

    /* Look up curve pointer */
    ptr1 = FORT_GetPointer(*object);
    if (ptr1 == NULL) return 0;

    /* Call function */
    ptr2 = (RL_VOID *) Pro_InverseCurve((PRO_OBJECT *) ptr1, *segment);
    if (ptr2 == NULL) return 0;

    /* Save new pointer */
    index = FORT_AddPointer(ptr2);
    if (index == 0) Pro_FreeObject((PRO_OBJECT *) ptr2);

    return index;
}

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