campo-sirio/gfm/compaux.c

/* DEC	*_CompoundAux(fun, nperi, nperd, intr, pv, pmt,	fv, begend, opt)
 *
 * ARGUMENT
 *	int	fun, *nperi, begend, opt;
 *	DEC	*nperd,	*intr, *pv, *pmt, *fv;
 *
 * DESCRIPTION
 *	Given four variables involved in compound interest, solves for the
 *  fifth one.	The variables are the number of	periods	nper, the percentage
 *  interest rate per period intr, the present value pv, the periodic payment
 *  pmt, and the future	value fv.  begend specifies whether payments take
 *  place at the beginning or the end of each month, while opt tells which
 *  variable to	solve for.
 *	This auxillary function	does the work of CompoundInterest,
 *  CompoundInterestSimple, CompoundInterestCompound,
 *  and	AdvancePayment.
 *
 * SIDE	EFFECTS
 *	Changes	value of unknown variable.
 *
 * RETURNS
 *	In case	of success when	not solving for	nper, the result is returned.
 *  If solving for nper	or if an error occurs, GM_NULL is returned.
 *
 * POSSIBLE ERRORS
 *	GM_NULLPOINTER
 *	GM_ARGVAL
 *
 *
 *
 * AUTHOR
 *  Jared Levy
 *   Copyright (C) 1988-1990 Greenleaf Software	Inc.  All rights reserved.
 *
 * ALGORITHM
 *	Solve the following formula for	the unknown variable:
 *  0=pv*alpha + (1+intr*begend)*pmt*[1-(1+intr)^-int(nper)]/intr +
 *	 fv*(1+intr)^-int(nper)
 *  where alpha=1 for no odd period,
 *	  alpha=1+intr*frac(nper) for an odd period with simple	interest
 *	  alpha=(1+intr)^frac(nper) for	an odd period with compound interest
 *
 *  If intr==0,	the function solves
 *	0 = pv + nper *	pmt + fv
 *  If nper==0,	the function solves
 *	0 = pv * alpha + fv
 *
 *  The	equation can be	solved in closed form for any variable except intr,
 *  which requires numerical methods.
 *  The	variables used by this routine have the	following meanings:
 *	fun:   1 if called by ComoundInterest, 2 if by CompoundInterestSimple,
 *		3 if by	CompoundInterestCompound, and 0	if by AdvancePayment
 *	nperi: integer number of periods if fun==1
 *	nperd: DEC number of periods if	fun==2 or fun==3
 *	intr:  interest	rate per period
 *	pv:    present value
 *	pmt:   period payment
 *	fv:    future value (balloon payment)
 *	begend:	GM_BEGIN if payments at	beginning of period, GM_END if at end
 *		(or if fun==0, number of advanced payments ad)
 *	opt:   variable	to solve for: GM_N, GM_PV, GM_INTR, GM_FV, GM_PMT
 *
 *	opi:   1 + intr
 *	intper:	integer	part of	nper
 *	fractper: fractional part of nper (if fun==2 or	fun==3)
 *	opitmn:	(1 + intr) ^ -intper
 *	mess: (1 + begend)[1 - (1 + intr) ^ -intper]/intr
 *	alpha: 1 + intr	* fractper if fun==2, (1 + intr) ^ fractper if fun==3
 *	pva:   pv * alpha
 *	fvopi: fv * opitmn
 *	pmtm:  pmt * mess
 *	temp, temp2: temporary DEC's
 */

#include <stdio.h>
#include "gm.h"
#include "gmsystem.h"

DEC	*_CompoundAux(fun, nperi, nperd, intr, pv, pmt,	fv, begend, opt)
int	fun, *nperi, begend, opt;
DEC	*nperd,	*intr, *pv, *pmt, *fv;
{
	int	intper,	ad;
	DEC	dopi, *opi=&dopi, dfractper, *fractper=&dfractper;
	DEC	dmess, *mess=&dmess, dalpha, *alpha=&dalpha;
	DEC	dpva, *pva=&dpva, dfvopi, *fvopi=&dfvopi;
	DEC	dpmtm, *pmtm=&dpmtm, dopitmn, *opitmn=&dopitmn;
	DEC	dtemp, *temp=&dtemp, dtemp2, *temp2=&dtemp2;
	DEC	dnintr,	*nintr=&dnintr;
	DEC	ddad, *dad=&ddad, dopitmna, *opitmna=&dopitmna;


	if (!intr||!pv||!pmt||!fv||!nperd)  {
		_MacErr(GM_NULLPOINTER);
		return(GM_NULL);
	}
	if ((opt!=GM_I && _MacBad(intr)) || (opt!=GM_PV	&& _MacBad(pv))	||
	    (opt!=GM_PMT && _MacBad(pmt)) || (opt!=GM_FV && _MacBad(fv))) {
		    _MacErr(GM_INIT);
		    return(GM_NULL);
	    }

	if ((begend!=GM_BEGIN&&begend!=GM_END&&fun!=0)||
		(opt!=GM_N&&opt!=GM_I&&opt!=GM_PV&&opt!=GM_PMT&&opt!=GM_FV)||
		(opt!=GM_I&&CompareDecimal(intr,&decMinusHundred)!=1))	{
		_MacErr(GM_ARGVAL);
		return(GM_NULL);
	}

	intper = 0;
	ad = begend;

	if (opt!=GM_N)	{
/* determine integer & fractional parts	of nper, if in range */
		if (fun<=1)  {
			if (*nperi<0)  {
				_MacErr(GM_ARGVAL);
				return(GM_NULL);
			}
			intper=*nperi;
		}
		else {
			if (_MacIsDecN(nperd)||
				(CompareDecimal(nperd,&decMaxTime)==1))	{
				_MacErr(GM_ARGVAL);
				return(GM_NULL);
			}
			(void) _TruncateDec80Bit(temp, nperd, 0);
			intper=temp->dc.sl[0];
			(void) _SubDec80Bit(fractper, nperd, temp);
		}
	}

	if (opt==GM_I)	{
		opi=_InterestAux(fun, intper, fractper,
			intr, pv, pmt, fv, begend);
		return(opi);
	}

	_MacDCopy(nintr, intr);
	nintr->dc.id+=2;

/* opi = 1+i */
	(void) _AddDec80Bit(opi, nintr,	&decOne);

	if (opt!=GM_N)	{
/* handle zero interest	*/
		if (_MacIsDecZ(intr))  {
			(void) ConvLongToDecimal(temp2,	(long) intper);

			if (opt==GM_PV)	 {
				(void) _MulDec80Bit(temp, temp2, pmt);
				(void) _AddDec80Bit(temp, temp,	fv);
				_MacDChgs(temp);
				(void) _ScaleDec80Bit(pv, temp,	2);
				return(pv);
			}

			if (opt==GM_FV)	 {
				(void) _MulDec80Bit(temp, temp2, pmt);
				(void) _AddDec80Bit(temp, temp,	pv);
				_MacDChgs(temp);
				(void) _ScaleDec80Bit(fv, temp,	2);
				return(fv);
			}

			if (opt==GM_PMT)  {
				if (intper==0)	{
					_MacErr(GM_ARGVAL);
					return(GM_NULL);
				}
				(void) _AddDec80Bit(temp, pv, fv);
				_MacDChgs(temp);
				(void) _DivRndDec80Bit(pmt, temp, temp2, 2);
				return(pmt);
			}
		}

/* calculate alpha */
		if (fun==2)  {
			(void) _MulDec80Bit(temp, nintr, fractper);
			(void) _AddDec80Bit(alpha, temp, &decOne);
		}
		if (fun==3)  {
			(void) _LnDec80Bit(temp, opi);
			(void) _MulDec80Bit(temp, temp,	fractper);
			(void) _ExpDec80Bit(alpha, temp);
		}

/* handle zero nper */
		if (intper==0)	{
			if (opt==GM_PMT)  {
				_MacErr(GM_ARGVAL);
				return(GM_NULL);
			}

			if (opt==GM_PV)	 {
				if (fun<=1)
					(void) _ScaleDec80Bit(pv, fv, 2);
				else
					(void) _DivRndDec80Bit(
						pv, fv,	alpha, 2);
				_MacDChgs(pv);
				return(pv);
			}

			if (opt==GM_FV)	 {
				if (fun<=1)
					(void) _ScaleDec80Bit(fv, pv, 2);
				else  {
					(void) _MulDec80Bit(fv,	pv, alpha);
					(void) _ScaleDec80Bit(fv, fv, 2);
				}
				_MacDChgs(fv);
				return(fv);
			}
		}

/* calcuate (1+i)^-n and (1+iS)[1-(1+i)^-n]/i */
		(void) _IntPwrDec80Bit(opitmn, opi, -intper);
		(void) _SubDec80Bit(temp, &decOne, opitmn);

/* Advance payment needs (1+i)^-(n-a) */
		if (fun==0)  {
			(void) _IntPwrDec80Bit(opitmna,	opi, -(intper-ad));
			(void) _SubDec80Bit(temp, &decOne, opitmna);
			(void) ConvLongToDecimal(dad, (long) ad);
		}
		else
		(void) _SubDec80Bit(temp, &decOne, opitmn);

		(void) _DivDec80Bit(mess, temp,	nintr);
		if (begend==GM_BEGIN &&	fun!=0)
			(void) _MulDec80Bit(mess, mess,	opi);

		if ((opt==GM_PMT||opt==GM_FV))	{
			if (fun>1)
				(void) _MulDec80Bit(pva, pv, alpha);
			if (fun<=1)
				_MacDCopy(pva, pv);
		}

		/* calculate FV*(1+i)^-n */
		if (opt==GM_PV||opt==GM_PMT)
			(void) _MulDec80Bit(fvopi, fv, opitmn);

		if (opt==GM_PV||opt==GM_FV)
			(void) _MulDec80Bit(pmtm, pmt, mess);

		if (opt==GM_PV)	 {
			(void) _AddDec80Bit(temp, pmtm,	fvopi);
			_MacDChgs(temp);
			if (fun>1)
				(void) _DivRndDec80Bit(pv, temp, alpha,	2);
			if (fun==1)
				(void) _ScaleDec80Bit(pv, temp,	2);
			if (fun==0)  {
				(void) _MulDec80Bit(temp2, dad,	pmt);
				(void) _SubDec80Bit(temp, temp,	temp2);
				(void) _ScaleDec80Bit(pv, temp,	2);
			}
			return(pv);
		}

		if (opt==GM_PMT)  {
			(void) _AddDec80Bit(temp, pva, fvopi);
			_MacDChgs(temp);
			if (fun==0)
				(void) _AddDec80Bit(mess, mess,	dad);
			(void) _DivRndDec80Bit(pmt, temp, mess,	2);
			return(pmt);
		}

		if (opt==GM_FV)	 {
			if (fun==0)  {
				(void) _MulDec80Bit(temp, pmt, dad);
				(void) _AddDec80Bit(pva, pv, temp);
			}
			(void) _AddDec80Bit(temp, pva, pmtm);
			_MacDChgs(temp);
			(void) _DivRndDec80Bit(fv, temp, opitmn, 2);
			return(fv);
		}
	}

	/* opt==GM_N */
/* handle zero interest	*/
	if (_MacIsDecZ(intr))  {
		if (_MacIsDecZ(pmt))  {
			_MacErr(GM_ARGVAL);
			return(GM_NULL);
		}

		(void) _AddDec80Bit(temp, pv, fv);
		_MacDChgs(temp);

		(void) _DivTrnDec80Bit(temp2, temp, pmt, 0);
/* check for exact division => don't increment */
		(void) _MulDec80Bit(mess, temp2, pmt);
		if (CompareDecimal(temp,mess)!=0)
			(void) _AddDec80Bit(temp2, temp2, &decOne);

		if (_MacIsDecN(temp2)||CompareDecimal(temp2,&decMaxTime)==1) {
			_MacErr(GM_ARGVAL);
			return(GM_NULL);
		}

		if (fun==1)  {
			*nperi=temp2->dc.sl[0];
			return(GM_NULL);
		}
		else  {
			_MacDCopy(nperd, temp2);
			return(nperd);
		}
	}

/* first solve for integer part	of period */
	(void) _DivDec80Bit(temp, pmt, nintr);
	if (begend==GM_BEGIN)
		(void) _MulDec80Bit(temp, temp,	opi);
	_MacDCopy(temp2, temp);
	(void) _AddDec80Bit(temp, temp,	pv);
	(void) _SubDec80Bit(temp2, temp2, fv);
	if (_MacIsDecZ(temp)||_MacIsDecZ(temp2))  {
		_MacErr(GM_ARGVAL);
		return(GM_NULL);
	}
	(void) _DivDec80Bit(temp, temp2, temp);
	if (!_MacIsDecP(temp))	{
		_MacErr(GM_ARGVAL);
		return(GM_NULL);
	}
	(void) _LnDec80Bit(temp, temp);
	(void) _LnDec80Bit(temp2, opi);

	(void) _DivTrnDec80Bit(temp, temp, temp2, 0);
	if (_MacIsDecN(temp)||(CompareDecimal(temp,&decMaxTime)==1)) {
		_MacErr(GM_ARGVAL);
		return(GM_NULL);
	}

	intper=temp->dc.sl[0]+1;
	if (intper==1)
		intper--;

/* the +1 rounding assumes the ratio of	logarithms is not an integer */
	if (fun==1)  {
		*nperi=intper;	/* always round	up */
		return(GM_NULL);
	}

	/* fun > 1 */
	(void) ConvLongToDecimal(nperd,	(long) intper);
/* zero	pv makes fractional period irrelevant */
	if (_MacIsDecZ(pv))
		return(nperd);
/* now solve for fractional part & add to integer part */
	(void) _IntPwrDec80Bit(opitmn, opi, -intper);
	(void) _SubDec80Bit(temp, &decOne, opitmn);
	(void) _DivDec80Bit(mess, temp,	nintr);
	if (begend==GM_BEGIN)
		(void) _MulDec80Bit(mess, mess,	opi);
	(void) _MulDec80Bit(pmtm, pmt, mess);
	(void) _MulDec80Bit(fvopi, fv, opitmn);
	(void) _AddDec80Bit(temp, pmtm,	fvopi);
	_MacDChgs(temp);
	(void) _DivDec80Bit(alpha, temp, pv);
	if (fun==2)  {
		(void) _SubDec80Bit(temp, alpha, &decOne);
		(void) _DivDec80Bit(fractper, temp, nintr);
		(void) _AddDec80Bit(nperd, nperd, fractper);
		(void) _Sq5UnsTo4Uns(nperd);
	}
	if (fun==3)  {
		if (!_MacIsDecP(alpha))
			return(nperd);
		(void) _LnDec80Bit(temp, alpha);
		(void) _LnDec80Bit(temp2, opi);
		(void) _DivDec80Bit(fractper, temp, temp2);
		(void) _AddDec80Bit(nperd, nperd, fractper);
		(void) _Sq5UnsTo4Uns(nperd);
	}
	return(nperd);
}