Files
calc/qtrans.c
Landon Curt Noll ff90bc0e3a add E_STRING to error, errno, strerror, change multiple E_STRING's
While help/errstr has been added, the errstr builtin function is
not yet written.  In anticipation of the new errstr builtin the
rest of the calc error system has been updated to associated errsym
E_STRING's with errnum error codes and errmsg error messages.

Minor improvements to help/rand.

The verify_error_table() function that does a verification
the error_table[] array and setup private_error_alias[] array
is now called by libcalc_call_me_first().

Fix comment about wrong include file in have_sys_mount.h.

Removed unused booltostr() and strtobool() macros from bool.h.

Moved define of math_error(char *, ...) from zmath.h to errtbl.h.
The errtbl.h include file, unless ERRCODE_SRC is defined
also includes attribute.h and errsym.h.

Group calc error related builtin support functions together in func.c.

Make switch indenting in func.c consistent.

Passing an invalid argument to error(), errno() or strerror() will
set errno AND throw a math error.  Before errno would be set and
an error value was returned.  Before there was no way to tell if
the error value was a result of the arg or if an error detected.

Added E_STRING to error([errnum | "E_STRING"]) builtin function.
Added E_STRING to errno([errnum | "E_STRING"]) builtin function.
Added E_STRING to strerror([errnum | "E_STRING"]) builtin function.
Calling these functions with an E_STRING errsym is the same as calling
them with the matching errnum code.

Standardized on calc computation error related E_STRING strings
where there are a set of related codes.  Changed "E_...digits" into
"E_..._digits".  For example, E_FPUTC1 became E_FPUTC_1, E_FPUTC2
became E_FPUTC_2, and E_FPUTC3 became E_FPUTC_3.  In a few cases
such as E_APPR became E_APPR_1, because there was a E_APPR2 (which
became E_APPR_2) and E_APPR3 (which became E_APPR_3).  To other
special cases, E_ILOG10 became E_IBASE10_LOG and E_ILOG2 became
E_IBASE2_LOG because E_ILOG10 and E_ILOG2 are both independent calc
computation error related E_STRING strings.  Now related sets of
E_STRING strings end in _ (underscore) followed by digits.

The following is the list of E_STRING strings changes:

    E_APPR ==> E_APPR_1
    E_ROUND ==> E_ROUND_1
    E_SQRT ==> E_SQRT_1
    E_ROOT ==> E_ROOT_1
    E_SHIFT ==> E_SHIFT_1
    E_SCALE ==> E_SCALE_1
    E_POWI ==> E_POWI_1
    E_POWER ==> E_POWER_1
    E_QUO ==> E_QUO_1
    E_MOD ==> E_MOD_1
    E_ABS ==> E_ABS_1
    E_APPR2 ==> E_APPR_2
    E_APPR3 ==> E_APPR_3
    E_ROUND2 ==> E_ROUND_2
    E_ROUND3 ==> E_ROUND_3
    E_BROUND2 ==> E_BROUND_2
    E_BROUND3 ==> E_BROUND_3
    E_SQRT2 ==> E_SQRT_2
    E_SQRT3 ==> E_SQRT_3
    E_ROOT2 ==> E_ROOT_2
    E_ROOT3 ==> E_ROOT_3
    E_SHIFT2 ==> E_SHIFT_2
    E_SCALE2 ==> E_SCALE_2
    E_POWI2 ==> E_POWI_2
    E_POWER2 ==> E_POWER_2
    E_POWER3 ==> E_POWER_3
    E_QUO2 ==> E_QUO_2
    E_QUO3 ==> E_QUO_3
    E_MOD2 ==> E_MOD_2
    E_MOD3 ==> E_MOD_3
    E_ABS2 ==> E_ABS_2
    E_EXP1 ==> E_EXP_1
    E_EXP2 ==> E_EXP_2
    E_FPUTC1 ==> E_FPUTC_1
    E_FPUTC2 ==> E_FPUTC_2
    E_FPUTC3 ==> E_FPUTC_3
    E_FGETC1 ==> E_FGETC_1
    E_FGETC2 ==> E_FGETC_2
    E_FOPEN1 ==> E_FOPEN_1
    E_FOPEN2 ==> E_FOPEN_2
    E_FREOPEN1 ==> E_FREOPEN_1
    E_FREOPEN2 ==> E_FREOPEN_2
    E_FREOPEN3 ==> E_FREOPEN_3
    E_FCLOSE1 ==> E_FCLOSE_1
    E_FPUTS1 ==> E_FPUTS_1
    E_FPUTS2 ==> E_FPUTS_2
    E_FPUTS3 ==> E_FPUTS_3
    E_FGETS1 ==> E_FGETS_1
    E_FGETS2 ==> E_FGETS_2
    E_FPUTSTR1 ==> E_FPUTSTR_1
    E_FPUTSTR2 ==> E_FPUTSTR_2
    E_FPUTSTR3 ==> E_FPUTSTR_3
    E_FGETSTR1 ==> E_FGETSTR_1
    E_FGETSTR2 ==> E_FGETSTR_2
    E_FGETLINE1 ==> E_FGETLINE_1
    E_FGETLINE2 ==> E_FGETLINE_2
    E_FGETFIELD1 ==> E_FGETFIELD_1
    E_FGETFIELD2 ==> E_FGETFIELD_2
    E_REWIND1 ==> E_REWIND_1
    E_PRINTF1 ==> E_PRINTF_1
    E_PRINTF2 ==> E_PRINTF_2
    E_FPRINTF1 ==> E_FPRINTF_1
    E_FPRINTF2 ==> E_FPRINTF_2
    E_FPRINTF3 ==> E_FPRINTF_3
    E_STRPRINTF1 ==> E_STRPRINTF_1
    E_STRPRINTF2 ==> E_STRPRINTF_2
    E_FSCAN1 ==> E_FSCAN_1
    E_FSCAN2 ==> E_FSCAN_2
    E_FSCANF1 ==> E_FSCANF_1
    E_FSCANF2 ==> E_FSCANF_2
    E_FSCANF3 ==> E_FSCANF_3
    E_FSCANF4 ==> E_FSCANF_4
    E_STRSCANF1 ==> E_STRSCANF_1
    E_STRSCANF2 ==> E_STRSCANF_2
    E_STRSCANF3 ==> E_STRSCANF_3
    E_STRSCANF4 ==> E_STRSCANF_4
    E_SCANF1 ==> E_SCANF_1
    E_SCANF2 ==> E_SCANF_2
    E_SCANF3 ==> E_SCANF_3
    E_FTELL1 ==> E_FTELL_1
    E_FTELL2 ==> E_FTELL_2
    E_FSEEK1 ==> E_FSEEK_1
    E_FSEEK2 ==> E_FSEEK_2
    E_FSEEK3 ==> E_FSEEK_3
    E_FSIZE1 ==> E_FSIZE_1
    E_FSIZE2 ==> E_FSIZE_2
    E_FEOF1 ==> E_FEOF_1
    E_FEOF2 ==> E_FEOF_2
    E_FERROR1 ==> E_FERROR_1
    E_FERROR2 ==> E_FERROR_2
    E_UNGETC1 ==> E_UNGETC_1
    E_UNGETC2 ==> E_UNGETC_2
    E_UNGETC3 ==> E_UNGETC_3
    E_ISATTY1 ==> E_ISATTY_1
    E_ISATTY2 ==> E_ISATTY_2
    E_ACCESS1 ==> E_ACCESS_1
    E_ACCESS2 ==> E_ACCESS_2
    E_SEARCH1 ==> E_SEARCH_1
    E_SEARCH2 ==> E_SEARCH_2
    E_SEARCH3 ==> E_SEARCH_3
    E_SEARCH4 ==> E_SEARCH_4
    E_SEARCH5 ==> E_SEARCH_5
    E_SEARCH6 ==> E_SEARCH_6
    E_RSEARCH1 ==> E_RSEARCH_1
    E_RSEARCH2 ==> E_RSEARCH_2
    E_RSEARCH3 ==> E_RSEARCH_3
    E_RSEARCH4 ==> E_RSEARCH_4
    E_RSEARCH5 ==> E_RSEARCH_5
    E_RSEARCH6 ==> E_RSEARCH_6
    E_REWIND2 ==> E_REWIND_2
    E_STRERROR1 ==> E_STRERROR_1
    E_STRERROR2 ==> E_STRERROR_2
    E_COS1 ==> E_COS_1
    E_COS2 ==> E_COS_2
    E_SIN1 ==> E_SIN_1
    E_SIN2 ==> E_SIN_2
    E_EVAL2 ==> E_EVAL_2
    E_ARG1 ==> E_ARG_1
    E_ARG2 ==> E_ARG_2
    E_POLAR1 ==> E_POLAR_1
    E_POLAR2 ==> E_POLAR_2
    E_MATFILL1 ==> E_MATFILL_1
    E_MATFILL2 ==> E_MATFILL_2
    E_MATTRANS1 ==> E_MATTRANS_1
    E_MATTRANS2 ==> E_MATTRANS_2
    E_DET1 ==> E_DET_1
    E_DET2 ==> E_DET_2
    E_DET3 ==> E_DET_3
    E_MATMIN1 ==> E_MATMIN_1
    E_MATMIN2 ==> E_MATMIN_2
    E_MATMIN3 ==> E_MATMIN_3
    E_MATMAX1 ==> E_MATMAX_1
    E_MATMAX2 ==> E_MATMAX_2
    E_MATMAX3 ==> E_MATMAX_3
    E_CP1 ==> E_CP_1
    E_CP2 ==> E_CP_2
    E_CP3 ==> E_CP_3
    E_DP1 ==> E_DP_1
    E_DP2 ==> E_DP_2
    E_DP3 ==> E_DP_3
    E_SUBSTR1 ==> E_SUBSTR_1
    E_SUBSTR2 ==> E_SUBSTR_2
    E_INSERT1 ==> E_INSERT_1
    E_INSERT2 ==> E_INSERT_2
    E_DELETE1 ==> E_DELETE_1
    E_DELETE2 ==> E_DELETE_2
    E_LN1 ==> E_LN_1
    E_LN2 ==> E_LN_2
    E_ERROR1 ==> E_ERROR_1
    E_ERROR2 ==> E_ERROR_2
    E_EVAL3 ==> E_EVAL_3
    E_EVAL4 ==> E_EVAL_4
    E_RM1 ==> E_RM_1
    E_RM2 ==> E_RM_2
    E_BLK1 ==> E_BLK_1
    E_BLK2 ==> E_BLK_2
    E_BLK3 ==> E_BLK_3
    E_BLK4 ==> E_BLK_4
    E_BLKFREE1 ==> E_BLKFREE_1
    E_BLKFREE2 ==> E_BLKFREE_2
    E_BLKFREE3 ==> E_BLKFREE_3
    E_BLKFREE4 ==> E_BLKFREE_4
    E_BLKFREE5 ==> E_BLKFREE_5
    E_BLOCKS1 ==> E_BLOCKS_1
    E_BLOCKS2 ==> E_BLOCKS_2
    E_COPY1 ==> E_COPY_01
    E_COPY2 ==> E_COPY_02
    E_COPY3 ==> E_COPY_03
    E_COPY4 ==> E_COPY_04
    E_COPY5 ==> E_COPY_05
    E_COPY6 ==> E_COPY_06
    E_COPY7 ==> E_COPY_07
    E_COPY8 ==> E_COPY_08
    E_COPY9 ==> E_COPY_09
    E_COPY10 ==> E_COPY_10
    E_COPY11 ==> E_COPY_11
    E_COPY12 ==> E_COPY_12
    E_COPY13 ==> E_COPY_13
    E_COPY14 ==> E_COPY_14
    E_COPY15 ==> E_COPY_15
    E_COPY16 ==> E_COPY_16
    E_COPY17 ==> E_COPY_17
    E_COPYF1 ==> E_COPYF_1
    E_COPYF2 ==> E_COPYF_2
    E_COPYF3 ==> E_COPYF_3
    E_COPYF4 ==> E_COPYF_4
    E_PROTECT1 ==> E_PROTECT_1
    E_PROTECT2 ==> E_PROTECT_2
    E_PROTECT3 ==> E_PROTECT_3
    E_MATFILL3 ==> E_MATFILL_3
    E_MATFILL4 ==> E_MATFILL_4
    E_MATTRACE1 ==> E_MATTRACE_1
    E_MATTRACE2 ==> E_MATTRACE_2
    E_MATTRACE3 ==> E_MATTRACE_3
    E_TAN1 ==> E_TAN_1
    E_TAN2 ==> E_TAN_2
    E_COT1 ==> E_COT_1
    E_COT2 ==> E_COT_2
    E_SEC1 ==> E_SEC_1
    E_SEC2 ==> E_SEC_2
    E_CSC1 ==> E_CSC_1
    E_CSC2 ==> E_CSC_2
    E_SINH1 ==> E_SINH_1
    E_SINH2 ==> E_SINH_2
    E_COSH1 ==> E_COSH_1
    E_COSH2 ==> E_COSH_2
    E_TANH1 ==> E_TANH_1
    E_TANH2 ==> E_TANH_2
    E_COTH1 ==> E_COTH_1
    E_COTH2 ==> E_COTH_2
    E_SECH1 ==> E_SECH_1
    E_SECH2 ==> E_SECH_2
    E_CSCH1 ==> E_CSCH_1
    E_CSCH2 ==> E_CSCH_2
    E_ASIN1 ==> E_ASIN_1
    E_ASIN2 ==> E_ASIN_2
    E_ACOS1 ==> E_ACOS_1
    E_ACOS2 ==> E_ACOS_2
    E_ATAN1 ==> E_ATAN_1
    E_ATAN2 ==> E_ATAN_2
    E_ACOT1 ==> E_ACOT_1
    E_ACOT2 ==> E_ACOT_2
    E_ASEC1 ==> E_ASEC_1
    E_ASEC2 ==> E_ASEC_2
    E_ACSC1 ==> E_ACSC_1
    E_ACSC2 ==> E_ACSC_2
    E_ASINH1 ==> E_ASINH_1
    E_ASINH2 ==> E_ASINH_2
    E_ACOSH1 ==> E_ACOSH_1
    E_ACOSH2 ==> E_ACOSH_2
    E_ATANH1 ==> E_ATANH_1
    E_ATANH2 ==> E_ATANH_2
    E_ACOTH1 ==> E_ACOTH_1
    E_ACOTH2 ==> E_ACOTH_2
    E_ASECH1 ==> E_ASECH_1
    E_ASECH2 ==> E_ASECH_2
    E_ACSCH1 ==> E_ACSCH_1
    E_ACSCH2 ==> E_ACSCH_2
    E_GD1 ==> E_GD_1
    E_GD2 ==> E_GD_2
    E_AGD1 ==> E_AGD_1
    E_AGD2 ==> E_AGD_2
    E_BIT1 ==> E_BIT_1
    E_BIT2 ==> E_BIT_2
    E_SETBIT1 ==> E_SETBIT_1
    E_SETBIT2 ==> E_SETBIT_2
    E_SETBIT3 ==> E_SETBIT_3
    E_SEG1 ==> E_SEG_1
    E_SEG2 ==> E_SEG_2
    E_SEG3 ==> E_SEG_3
    E_HIGHBIT1 ==> E_HIGHBIT_1
    E_HIGHBIT2 ==> E_HIGHBIT_2
    E_LOWBIT1 ==> E_LOWBIT_1
    E_LOWBIT2 ==> E_LOWBIT_2
    E_HEAD1 ==> E_HEAD_1
    E_HEAD2 ==> E_HEAD_2
    E_TAIL1 ==> E_TAIL_1
    E_TAIL2 ==> E_TAIL_2
    E_XOR1 ==> E_XOR_1
    E_XOR2 ==> E_XOR_2
    E_INDICES1 ==> E_INDICES_1
    E_INDICES2 ==> E_INDICES_2
    E_EXP3 ==> E_EXP_3
    E_SINH3 ==> E_SINH_3
    E_COSH3 ==> E_COSH_3
    E_SIN3 ==> E_SIN_3
    E_COS3 ==> E_COS_3
    E_GD3 ==> E_GD_3
    E_AGD3 ==> E_AGD_3
    E_POWER4 ==> E_POWER_4
    E_ROOT4 ==> E_ROOT_4
    E_DGT1 ==> E_DGT_1
    E_DGT2 ==> E_DGT_2
    E_DGT3 ==> E_DGT_3
    E_PLCS1 ==> E_PLCS_1
    E_PLCS2 ==> E_PLCS_2
    E_DGTS1 ==> E_DGTS_1
    E_DGTS2 ==> E_DGTS_2
    E_ILOG10 ==> E_IBASE10_LOG
    E_ILOG2 ==> E_IBASE2_LOG
    E_COMB1 ==> E_COMB_1
    E_COMB2 ==> E_COMB_2
    E_ASSIGN1 ==> E_ASSIGN_1
    E_ASSIGN2 ==> E_ASSIGN_2
    E_ASSIGN3 ==> E_ASSIGN_3
    E_ASSIGN4 ==> E_ASSIGN_4
    E_ASSIGN5 ==> E_ASSIGN_5
    E_ASSIGN6 ==> E_ASSIGN_6
    E_ASSIGN7 ==> E_ASSIGN_7
    E_ASSIGN8 ==> E_ASSIGN_8
    E_ASSIGN9 ==> E_ASSIGN_9
    E_SWAP1 ==> E_SWAP_1
    E_SWAP2 ==> E_SWAP_2
    E_SWAP3 ==> E_SWAP_3
    E_QUOMOD1 ==> E_QUOMOD_1
    E_QUOMOD2 ==> E_QUOMOD_2
    E_QUOMOD3 ==> E_QUOMOD_3
    E_PREINC1 ==> E_PREINC_1
    E_PREINC2 ==> E_PREINC_2
    E_PREINC3 ==> E_PREINC_3
    E_PREDEC1 ==> E_PREDEC_1
    E_PREDEC2 ==> E_PREDEC_2
    E_PREDEC3 ==> E_PREDEC_3
    E_POSTINC1 ==> E_POSTINC_1
    E_POSTINC2 ==> E_POSTINC_2
    E_POSTINC3 ==> E_POSTINC_3
    E_POSTDEC1 ==> E_POSTDEC_1
    E_POSTDEC2 ==> E_POSTDEC_2
    E_POSTDEC3 ==> E_POSTDEC_3
    E_INIT1 ==> E_INIT_01
    E_INIT2 ==> E_INIT_02
    E_INIT3 ==> E_INIT_03
    E_INIT4 ==> E_INIT_04
    E_INIT5 ==> E_INIT_05
    E_INIT6 ==> E_INIT_06
    E_INIT7 ==> E_INIT_07
    E_INIT8 ==> E_INIT_08
    E_INIT9 ==> E_INIT_09
    E_INIT10 ==> E_INIT_10
    E_LIST1 ==> E_LIST_1
    E_LIST2 ==> E_LIST_2
    E_LIST3 ==> E_LIST_3
    E_LIST4 ==> E_LIST_4
    E_LIST5 ==> E_LIST_5
    E_LIST6 ==> E_LIST_6
    E_MODIFY1 ==> E_MODIFY_1
    E_MODIFY2 ==> E_MODIFY_2
    E_MODIFY3 ==> E_MODIFY_3
    E_MODIFY4 ==> E_MODIFY_4
    E_MODIFY5 ==> E_MODIFY_5
    E_FPATHOPEN1 ==> E_FPATHOPEN_1
    E_FPATHOPEN2 ==> E_FPATHOPEN_2
    E_LOG1 ==> E_LOG_1
    E_LOG2 ==> E_LOG_2
    E_LOG3 ==> E_LOG_3
    E_FGETFILE1 ==> E_FGETFILE_1
    E_FGETFILE2 ==> E_FGETFILE_2
    E_FGETFILE3 ==> E_FGETFILE_3
    E_TAN3 ==> E_TAN_3
    E_TAN4 ==> E_TAN_4
    E_COT3 ==> E_COT_3
    E_COT4 ==> E_COT_4
    E_SEC3 ==> E_SEC_3
    E_CSC3 ==> E_CSC_3
    E_TANH3 ==> E_TANH_3
    E_TANH4 ==> E_TANH_4
    E_COTH3 ==> E_COTH_3
    E_COTH4 ==> E_COTH_4
    E_SECH3 ==> E_SECH_3
    E_CSCH3 ==> E_CSCH_3
    E_ASIN3 ==> E_ASIN_3
    E_ACOS3 ==> E_ACOS_3
    E_ASINH3 ==> E_ASINH_3
    E_ACOSH3 ==> E_ACOSH_3
    E_ATAN3 ==> E_ATAN_3
    E_ACOT3 ==> E_ACOT_3
    E_ASEC3 ==> E_ASEC_3
    E_ACSC3 ==> E_ACSC_3
    E_ATANH3 ==> E_ATANH_3
    E_ACOTH3 ==> E_ACOTH_3
    E_ASECH3 ==> E_ASECH_3
    E_ACSCH3 ==> E_ACSCH_3
    E_D2R1 ==> E_D2R_1
    E_D2R2 ==> E_D2R_2
    E_R2D1 ==> E_R2D_1
    E_R2D2 ==> E_R2D_2
    E_G2R1 ==> E_G2R_1
    E_G2R2 ==> E_G2R_2
    E_R2G1 ==> E_R2G_1
    E_R2G2 ==> E_R2G_2
    E_D2G1 ==> E_D2G_1
    E_G2D1 ==> E_G2D_1
    E_D2DMS1 ==> E_D2DMS_1
    E_D2DMS2 ==> E_D2DMS_2
    E_D2DMS3 ==> E_D2DMS_3
    E_D2DMS4 ==> E_D2DMS_4
    E_D2DM1 ==> E_D2DM_1
    E_D2DM2 ==> E_D2DM_2
    E_D2DM3 ==> E_D2DM_3
    E_D2DM4 ==> E_D2DM_4
    E_G2GMS1 ==> E_G2GMS_1
    E_G2GMS2 ==> E_G2GMS_2
    E_G2GMS3 ==> E_G2GMS_3
    E_G2GMS4 ==> E_G2GMS_4
    E_G2GM1 ==> E_G2GM_1
    E_G2GM2 ==> E_G2GM_2
    E_G2GM3 ==> E_G2GM_3
    E_G2GM4 ==> E_G2GM_4
    E_H2HMS1 ==> E_H2HMS_1
    E_H2HMS2 ==> E_H2HMS_2
    E_H2HMS3 ==> E_H2HMS_3
    E_H2HMS4 ==> E_H2HMS_4
    E_H2HM1 ==> E_H2HM_1
    E_H2HM2 ==> E_H2HM_2
    E_H2HM3 ==> E_H2HM_3
    E_H2HM4 ==> E_H2HM_4
    E_DMS2D1 ==> E_DMS2D_1
    E_DMS2D2 ==> E_DMS2D_2
    E_DM2D1 ==> E_DM2D_1
    E_DM2D2 ==> E_DM2D_2
    E_GMS2G1 ==> E_GMS2G_1
    E_GMS2G2 ==> E_GMS2G_2
    E_GM2G1 ==> E_GM2G_1
    E_GM2G2 ==> E_GM2G_2
    E_HMS2H1 ==> E_HMS2H_1
    E_HMS2H2 ==> E_HMS2H_2
    E_HM2H1 ==> E_HM2H_1
    E_HM2H2 ==> E_HM2H_2
    E_VERSIN1 ==> E_VERSIN_1
    E_VERSIN2 ==> E_VERSIN_2
    E_VERSIN3 ==> E_VERSIN_3
    E_AVERSIN1 ==> E_AVERSIN_1
    E_AVERSIN2 ==> E_AVERSIN_2
    E_AVERSIN3 ==> E_AVERSIN_3
    E_COVERSIN1 ==> E_COVERSIN_1
    E_COVERSIN2 ==> E_COVERSIN_2
    E_COVERSIN3 ==> E_COVERSIN_3
    E_ACOVERSIN1 ==> E_ACOVERSIN_1
    E_ACOVERSIN2 ==> E_ACOVERSIN_2
    E_ACOVERSIN3 ==> E_ACOVERSIN_3
    E_VERCOS1 ==> E_VERCOS_1
    E_VERCOS2 ==> E_VERCOS_2
    E_VERCOS3 ==> E_VERCOS_3
    E_AVERCOS1 ==> E_AVERCOS_1
    E_AVERCOS2 ==> E_AVERCOS_2
    E_AVERCOS3 ==> E_AVERCOS_3
    E_COVERCOS1 ==> E_COVERCOS_1
    E_COVERCOS2 ==> E_COVERCOS_2
    E_COVERCOS3 ==> E_COVERCOS_3
    E_ACOVERCOS1 ==> E_ACOVERCOS_1
    E_ACOVERCOS2 ==> E_ACOVERCOS_2
    E_ACOVERCOS3 ==> E_ACOVERCOS_3
    E_TAN5 ==> E_TAN_5
    E_COT5 ==> E_COT_5
    E_COT6 ==> E_COT_6
    E_SEC5 ==> E_SEC_5
    E_CSC5 ==> E_CSC_5
    E_CSC6 ==> E_CSC_6
2023-09-19 18:34:21 -07:00

2570 lines
50 KiB
C

/*
* qtrans - transcendental functions for real numbers
*
* Copyright (C) 1999-2007,2021-2023 David I. Bell, Landon Curt Noll and Ernest Bowen
*
* Primary author: David I. Bell
*
* Calc is open software; you can redistribute it and/or modify it under
* the terms of the version 2.1 of the GNU Lesser General Public License
* as published by the Free Software Foundation.
*
* Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details.
*
* A copy of version 2.1 of the GNU Lesser General Public License is
* distributed with calc under the filename COPYING-LGPL. You should have
* received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* Under source code control: 1990/02/15 01:48:22
* File existed as early as: before 1990
*
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/
/*
* Transcendental functions for real numbers.
* These are sin, cos, exp, ln, power, cosh, sinh.
*/
#include "qmath.h"
#include "errtbl.h"
#include "banned.h" /* include after system header <> includes */
HALF _qlgenum_[] = { 36744 };
HALF _qlgeden_[] = { 25469 };
NUMBER _qlge_ = { { _qlgenum_, 1, 0 }, { _qlgeden_, 1, 0 }, 1, NULL };
/*
* cache the natural logarithm of 10 and 2
*/
STATIC NUMBER *ln_10 = NULL;
STATIC NUMBER *ln_10_epsilon = NULL;
STATIC NUMBER *ln_2 = NULL;
STATIC NUMBER *ln_2_epsilon = NULL;
STATIC NUMBER *ln_n = NULL;
STATIC NUMBER *ln_n_epsilon = NULL;
/*
* cache pi
*
* pivalue[LAST_PI_EPSILON] - last epsilon used to calculate pi
* pivalue[LAST_PI_VALUE] - last calculated pi
* given pivalue[LAST_PI_EPSILON] epsilon
* pivalue[LAST_PI_DIV_180_EPSILON] - last epsilon used to calculate pi/180
* pivalue[LAST_PI_DIV_180_VALUE] - last calculated pi/180 given
* pivalue[LAST_PI_DIV_180_EPSILON] epsilon
* pivalue[LAST_PI_DIV_200_EPSILON] - last epsilon used to calculate pi/200
* pivalue[LAST_PI_DIV_200_VALUE] - last calculated pi/200 given
* pivalue[LAST_PI_DIV_200_EPSILON] epsilon
*/
enum pi_cache {
LAST_PI_EPSILON = 0,
LAST_PI_VALUE,
LAST_PI_DIV_180_EPSILON,
LAST_PI_DIV_180_VALUE,
LAST_PI_DIV_200_EPSILON,
LAST_PI_DIV_200_VALUE,
PI_CACHE_LEN /* must be last */
};
STATIC NUMBER *pivalue[PI_CACHE_LEN] = {
NULL, /* LAST_PI_EPSILON */
NULL, /* LAST_PI_VALUE */
NULL, /* LAST_PI_DIV_180_EPSILON */
NULL, /* LAST_PI_DIV_180_VALUE */
NULL, /* LAST_PI_DIV_200_EPSILON */
NULL, /* LAST_PI_DIV_200_VALUE */
};
/*
* other static function declarations
*/
STATIC NUMBER *qexprel(NUMBER *q, long bitnum);
/*
* Evaluate and store in specified locations the sin and cos of a given
* number to accuracy corresponding to a specified number of binary digits.
*/
void
qsincos(NUMBER *q, long bitnum, NUMBER **vs, NUMBER **vc)
{
long n, m, k, h, s, t, d;
NUMBER *qtmp1, *qtmp2;
ZVALUE X, cossum, sinsum, mul, ztmp1, ztmp2, ztmp3;
qtmp1 = qqabs(q);
h = qilog2(qtmp1);
qfree(qtmp1);
k = bitnum + h + 1;
if (k < 0) {
*vs = qlink(&_qzero_);
*vc = qlink(&_qone_);
return;
}
s = k;
if (k) {
do {
t = s;
s = (s + k/s)/2;
}
while (t > s);
} /* s is int(sqrt(k)) */
s++;
if (s < -h)
s = -h;
n = h + s; /* n is number of squaring that will be required */
m = bitnum + n;
while (s > 0) { /* increasing m by ilog2(s) */
s >>= 1;
m++;
} /* m is working number of bits */
qtmp1 = qscale(q, m - n);
zquo(qtmp1->num, qtmp1->den, &X, 24);
qfree(qtmp1);
if (ziszero(X)) {
zfree(X);
*vs = qlink(&_qzero_);
*vc = qlink(&_qone_);
return;
}
zbitvalue(m, &cossum);
zcopy(X, &sinsum);
zcopy(X, &mul);
d = 1;
for (;;) {
X.sign = !X.sign;
zmul(X, mul, &ztmp1);
zfree(X);
zshift(ztmp1, -m, &ztmp2);
zfree(ztmp1);
zdivi(ztmp2, ++d, &X);
zfree(ztmp2);
if (ziszero(X))
break;
zadd(cossum, X, &ztmp1);
zfree(cossum);
cossum = ztmp1;
zmul(X, mul, &ztmp1);
zfree(X);
zshift(ztmp1, -m, &ztmp2);
zfree(ztmp1);
zdivi(ztmp2, ++d, &X);
zfree(ztmp2);
if (ziszero(X))
break;
zadd(sinsum, X, &ztmp1);
zfree(sinsum);
sinsum = ztmp1;
}
zfree(X);
zfree(mul);
while (n-- > 0) {
zsquare(cossum, &ztmp1);
zsquare(sinsum, &ztmp2);
zsub(ztmp1, ztmp2, &ztmp3);
zfree(ztmp1);
zfree(ztmp2);
zmul(cossum, sinsum, &ztmp1);
zfree(cossum);
zfree(sinsum);
zshift(ztmp3, -m, &cossum);
zfree(ztmp3);
zshift(ztmp1, 1 - m, &sinsum);
zfree(ztmp1);
}
h = zlowbit(cossum);
qtmp1 = qalloc();
if (m > h) {
zshift(cossum, -h, &qtmp1->num);
zbitvalue(m - h, &qtmp1->den);
} else {
zshift(cossum, - m, &qtmp1->num);
}
zfree(cossum);
*vc = qtmp1;
h = zlowbit(sinsum);
qtmp2 = qalloc();
if (m > h) {
zshift(sinsum, -h, &qtmp2->num);
zbitvalue(m - h, &qtmp2->den);
} else {
zshift(sinsum, -m, &qtmp2->num);
}
zfree(sinsum);
*vs = qtmp2;
return;
}
/*
* Calculate the cosine of a number to a near multiple of epsilon.
* This calls qsincos() and discards the value of sin.
*/
NUMBER *
qcos(NUMBER *q, NUMBER *epsilon)
{
NUMBER *sin, *cos, *res;
long n;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for cosine");
not_reached();
}
if (qiszero(q))
return qlink(&_qone_);
n = -qilog2(epsilon);
if (n < 0)
return qlink(&_qzero_);
qsincos(q, n + 2, &sin, &cos);
qfree(sin);
res = qmappr(cos, epsilon, 24);
qfree(cos);
return res;
}
/*
* This calls qsincos() and discards the value of cos.
*/
NUMBER *
qsin(NUMBER *q, NUMBER *epsilon)
{
NUMBER *sin, *cos, *res;
long n;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for sine");
not_reached();
}
n = -qilog2(epsilon);
if (qiszero(q) || n < 0)
return qlink(&_qzero_);
qsincos(q, n + 2, &sin, &cos);
qfree(cos);
res = qmappr(sin, epsilon, 24);
qfree(sin);
return res;
}
/*
* Calculate the tangent function.
*/
NUMBER *
qtan(NUMBER *q, NUMBER *epsilon)
{
NUMBER *sin, *cos, *tan, *res;
long n, k, m;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for tangent");
not_reached();
}
if (qiszero(q))
return qlink(q);
n = qilog2(epsilon);
k = (n > 0) ? 4 + n/2 : 4;
for (;;) {
qsincos(q, 2 * k - n, &sin, &cos);
if (qiszero(cos)) {
qfree(sin);
qfree(cos);
k = 2 * k - n + 4;
continue;
}
m = -qilog2(cos);
if (m < k)
break;
qfree(sin);
qfree(cos);
k = m + 1;
}
tan = qqdiv(sin, cos);
qfree(sin);
qfree(cos);
res = qmappr(tan, epsilon, 24);
qfree(tan);
return res;
}
/*
* Calculate the cotangent function.
*/
NUMBER *
qcot(NUMBER *q, NUMBER *epsilon)
{
NUMBER *sin, *cos, *cot, *res;
long n, k, m;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for cotangent");
not_reached();
}
if (qiszero(q)) {
math_error("Zero argument for cotangent");
not_reached();
}
k = -qilog2(q);
n = qilog2(epsilon);
if (k < 0)
k = (n > 0) ? n/2 : 0;
k += 4;
for (;;) {
qsincos(q, 2 * k - n, &sin, &cos);
if (qiszero(sin)) {
qfree(sin);
qfree(cos);
k = 2 * k - n + 4;
continue;
}
m = -qilog2(sin);
if (m < k)
break;
qfree(sin);
qfree(cos);
k = m + 1;
}
cot = qqdiv(cos, sin);
qfree(sin);
qfree(cos);
res = qmappr(cot, epsilon, 24);
qfree(cot);
return res;
}
/*
* Calculate the secant function.
*/
NUMBER *
qsec(NUMBER *q, NUMBER *epsilon)
{
NUMBER *sin, *cos, *sec, *res;
long n, k, m;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for secant");
not_reached();
}
if (qiszero(q))
return qlink(&_qone_);
n = qilog2(epsilon);
k = (n > 0) ? 4 + n/2 : 4;
for (;;) {
qsincos(q, 2 * k - n, &sin, &cos);
qfree(sin);
if (qiszero(cos)) {
qfree(cos);
k = 2 * k - n + 4;
continue;
}
m = -qilog2(cos);
if (m < k)
break;
qfree(cos);
k = m + 1;
}
sec = qinv(cos);
qfree(cos);
res = qmappr(sec, epsilon, 24);
qfree(sec);
return res;
}
/*
* Calculate the cosecant function.
*/
NUMBER *
qcsc(NUMBER *q, NUMBER *epsilon)
{
NUMBER *sin, *cos, *csc, *res;
long n, k, m;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for cosecant");
not_reached();
}
if (qiszero(q)) {
math_error("Zero argument for cosecant");
not_reached();
}
k = -qilog2(q);
n = qilog2(epsilon);
if (k < 0)
k = (n > 0) ? n/2 : 0;
k += 4;
for (;;) {
qsincos(q, 2 * k - n, &sin, &cos);
qfree(cos);
if (qiszero(sin)) {
qfree(sin);
k = 2 * k - n + 4;
continue;
}
m = -qilog2(sin);
if (m < k)
break;
qfree(sin);
k = m + 1;
}
csc = qinv(sin);
qfree(sin);
res = qmappr(csc, epsilon, 24);
qfree(csc);
return res;
}
/*
* Calculate the arcsine function.
* The result is in the range -pi/2 to pi/2.
*/
NUMBER *
qasin(NUMBER *q, NUMBER *epsilon)
{
NUMBER *qtmp1, *qtmp2, *epsilon1;
ZVALUE ztmp;
bool neg;
FLAG r;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for asin");
not_reached();
}
if (qiszero(q)) {
return qlink(&_qzero_);
}
ztmp = q->num;
neg = ztmp.sign;
ztmp.sign = 0;
r = zrel(ztmp, q->den);
if (r > 0) {
return NULL;
}
if (r == 0) {
epsilon1 = qscale(epsilon, 1L);
qtmp2 = qpi(epsilon1);
qtmp1 = qscale(qtmp2, -1L);
} else {
epsilon1 = qscale(epsilon, -2L);
qtmp1 = qalloc();
zsquare(q->num, &qtmp1->num);
zsquare(q->den, &ztmp);
zsub(ztmp, qtmp1->num, &qtmp1->den);
zfree(ztmp);
qtmp2 = qsqrt(qtmp1, epsilon1, 24);
qfree(qtmp1);
qtmp1 = qatan(qtmp2, epsilon);
}
qfree(qtmp2);
qfree(epsilon1);
if (neg) {
qtmp2 = qneg(qtmp1);
qfree(qtmp1);
return(qtmp2);
}
return qtmp1;
}
/*
* Calculate the acos function.
* The result is in the range 0 to pi.
*/
NUMBER *
qacos(NUMBER *q, NUMBER *epsilon)
{
NUMBER *q1, *q2, *epsilon1;
ZVALUE z;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for acos");
not_reached();
}
if (qisone(q))
return qlink(&_qzero_);
if (qisnegone(q))
return qpi(epsilon);
z = q->num;
z.sign = 0;
if (zrel(z, q->den) > 0)
return NULL;
epsilon1 = qscale(epsilon, -3L); /* ??? */
q1 = qalloc();
zsub(q->den, q->num, &q1->num);
zadd(q->den, q->num, &q1->den);
q2 = qsqrt(q1, epsilon1, 24L);
qfree(q1);
qfree(epsilon1);
epsilon1 = qscale(epsilon, -1L);
q1 = qatan(q2, epsilon1);
qfree(epsilon1);
qfree(q2);
q2 = qscale(q1, 1L);
qfree(q1)
return q2;
}
/*
* Calculate the arctangent function to the nearest or next to nearest
* multiple of epsilon. Algorithm uses
* atan(x) = 2 * atan(x/(1 + sqrt(1+x^2)))
* to reduce x to a small value and then
* atan(x) = x - x^3/3 + ...
*/
NUMBER *
qatan(NUMBER *q, NUMBER *epsilon)
{
long m, k, i;
FULL d;
ZVALUE X, D, DD, sum, mul, term, ztmp1, ztmp2;
NUMBER *qtmp, *res;
bool sign;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for arctangent");
not_reached();
}
if (qiszero(q))
return qlink(&_qzero_);
m = 12 - qilog2(epsilon);
/* 4 bits for 4 doublings; 8 for rounding */
if (m < 8)
m = 8; /* m is number of working binary digits */
qtmp = qscale(q, m);
zquo(qtmp->num, qtmp->den, &X, 24);
qfree(qtmp);
zbitvalue(m, &D); /* q has become X/D */
zsquare(D, &DD);
i = 4; /* maybe this should be larger */
while (i-- > 0 && !ziszero(X)) {
zsquare(X, &ztmp1);
zadd(ztmp1, DD, &ztmp2);
zfree(ztmp1);
zsqrt(ztmp2, &ztmp1, 24L);
zfree(ztmp2);
zadd(ztmp1, D, &ztmp2);
zfree(ztmp1);
zshift(X, m, &ztmp1);
zfree(X);
zquo(ztmp1, ztmp2, &X, 24L);
zfree(ztmp1);
zfree(ztmp2);
}
zfree(DD);
zfree(D);
if (ziszero(X)) {
zfree(X);
return qlink(&_qzero_);
}
zcopy(X, &sum);
zsquare(X, &ztmp1);
zshift(ztmp1, -m, &mul);
zfree(ztmp1);
d = 3;
sign = !X.sign;
for (;;) {
if (d > BASE) {
math_error("Too many terms required for atan");
not_reached();
}
zmul(X, mul, &ztmp1);
zfree(X);
zshift(ztmp1, -m, &X); /* X now (original X)^d */
zfree(ztmp1);
zdivi(X, d, &term);
if (ziszero(term)) {
zfree(term);
break;
}
term.sign = sign;
zadd(sum, term, &ztmp1);
zfree(sum);
zfree(term);
sum = ztmp1;
sign = !sign;
d += 2;
}
zfree(mul);
zfree(X);
qtmp = qalloc();
k = zlowbit(sum);
if (k) {
zshift(sum, -k, &qtmp->num);
zfree(sum);
} else {
qtmp->num = sum;
}
zbitvalue(m - 4 - k, &qtmp->den);
res = qmappr(qtmp, epsilon, 24L);
qfree(qtmp);
return res;
}
/*
* Inverse secant function
*/
NUMBER *
qasec(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp, *res;
tmp = qinv(q);
res = qacos(tmp, epsilon);
qfree(tmp);
return res;
}
/*
* Inverse cosecant function
*/
NUMBER *
qacsc(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp, *res;
tmp = qinv(q);
res = qasin(tmp, epsilon);
qfree(tmp);
return res;
}
/*
* Inverse cotangent function
*/
NUMBER *
qacot(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2, *tmp3, *epsilon1;
if (qiszero(epsilon)) {
math_error("Zero epsilon for acot");
not_reached();
}
if (qiszero(q)) {
epsilon1 = qscale(epsilon, 1L);
tmp1 = qpi(epsilon1);
qfree(epsilon1);
tmp2 = qscale(tmp1, -1L);
qfree(tmp1);
return tmp2;
}
tmp1 = qinv(q);
if (!qisneg(q)) {
tmp2 = qatan(tmp1, epsilon);
qfree(tmp1);
return tmp2;
}
epsilon1 = qscale(epsilon, -2L);
tmp2 = qatan(tmp1, epsilon1);
qfree(tmp1);
tmp1 = qpi(epsilon1);
qfree(epsilon1);
tmp3 = qqadd(tmp1, tmp2);
qfree(tmp1);
qfree(tmp2);
tmp1 = qmappr(tmp3, epsilon, 24L);
qfree(tmp3);
return tmp1;
}
/*
* Calculate the angle which is determined by the point (x,y).
* This is the same as atan(y/x) for positive x, but is continuous
* except for y = 0, x <= 0. By convention, y is the first argument.
* For all x, y, -pi < atan2 <= pi. For example, qatan2(1, -1) = 3/4 * pi.
*/
NUMBER *
qatan2(NUMBER *qy, NUMBER *qx, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2, *tmp3, *epsilon2;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for atan2");
not_reached();
}
if (qiszero(qy) && qiszero(qx)) {
/* conform to 4.3BSD ANSI/IEEE 754-1985 math lib */
return qlink(&_qzero_);
}
/*
* If the point is on the negative real axis, then the answer is pi.
*/
if (qiszero(qy) && qisneg(qx))
return qpi(epsilon);
/*
* If the point is in the right half plane, then use the normal atan.
*/
if (!qisneg(qx) && !qiszero(qx)) {
if (qiszero(qy))
return qlink(&_qzero_);
tmp1 = qqdiv(qy, qx);
tmp2 = qatan(tmp1, epsilon);
qfree(tmp1);
return tmp2;
}
/*
* The point is in the left half plane (x <= 0) with nonzero y.
* Calculate the angle by using the formula:
* atan2(y,x) = 2 * atan(sgn(y) * sqrt((x/y)^2 + 1) - x/y).
*/
epsilon2 = qscale(epsilon, -4L);
tmp1 = qqdiv(qx, qy);
tmp2 = qsquare(tmp1);
tmp3 = qqadd(tmp2, &_qone_);
qfree(tmp2);
tmp2 = qsqrt(tmp3, epsilon2, 24L | (qy->num.sign * 64));
qfree(tmp3);
tmp3 = qsub(tmp2, tmp1);
qfree(tmp2);
qfree(tmp1);
qfree(epsilon2);
epsilon2 = qscale(epsilon, -1L);
tmp1 = qatan(tmp3, epsilon2);
qfree(epsilon2);
qfree(tmp3);
tmp2 = qscale(tmp1, 1L);
qfree(tmp1);
return tmp2;
}
/*
* Calculate the value of pi to within the required epsilon.
* This uses the following formula which only needs integer calculations
* except for the final operation:
* pi = 1 / SUMOF(comb(2 * N, N) ^ 3 * (42 * N + 5) / 2 ^ (12 * N + 4)),
* where the summation runs from N=0. This formula gives about 6 bits of
* accuracy per term. Since the denominator for each term is a power of two,
* we can simply use shifts to sum the terms. The combinatorial numbers
* in the formula are calculated recursively using the formula:
* comb(2*(N+1), N+1) = 2 * comb(2 * N, N) * (2 * N + 1) / N.
*/
NUMBER *
qpi(NUMBER *epsilon)
{
ZVALUE comb; /* current combinatorial value */
ZVALUE sum; /* current sum */
ZVALUE tmp1, tmp2;
NUMBER *r, *t1, qtmp;
long shift; /* current shift of result */
long N; /* current term number */
long bits; /* needed number of bits of precision */
long t;
/* firewall */
if (qiszero(epsilon)) {
math_error("zero epsilon value for pi");
not_reached();
}
/* use pi cache if epsilon marches, else flush if needed */
if (pivalue[LAST_PI_EPSILON] != NULL &&
pivalue[LAST_PI_VALUE] != NULL &&
epsilon == pivalue[LAST_PI_EPSILON]) {
return qlink(pivalue[LAST_PI_VALUE]);
}
if (pivalue[LAST_PI_EPSILON] != NULL) {
qfree(pivalue[LAST_PI_EPSILON]);
}
if (pivalue[LAST_PI_VALUE] != NULL) {
qfree(pivalue[LAST_PI_VALUE]);
}
bits = -qilog2(epsilon) + 4;
if (bits < 4)
bits = 4;
comb = _one_;
itoz(5L, &sum);
N = 0;
shift = 4;
do {
t = 1 + (++N & 0x1);
(void) zdivi(comb, N / (3 - t), &tmp1);
zfree(comb);
zmuli(tmp1, t * (2 * N - 1), &comb);
zfree(tmp1);
zsquare(comb, &tmp1);
zmul(comb, tmp1, &tmp2);
zfree(tmp1);
zmuli(tmp2, 42 * N + 5, &tmp1);
zfree(tmp2);
zshift(sum, 12L, &tmp2);
zfree(sum);
zadd(tmp1, tmp2, &sum);
t = zhighbit(tmp1);
zfree(tmp1);
zfree(tmp2);
shift += 12;
} while ((shift - t) < bits);
zfree(comb);
qtmp.num = _one_;
qtmp.den = sum;
t1 = qscale(&qtmp, shift);
zfree(sum);
r = qmappr(t1, epsilon, 24L);
qfree(t1);
pivalue[LAST_PI_EPSILON] = qlink(epsilon);
pivalue[LAST_PI_VALUE] = qlink(r);
return r;
}
/*
* qpidiv180 - calculate pi / 180
*
* This function returns pi/180 as used to covert between radians and degrees.
*/
NUMBER *
qpidiv180(NUMBER *epsilon)
{
NUMBER *pi, *pidiv180;
/* firewall */
if (qiszero(epsilon)) {
math_error("zero epsilon value for qpidiv180");
not_reached();
}
/* use pi/180 cache if epsilon marches, else flush if needed */
if (pivalue[LAST_PI_DIV_180_EPSILON] != NULL &&
pivalue[LAST_PI_DIV_180_VALUE] != NULL &&
epsilon == pivalue[LAST_PI_DIV_180_EPSILON]) {
return qlink(pivalue[LAST_PI_DIV_180_VALUE]);
}
if (pivalue[LAST_PI_DIV_180_EPSILON] != NULL) {
qfree(pivalue[LAST_PI_DIV_180_EPSILON]);
}
if (pivalue[LAST_PI_DIV_180_VALUE] != NULL) {
qfree(pivalue[LAST_PI_DIV_180_VALUE]);
}
/* let qpi() returned cached pi or calculate new as needed */
pi = qpi(epsilon);
/* calculate pi/180 */
pidiv180 = qdivi(pi, 180);
/* cache epsilon and pi/180 */
pivalue[LAST_PI_DIV_180_EPSILON] = qlink(epsilon);
pivalue[LAST_PI_DIV_180_VALUE] = qlink(pidiv180);
/* return pi/180 */
return pidiv180;
}
/*
* qpidiv200 - calculate pi / 200
*
* This function returns pi/200 as used to covert between radians and gradians.
*/
NUMBER *
qpidiv200(NUMBER *epsilon)
{
NUMBER *pi, *pidiv200;
/* firewall */
if (qiszero(epsilon)) {
math_error("zero epsilon value for qpidiv200");
not_reached();
}
/* use pi/200 cache if epsilon marches, else flush if needed */
if (pivalue[LAST_PI_DIV_200_EPSILON] != NULL &&
pivalue[LAST_PI_DIV_200_VALUE] != NULL &&
epsilon == pivalue[LAST_PI_DIV_200_EPSILON]) {
return qlink(pivalue[LAST_PI_DIV_200_VALUE]);
}
if (pivalue[LAST_PI_DIV_200_EPSILON] != NULL) {
qfree(pivalue[LAST_PI_DIV_200_EPSILON]);
}
if (pivalue[LAST_PI_DIV_200_VALUE] != NULL) {
qfree(pivalue[LAST_PI_DIV_200_VALUE]);
}
/* let qpi() returned cached pi or calculate new as needed */
pi = qpi(epsilon);
/* calculate pi/200 */
pidiv200 = qdivi(pi, 200);
/* cache epsilon and pi/200 */
pivalue[LAST_PI_DIV_200_EPSILON] = qlink(epsilon);
pivalue[LAST_PI_DIV_200_VALUE] = qlink(pidiv200);
/* return pi/200 */
return pidiv200;
}
/*
* Calculate the exponential function to the nearest or next to nearest
* multiple of the positive number epsilon.
*/
NUMBER *
qexp(NUMBER *q, NUMBER *epsilon)
{
long m, n;
NUMBER *tmp1, *tmp2;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for exp");
not_reached();
}
if (qiszero(q))
return qlink(&_qone_);
tmp1 = qmul(q, &_qlge_);
m = qtoi(tmp1); /* exp(q) < 2^(m+1) or m == MAXLONG */
qfree(tmp1);
if (m > (1 << 30))
return NULL;
n = qilog2(epsilon); /* 2^n <= epsilon < 2^(n+1) */
if (m < n)
return qlink(&_qzero_);
tmp1 = qqabs(q);
tmp2 = qexprel(tmp1, m - n + 1);
qfree(tmp1);
if (tmp2 == NULL)
return NULL;
if (qisneg(q)) {
tmp1 = qinv(tmp2);
qfree(tmp2);
tmp2 = tmp1;
}
tmp1 = qmappr(tmp2, epsilon, 24L);
qfree(tmp2);
return tmp1;
}
/*
* Calculate the exponential function with relative error corresponding
* to a specified number of significant bits
* Requires *q >= 0, bitnum >= 0.
* This returns NULL if more than 2^30 working bits would be required.
*/
S_FUNC NUMBER *
qexprel(NUMBER *q, long bitnum)
{
long n, m, k, h, s, t, d;
NUMBER *qtmp1;
ZVALUE X, B, sum, term, ztmp1, ztmp2;
h = qilog2(q);
k = bitnum + h + 1;
if (k < 0)
return qlink(&_qone_);
s = k;
if (k) {
do {
t = s;
s = (s + k/s)/2;
}
while (t > s);
} /* s is int(sqrt(k)) */
s++;
if (s < -h)
s = -h;
n = h + s; /* n is number of squarings that will be required */
m = bitnum + n;
if (m > (1 << 30))
return NULL;
while (s > 0) { /* increasing m by ilog2(s) */
s >>= 1;
m++;
} /* m is working number of bits */
qtmp1 = qscale(q, m - n);
zquo(qtmp1->num, qtmp1->den, &X, 24);
qfree(qtmp1);
if (ziszero(X)) {
zfree(X);
return qlink(&_qone_);
}
zbitvalue(m, &sum);
zcopy(X, &term);
d = 1;
do {
zadd(sum, term, &ztmp1);
zfree(sum);
sum = ztmp1;
zmul(term, X, &ztmp1);
zfree(term);
zshift(ztmp1, -m, &ztmp2);
zfree(ztmp1);
zdivi(ztmp2, ++d, &term);
zfree(ztmp2);
}
while (!ziszero(term));
zfree(term);
zfree(X);
k = 0;
zbitvalue(2 * m + 1, &B);
while (n-- > 0) {
k *= 2;
zsquare(sum, &ztmp1);
zfree(sum);
if (zrel(ztmp1, B) >= 0) {
zshift(ztmp1, -m - 1, &sum);
k++;
} else {
zshift(ztmp1, -m, &sum);
}
zfree(ztmp1);
}
zfree(B);
h = zlowbit(sum);
qtmp1 = qalloc();
if (m > h + k) {
zshift(sum, -h, &qtmp1->num);
zbitvalue(m - h - k, &qtmp1->den);
}
else
zshift(sum, k - m, &qtmp1->num);
zfree(sum);
return qtmp1;
}
/*
* Calculate the natural logarithm of a number accurate to the specified
* positive epsilon.
*/
NUMBER *
qln(NUMBER *q, NUMBER *epsilon)
{
long m, n, k, h, d;
ZVALUE term, sum, mul, pow, X, D, B, ztmp;
NUMBER *qtmp, *res;
bool neg;
if (qiszero(q)) {
math_error("logarithm of 0");
not_reached();
}
if (qiszero(epsilon)) {
math_error("Zero epsilon value for ln");
not_reached();
}
if (qisunit(q))
return qlink(&_qzero_);
q = qqabs(q); /* Ignore sign of q */
neg = (zrel(q->num, q->den) < 0);
if (neg) {
qtmp = qinv(q);
qfree(q);
q = qtmp;
}
k = qilog2(q);
m = -qilog2(epsilon); /* m will be number of working bits */
if (m < 0)
m = 0;
h = k;
while (h > 0) {
h /= 2;
m++; /* Add 1 for each sqrt until X < 2 */
}
m += 18; /* 8 more sqrts, 8 for rounding, 2 for epsilon/4 */
qtmp = qscale(q, m - k);
zquo(qtmp->num, qtmp->den, &X, 24L);
qfree(q);
qfree(qtmp);
zbitvalue(m, &D); /* Now "q" = X/D */
zbitvalue(m - 8, &ztmp);
zadd(D, ztmp, &B); /* Will take sqrts until X <= B */
zfree(ztmp);
n = 1; /* n is to count 1 + number of sqrts */
while (k > 0 || zrel(X, B) > 0) {
n++;
zshift(X, m + (k & 1), &ztmp);
zfree(X);
zsqrt(ztmp, &X, 24);
zfree(ztmp)
k /= 2;
}
zfree(B);
zsub(X, D, &pow); /* pow, mul used as tmps */
zadd(X, D, &mul);
zfree(X);
zfree(D);
zshift(pow, m, &ztmp);
zfree(pow);
zquo(ztmp, mul, &pow, 24); /* pow now (X - D)/(X + D) */
zfree(ztmp);
zfree(mul);
zcopy(pow, &sum); /* pow is first term of sum */
zsquare(pow, &ztmp);
zshift(ztmp, -m, &mul); /* mul is now multiplier for powers */
zfree(ztmp);
d = 1;
for (;;) {
zmul(pow, mul, &ztmp);
zfree(pow);
zshift(ztmp, -m, &pow);
zfree(ztmp);
d += 2;
zdivi(pow, d, &term); /* Round down div should be round off */
if (ziszero(term)) {
zfree(term);
break;
}
zadd(sum, term, &ztmp);
zfree(term);
zfree(sum);
sum = ztmp;
}
zfree(pow);
zfree(mul);
qtmp = qalloc(); /* qtmp is to be 2^n * sum / 2^m */
k = zlowbit(sum);
sum.sign = neg;
if (k + n >= m) {
zshift(sum, n - m, &qtmp->num);
zfree(sum);
} else {
if (k) {
zshift(sum, -k, &qtmp->num);
zfree(sum);
} else {
qtmp->num = sum;
}
zbitvalue(m - k - n, &qtmp->den);
}
res = qmappr(qtmp, epsilon, 24L);
qfree(qtmp);
return res;
}
/*
* Calculate the base 10 logarithm
*
* log(q) = ln(q) / ln(10)
*/
NUMBER *
qlog(NUMBER *q, NUMBER *epsilon)
{
int need_new_ln_10 = true; /* false => use cached ln_10 value */
NUMBER *ln_q; /* ln(x) */
NUMBER *ret; /* base 10 logarithm of x */
/* firewall */
if (qiszero(q)) {
math_error("logarithm of 0");
not_reached();
}
if (qiszero(epsilon)) {
math_error("Zero epsilon value for log");
not_reached();
}
/*
* shortcut for small integer powers of 10
*/
if (qisint(q) && qispos(q) && !zge8192b(q->num) && ziseven(q->num)) {
bool is_10_power; /* true ==> q is a power of 10 */
long ilog_10; /* integer log base 10 */
/* try for a quick small power of 10 log */
ilog_10 = zlog10(q->num, &is_10_power );
if (is_10_power == true) {
/* is small power of 10, return log */
return itoq(ilog_10);
}
/* q is an even integer that is not a power of 10 */
}
/*
* compute ln(c) first
*/
ln_q = qln(q, epsilon);
/* quick return for log(1) == 0 */
if (qiszero(ln_q)) {
return ln_q;
}
/*
* save epsilon for ln(10) if needed
*/
if (ln_10_epsilon == NULL) {
/* first time call */
ln_10_epsilon = qcopy(epsilon);
} else if (qcmp(ln_10_epsilon, epsilon) == true) {
/* replaced cached value with epsilon arg */
qfree(ln_10_epsilon);
ln_10_epsilon = qcopy(epsilon);
} else if (ln_10 != NULL) {
/* the previously computed ln(2) is OK to use */
need_new_ln_10 = false;
}
/*
* compute ln(10) if needed
*/
if (need_new_ln_10 == true) {
if (ln_10 != NULL) {
qfree(ln_10);
}
ln_10 = qln(&_qten_, ln_10_epsilon);
}
/*
* return ln(q) / ln(10)
*/
ret = qqdiv(ln_q, ln_10);
qfree(ln_q);
return ret;
}
/*
* Calculate the base 2 logarithm
*
* log(q) = ln(q) / ln(2)
*/
NUMBER *
qlog2(NUMBER *q, NUMBER *epsilon)
{
int need_new_ln_2 = true; /* false => use cached ln_2 value */
NUMBER *ln_q; /* ln(x) */
NUMBER *ret; /* base 2 logarithm of x */
/* firewall */
if (qiszero(q)) {
math_error("logarithm of 0");
not_reached();
}
if (qiszero(epsilon)) {
math_error("Zero epsilon value for log2");
not_reached();
}
/*
* special case: q is integer power of 2
*/
ret = qalloc();
if (qispowerof2(q, &ret)) {
return ret;
}
qfree(ret);
/*
* compute ln(c) first
*/
ln_q = qln(q, epsilon);
/* quick return for ln(1) == 0 */
if (qiszero(ln_q)) {
return ln_q;
}
/*
* save epsilon for ln(2) if needed
*/
if (ln_2_epsilon == NULL) {
/* first time call */
ln_2_epsilon = qcopy(epsilon);
} else if (qcmp(ln_2_epsilon, epsilon) == true) {
/* replaced cached value with epsilon arg */
qfree(ln_2_epsilon);
ln_2_epsilon = qcopy(epsilon);
} else if (ln_2 != NULL) {
/* the previously computed ln(2) is OK to use */
need_new_ln_2 = false;
}
/*
* compute ln(2) if needed
*/
if (need_new_ln_2 == true) {
if (ln_2 != NULL) {
qfree(ln_2);
}
ln_2 = qln(&_qtwo_, ln_2_epsilon);
}
/*
* return ln(q) / ln(2)
*/
ret = qqdiv(ln_q, ln_2);
qfree(ln_q);
return ret;
}
/*
* Calculate the base n logarithm
*
* logn(q, n) = ln(q) / ln(n)
*/
NUMBER *
qlogn(NUMBER *q, NUMBER *n, NUMBER *epsilon)
{
int need_new_ln_n = true; /* false => use cached ln_n value */
NUMBER *ln_q; /* ln(x) */
NUMBER *ret; /* base 2 logarithm of x */
/* firewall */
if (qiszero(q)) {
math_error("logarithm of 0");
not_reached();
}
if (qiszero(epsilon)) {
math_error("Zero epsilon value for logn");
not_reached();
}
if (qiszero(n)) {
math_error("invalid logarithm base of 0 for logn");
not_reached();
}
if (qisone(n)) {
math_error("invalid logarithm base of 1 for logn");
not_reached();
}
/*
* special case: q is integer power of 2
*/
ret = qalloc();
if (qispowerof2(q, &ret)) {
return ret;
}
/* XXX - deal with n is integer power of 2 - XXX */
qfree(ret);
/*
* compute ln(q) first
*/
ln_q = qln(q, epsilon);
/* quick return for ln(1) == 0 */
if (qiszero(ln_q)) {
return ln_q;
}
/*
* save epsilon for ln(n) if needed
*/
if (ln_n_epsilon == NULL) {
/* first time call */
ln_n_epsilon = qcopy(epsilon);
} else if (qcmp(ln_n_epsilon, epsilon) == true) {
/* replaced cached value with epsilon arg */
qfree(ln_n_epsilon);
ln_n_epsilon = qcopy(epsilon);
} else if (ln_n != NULL) {
/* the previously computed ln(2) is OK to use */
need_new_ln_n = false;
}
/*
* compute ln(n) if needed
*/
if (need_new_ln_n == true) {
if (ln_n != NULL) {
qfree(ln_n);
}
ln_n = qln(&_qtwo_, ln_n_epsilon);
}
/*
* return ln(q) / ln(2)
*/
ret = qqdiv(ln_q, ln_n);
qfree(ln_q);
return ret;
}
/*
* Calculate the result of raising one number to the power of another.
* The result is calculated to the nearest or next to nearest multiple of
* epsilon.
*/
NUMBER *
qpower(NUMBER *q1, NUMBER *q2, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2, *epsilon2;
NUMBER *q1tmp, *q2tmp;
long m, n;
if (qiszero(epsilon)) {
math_error("Zero epsilon for power");
not_reached();
}
if (qiszero(q1) && qisneg(q2)) {
math_error("Negative power of zero");
not_reached();
}
if (qiszero(q2) || qisone(q1))
return qlink(&_qone_);
if (qiszero(q1))
return qlink(&_qzero_);
if (qisneg(q1)) {
math_error("Negative base for qpower");
not_reached();
}
if (qisone(q2))
return qmappr(q1, epsilon, 24);
if (zrel(q1->num, q1->den) < 0) {
q1tmp = qinv(q1);
q2tmp = qneg(q2);
} else {
q1tmp = qlink(q1);
q2tmp = qlink(q2);
}
if (qisone(q2tmp)) {
qfree(q2tmp);
q2tmp = qmappr(q1tmp, epsilon, 24);
qfree(q1tmp);
return q2tmp;
}
m = qilog2(q1tmp);
n = qilog2(epsilon);
if (qisneg(q2tmp)) {
if (m > 0) {
tmp1 = itoq(m);
tmp2 = qmul(tmp1, q2tmp);
m = qtoi(tmp2);
} else {
tmp1 = qdec(q1tmp);
tmp2 = qqdiv(tmp1, q1tmp);
qfree(tmp1);
tmp1 = qmul(tmp2, q2tmp);
qfree(tmp2);
tmp2 = qmul(tmp1, &_qlge_);
m = qtoi(tmp2);
}
} else {
if (m > 0) {
tmp1 = itoq(m + 1);
tmp2 = qmul(tmp1, q2tmp);
m = qtoi(tmp2);
} else {
tmp1 = qdec(q1tmp);
tmp2 = qmul(tmp1, q2tmp);
qfree(tmp1);
tmp1 = qmul(tmp2, &_qlge_);
m = qtoi(tmp1);
}
}
qfree(tmp1);
qfree(tmp2);
if (m > (1 << 30)) {
qfree(q1tmp);
qfree(q2tmp);
return NULL;
}
m += 1;
if (m < n) {
qfree(q1tmp);
qfree(q2tmp);
return qlink(&_qzero_);
}
tmp1 = qqdiv(epsilon, q2tmp);
tmp2 = qscale(tmp1, -m - 4);
epsilon2 = qqabs(tmp2);
qfree(tmp1);
qfree(tmp2);
tmp1 = qln(q1tmp, epsilon2);
qfree(epsilon2);
tmp2 = qmul(tmp1, q2tmp);
qfree(tmp1);
qfree(q1tmp);
qfree(q2tmp);
if (qisneg(tmp2)) {
tmp1 = qneg(tmp2);
qfree(tmp2);
tmp2 = qexprel(tmp1, m - n + 3);
if (tmp2 == NULL) {
qfree(tmp1);
return NULL;
}
qfree(tmp1);
tmp1 = qinv(tmp2);
} else {
tmp1 = qexprel(tmp2, m - n + 3) ;
if (tmp1 == NULL) {
qfree(tmp2);
return NULL;
}
}
qfree(tmp2);
tmp2 = qmappr(tmp1, epsilon, 24L);
qfree(tmp1);
return tmp2;
}
/*
* Calculate the K-th root of a number to within the specified accuracy.
*/
NUMBER *
qroot(NUMBER *q1, NUMBER *q2, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2;
int neg;
if (qiszero(epsilon)) {
math_error("Zero epsilon for root");
not_reached();
}
if (qisneg(q2) || qiszero(q2) || qisfrac(q2)) {
math_error("Taking bad root of number");
not_reached();
}
if (qiszero(q1) || qisone(q1) || qisone(q2))
return qlink(q1);
if (qistwo(q2))
return qsqrt(q1, epsilon, 24L);
neg = qisneg(q1);
if (neg) {
if (ziseven(q2->num)) {
math_error("Taking even root of negative number");
not_reached();
}
q1 = qqabs(q1);
}
tmp2 = qinv(q2);
tmp1 = qpower(q1, tmp2, epsilon);
qfree(tmp2);
if (tmp1 == NULL)
return NULL;
if (neg) {
tmp2 = qneg(tmp1);
qfree(tmp1);
tmp1 = tmp2;
}
return tmp1;
}
/* Calculate the hyperbolic cosine function to the nearest or next to
* nearest multiple of epsilon.
* This is calculated using cosh(x) = (exp(x) + 1/exp(x))/2;
*/
NUMBER *
qcosh(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2, *tmp3, *epsilon1;
epsilon1 = qscale(epsilon, -2);
tmp1 = qqabs(q);
tmp2 = qexp(tmp1, epsilon1);
qfree(tmp1);
qfree(epsilon1);
if (tmp2 == NULL)
return NULL;
tmp1 = qinv(tmp2);
tmp3 = qqadd(tmp1, tmp2);
qfree(tmp1)
qfree(tmp2)
tmp1 = qscale(tmp3, -1);
qfree(tmp3);
tmp2 = qmappr(tmp1, epsilon, 24L);
qfree(tmp1);
return tmp2;
}
/*
* Calculate the hyperbolic sine to the nearest or next to nearest
* multiple of epsilon.
* This is calculated using sinh(x) = (exp(x) - 1/exp(x))/2.
*/
NUMBER *
qsinh(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2, *tmp3, *epsilon1;
if (qiszero(q))
return qlink(&_qzero_);
epsilon1 = qscale(epsilon, -3);
tmp1 = qqabs(q);
tmp2 = qexp(tmp1, epsilon1);
qfree(tmp1);
qfree(epsilon1);
if (tmp2 == NULL)
return NULL;
tmp1 = qinv(tmp2);
tmp3 = qispos(q) ? qsub(tmp2, tmp1) : qsub(tmp1, tmp2);
qfree(tmp1)
qfree(tmp2)
tmp1 = qscale(tmp3, -1);
qfree(tmp3);
tmp2 = qmappr(tmp1, epsilon, 24L);
qfree(tmp1);
return tmp2;
}
/*
* Calculate the hyperbolic tangent to the nearest or next to nearest
* multiple of epsilon.
* This is calculated using the formulae:
* tanh(x) = 1 or -1 for very large abs(x)
* tanh(x) = (+ or -)(1 - 2 * exp(2 * x)) for large abx(x)
* tanh(x) = (exp(2*x) - 1)/(exp(2*x) + 1) otherwise
*/
NUMBER *
qtanh(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2, *tmp3;
long n, m;
n = qilog2(epsilon);
if (n > 0 || qiszero(q))
return qlink(&_qzero_);
n = -n;
tmp1 = qqabs(q);
tmp2 = qmul(tmp1, &_qlge_);
m = qtoi(tmp2); /* exp(|q|) < 2^(m+1) or m == MAXLONG */
qfree(tmp2);
if (m > 1 + n/2) {
qfree(tmp1);
return q->num.sign ? qlink(&_qnegone_) : qlink(&_qone_);
}
tmp2 = qscale(tmp1, 1);
qfree(tmp1);
tmp1 = qexprel(tmp2, 2 + n);
qfree(tmp2);
if (m > 1 + n/4) {
tmp2 = qqdiv(&_qtwo_, tmp1);
qfree(tmp1);
tmp1 = qsub(&_qone_, tmp2);
qfree(tmp2);
} else {
tmp2 = qdec(tmp1);
tmp3 = qinc(tmp1);
qfree(tmp1);
tmp1 = qqdiv(tmp2, tmp3);
qfree(tmp2);
qfree(tmp3);
}
tmp2 = qmappr(tmp1, epsilon, 24L);
qfree(tmp1);
if (qisneg(q)) {
tmp1 = qneg(tmp2);
qfree(tmp2);
return tmp1;
}
return tmp2;
}
/*
* Hyperbolic cotangent.
* Calculated using coth(x) = 1 + 2/(exp(2*x) - 1)
*/
NUMBER *
qcoth(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2, *res;
long n, k;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for coth");
not_reached();
}
if (qiszero(q)) {
math_error("Zero argument for coth");
not_reached();
}
tmp1 = qscale(q, 1);
tmp2 = qqabs(tmp1);
qfree(tmp1);
k = qilog2(tmp2);
n = qilog2(epsilon);
if (k > 0) {
tmp1 = qmul(&_qlge_, tmp2);
k = qtoi(tmp1);
qfree(tmp1);
} else {
k = 2 * k;
}
k = 4 - k - n;
if (k < 4)
k = 4;
tmp1 = qexprel(tmp2, k);
qfree(tmp2);
tmp2 = qdec(tmp1);
qfree(tmp1);
if (qiszero(tmp2)) {
math_error("This should not happen ????");
not_reached();
}
tmp1 = qinv(tmp2);
qfree(tmp2);
tmp2 = qscale(tmp1, 1);
qfree(tmp1);
tmp1 = qinc(tmp2);
qfree(tmp2);
if (qisneg(q)) {
tmp2 = qneg(tmp1);
qfree(tmp1);
tmp1 = tmp2;
}
res = qmappr(tmp1, epsilon, 24L);
qfree(tmp1);
return res;
}
NUMBER *
qsech(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2, *tmp3, *res;
long n, k;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for sech");
not_reached();
}
if (qiszero(q))
return qlink(&_qone_);
tmp1 = qqabs(q);
k = 0;
if (zrel(tmp1->num, tmp1->den) >= 0) {
tmp2 = qmul(&_qlge_, tmp1);
k = qtoi(tmp2);
qfree(tmp2);
}
n = qilog2(epsilon);
if (k + n > 1) {
qfree(tmp1);
return qlink(&_qzero_);
}
tmp2 = qexprel(tmp1, 4 - k - n);
qfree(tmp1);
tmp1 = qinv(tmp2);
tmp3 = qqadd(tmp1, tmp2);
qfree(tmp1);
qfree(tmp2);
tmp1 = qinv(tmp3);
qfree(tmp3);
tmp2 = qscale(tmp1, 1);
qfree(tmp1);
res = qmappr(tmp2, epsilon, 24L);
qfree(tmp2);
return res;
}
NUMBER *
qcsch(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2, *tmp3, *res;
long n, k;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for csch");
not_reached();
}
if (qiszero(q)) {
math_error("Zero argument for csch");
not_reached();
}
n = qilog2(epsilon);
tmp1 = qqabs(q);
if (zrel(tmp1->num, tmp1->den) >= 0) {
tmp2 = qmul(&_qlge_, tmp1);
k = qtoi(tmp2);
qfree(tmp2);
} else {
k = 2 * qilog2(tmp1);
}
if (k + n >= 1) {
qfree(tmp1);
return qlink(&_qzero_);
}
tmp2 = qexprel(tmp1, 4 - k - n);
qfree(tmp1);
tmp1 = qinv(tmp2);
if (qisneg(q))
tmp3 = qsub(tmp1, tmp2);
else
tmp3 = qsub(tmp2, tmp1);
qfree(tmp1);
qfree(tmp2);
tmp1 = qinv(tmp3);
qfree(tmp3)
tmp2 = qscale(tmp1, 1);
qfree(tmp1);
res = qmappr(tmp2, epsilon, 24L);
qfree(tmp2);
return res;
}
/*
* Compute the hyperbolic arccosine within the specified accuracy.
* This is calculated using the formula:
* acosh(x) = ln(x + sqrt(x^2 - 1)).
*/
NUMBER *
qacosh(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2, *epsilon1;
long n;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for acosh");
not_reached();
}
if (qisone(q))
return qlink(&_qzero_);
if (zrel(q->num, q->den) < 0)
return NULL;
n = qilog2(epsilon);
epsilon1 = qbitvalue(n - 3);
tmp1 = qsquare(q);
tmp2 = qdec(tmp1);
qfree(tmp1);
tmp1 = qsqrt(tmp2, epsilon1, 24L);
qfree(tmp2);
tmp2 = qqadd(tmp1, q);
qfree(tmp1);
tmp1 = qln(tmp2, epsilon1);
qfree(tmp2);
qfree(epsilon1);
tmp2 = qmappr(tmp1, epsilon, 24L);
qfree(tmp1);
return tmp2;
}
/*
* Compute the hyperbolic arcsine within the specified accuracy.
* This is calculated using the formula:
* asinh(x) = ln(x + sqrt(x^2 + 1)).
*/
NUMBER *
qasinh(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2, *epsilon1;
long n;
bool neg;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for asinh");
not_reached();
}
if (qiszero(q))
return qlink(&_qzero_);
neg = qisneg(q);
q = qqabs(q);
n = qilog2(epsilon);
epsilon1 = qbitvalue(n - 3);
tmp1 = qsquare(q);
tmp2 = qinc(tmp1);
qfree(tmp1);
tmp1 = qsqrt(tmp2, epsilon1, 24L);
qfree(tmp2);
tmp2 = qqadd(tmp1, q);
qfree(tmp1);
tmp1 = qln(tmp2, epsilon1);
qfree(tmp2);
qfree(q);
qfree(epsilon1);
tmp2 = qmappr(tmp1, epsilon, 24L);
if (neg) {
tmp1 = qneg(tmp2);
qfree(tmp2);
return tmp1;
}
return tmp2;
}
/*
* Compute the hyperbolic arctangent within the specified accuracy.
* This is calculated using the formula:
* atanh(x) = ln((1 + x) / (1 - x)) / 2.
*/
NUMBER *
qatanh(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp1, *tmp2, *tmp3, *epsilon1;
ZVALUE z;
if (qiszero(epsilon)) {
math_error("Zero epsilon value for atanh");
not_reached();
}
if (qiszero(q))
return qlink(&_qzero_);
z = q->num;
z.sign = 0;
if (zrel(z, q->den) >= 0)
return NULL;
tmp1 = qinc(q);
tmp2 = qsub(&_qone_, q);
tmp3 = qqdiv(tmp1, tmp2);
qfree(tmp1);
qfree(tmp2);
epsilon1 = qscale(epsilon, 1L);
tmp1 = qln(tmp3, epsilon1);
qfree(tmp3);
tmp2 = qscale(tmp1, -1L);
qfree(tmp1);
qfree(epsilon1);
return tmp2;
}
/*
* Inverse hyperbolic secant function
*/
NUMBER *
qasech(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp, *res;
tmp = qinv(q);
res = qacosh(tmp, epsilon);
qfree(tmp);
return res;
}
/*
* Inverse hyperbolic cosecant function
*/
NUMBER *
qacsch(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp, *res;
tmp = qinv(q);
res = qasinh(tmp, epsilon);
qfree(tmp);
return res;
}
/*
* Inverse hyperbolic cotangent function
*/
NUMBER *
qacoth(NUMBER *q, NUMBER *epsilon)
{
NUMBER *tmp, *res;
tmp = qinv(q);
res = qatanh(tmp, epsilon);
qfree(tmp);
return res;
}
/*
* qversin - versed sine for NUMBER values
*
* This uses the formula:
*
* versin(x) = 1 - cos(x)
*
* given:
* q real value to pass to the trig function
* epsilon error tolerance / precision for trig calculation
*
* returns:
* real value result of trig function on q with error epsilon
*/
NUMBER *
qversin(NUMBER *q, NUMBER *epsilon)
{
NUMBER *res;
NUMBER *cos;
/*
* firewall
*/
if (q == NULL) {
math_error("q is NULL for %s", __func__);
not_reached();
}
if (check_epsilon(epsilon) == false) {
math_error("Invalid epsilon arg for %s", __func__);
not_reached();
}
/*
* calculate trig function value
*/
cos = qcos(q, epsilon);
res = qsub(&_qone_, cos);
qfree(cos);
/*
* return 1 - cos(x)
*/
return res;
}
/*
* qaversin_or_NULL - inverse versed sine for NUMBER values
*
* This uses the formula:
*
* aversin(x) = acos(1 - x)
*
* given:
* q real value to pass to the trig function
* epsilon error tolerance / precision for trig calculation
*
* returns:
* != NULL ==> real value result of trig function on q with error epsilon,
* NULL ==> trig function value cannot be expressed as a NUMBER
*
* NOTE: If this function returns NULL, consider calling the equivalent
* COMPLEX function from comfunc.c. See the help file for the
* related builtin for details.
*/
NUMBER *
qaversin_or_NULL(NUMBER *q, NUMBER *epsilon)
{
NUMBER *res; /* inverse trig value result */
NUMBER *x; /* argument to inverse trig function */
/*
* firewall
*/
if (q == NULL) {
math_error("q is NULL for %s", __func__);
not_reached();
}
if (check_epsilon(epsilon) == false) {
math_error("Invalid epsilon arg for %s", __func__);
not_reached();
}
/*
* calculate inverse trig function value
*/
x = qsub(&_qone_, q);
res = qacos(x, epsilon);
qfree(x);
if (res == NULL) {
return NULL;
}
/*
* return acos(1 - x)
*/
return res;
}
/*
* qaversin - inverse versed sine for NUMBER values
*
* This uses the formula:
*
* aversin(x) = acos(1 - x)
*
* given:
* q real value to pass to the trig function
* epsilon error tolerance / precision for trig calculation
*
* returns:
* real value result of trig function on q with error epsilon
*/
NUMBER *
qaversin(NUMBER *q, NUMBER *epsilon)
{
NUMBER *res; /* inverse trig value result */
/*
* firewall
*/
if (q == NULL) {
math_error("q is NULL for %s", __func__);
not_reached();
}
if (check_epsilon(epsilon) == false) {
math_error("Invalid epsilon arg for %s", __func__);
not_reached();
}
/*
* calculate inverse trig function value
*/
res = qaversin_or_NULL(q, epsilon);
if (res == NULL) {
math_error("cannot compute inverse cos for aversin");
not_reached();
}
/*
* return acos(1 - x)
*/
return res;
}
/*
* qcoversin - coversed sine for NUMBER values
*
* This uses the formula:
*
* coversin((x) = 1 - sin(x)
*
* given:
* q real value to pass to the trig function
* epsilon error tolerance / precision for trig calculation
*
* returns:
* real value result of trig function on q with error epsilon
*/
NUMBER *
qcoversin(NUMBER *q, NUMBER *epsilon)
{
NUMBER *sin, *res;
/*
* firewall
*/
if (q == NULL) {
math_error("q is NULL for %s", __func__);
not_reached();
}
if (check_epsilon(epsilon) == false) {
math_error("Invalid epsilon arg for %s", __func__);
not_reached();
}
/*
* calculate trig function value
*/
sin = qsin(q, epsilon);
res = qsub(&_qone_, sin);
qfree(sin);
/*
* return 1 - sin(x)
*/
return res;
}
/*
* qacoversin_or_NULL - inverse coversed sine for NUMBER values
*
* This uses the formula:
*
* acoversin(x) = asin(1 - x)
*
* given:
* q real value to pass to the trig function
* epsilon error tolerance / precision for trig calculation
*
* returns:
* real value result of trig function on q with error epsilon
*
* returns:
* != NULL ==> real value result of trig function on q with error epsilon,
* NULL ==> trig function value cannot be expressed as a NUMBER
*
* NOTE: If this function returns NULL, consider calling the equivalent
* COMPLEX function from comfunc.c. See the help file for the
* related builtin for details.
*/
NUMBER *
qacoversin_or_NULL(NUMBER *q, NUMBER *epsilon)
{
NUMBER *res; /* inverse trig value result */
NUMBER *x; /* argument to inverse trig function */
/*
* firewall
*/
if (q == NULL) {
math_error("q is NULL for %s", __func__);
not_reached();
}
if (check_epsilon(epsilon) == false) {
math_error("Invalid epsilon arg for %s", __func__);
not_reached();
}
/*
* calculate inverse trig function value
*/
x = qsub(&_qone_, q);
res = qasin(x, epsilon);
qfree(x);
if (res == NULL) {
return NULL;
}
/*
* return asin(1 - x)
*/
return res;
}
/*
* qacoversin - inverse coversed sine for NUMBER values
*
* This uses the formula:
*
* acoversin(x) = asin(1 - x)
*
* given:
* q real value to pass to the trig function
* epsilon error tolerance / precision for trig calculation
*
* returns:
* real value result of trig function on q with error epsilon
*/
NUMBER *
qacoversin(NUMBER *q, NUMBER *epsilon)
{
NUMBER *res; /* inverse trig value result */
/*
* firewall
*/
if (q == NULL) {
math_error("q is NULL for %s", __func__);
not_reached();
}
if (check_epsilon(epsilon) == false) {
math_error("Invalid epsilon arg for %s", __func__);
not_reached();
}
/*
* calculate inverse trig function value
*/
res = qacoversin_or_NULL(q, epsilon);
if (res == NULL) {
math_error("cannot compute inverse sin for acoversin");
not_reached();
}
/*
* return asin(1 - x)
*/
return res;
}
/*
* qvercos - versed sine for NUMBER values
*
* This uses the formula:
*
* vercos(x) = 1 + cos(x)
*
* given:
* q real value to pass to the trig function
* epsilon error tolerance / precision for trig calculation
*
* returns:
* real value result of trig function on q with error epsilon
*/
NUMBER *
qvercos(NUMBER *q, NUMBER *epsilon)
{
NUMBER *cos, *res;
/*
* firewall
*/
if (q == NULL) {
math_error("q is NULL for %s", __func__);
not_reached();
}
if (check_epsilon(epsilon) == false) {
math_error("Invalid epsilon arg for %s", __func__);
not_reached();
}
/*
* calculate trig function value
*/
cos = qcos(q, epsilon);
res = qqadd(&_qone_, cos);
qfree(cos);
/*
* return 1 + cos(x)
*/
return res;
}
/*
* qavercos_or_NULL - inverse versed sine for NUMBER values
*
* This uses the formula:
*
* avercos(x) = acos(x - 1)
*
* given:
* q real value to pass to the trig function
* epsilon error tolerance / precision for trig calculation
*
* returns:
* != NULL ==> real value result of trig function on q with error epsilon,
* NULL ==> trig function value cannot be expressed as a NUMBER
*
* NOTE: If this function returns NULL, consider calling the equivalent
* COMPLEX function from comfunc.c. See the help file for the
* related builtin for details.
*/
NUMBER *
qavercos_or_NULL(NUMBER *q, NUMBER *epsilon)
{
NUMBER *res; /* inverse trig value result */
NUMBER *x; /* argument to inverse trig function */
/*
* firewall
*/
if (q == NULL) {
math_error("q is NULL for %s", __func__);
not_reached();
}
if (check_epsilon(epsilon) == false) {
math_error("Invalid epsilon arg for %s", __func__);
not_reached();
}
/*
* calculate inverse trig function value
*/
x = qsub(q, &_qone_);
res = qacos(x, epsilon);
qfree(x);
if (res == NULL) {
return NULL;
}
/*
* return acos(x - 1)
*/
return res;
}
/*
* qavercos - inverse versed sine for NUMBER values
*
* This uses the formula:
*
* avercos(x) = acos(x - 1)
*
* given:
* q real value to pass to the trig function
* epsilon error tolerance / precision for trig calculation
*
* returns:
* real value result of trig function on q with error epsilon
*/
NUMBER *
qavercos(NUMBER *q, NUMBER *epsilon)
{
NUMBER *res; /* inverse trig value result */
/*
* firewall
*/
if (q == NULL) {
math_error("q is NULL for %s", __func__);
not_reached();
}
if (check_epsilon(epsilon) == false) {
math_error("Invalid epsilon arg for %s", __func__);
not_reached();
}
/*
* calculate inverse trig function value
*/
res = qavercos_or_NULL(q, epsilon);
if (res == NULL) {
math_error("cannot compute inverse cos for avercos");
not_reached();
}
/*
* return acos(x - 1)
*/
return res;
}
/*
* qcovercos - coversed sine for NUMBER values
*
* This uses the formula:
*
* covercos((x) = 1 + sin(x)
*
* given:
* q real value to pass to the trig function
* epsilon error tolerance / precision for trig calculation
*
* returns:
* real value result of trig function on q with error epsilon
*/
NUMBER *
qcovercos(NUMBER *q, NUMBER *epsilon)
{
NUMBER *sin, *res;
/*
* firewall
*/
if (q == NULL) {
math_error("q is NULL for %s", __func__);
not_reached();
}
if (check_epsilon(epsilon) == false) {
math_error("Invalid epsilon arg for %s", __func__);
not_reached();
}
/*
* calculate trig function value
*/
sin = qsin(q, epsilon);
res = qqadd(&_qone_, sin);
qfree(sin);
/*
* return 1 + sin(x)
*/
return res;
}
/*
* qacovercos_or_NULL - inverse coversed sine for NUMBER values
*
* This uses the formula:
*
* acovercos(x) = asin(x - 1)
*
* given:
* q real value to pass to the trig function
* epsilon error tolerance / precision for trig calculation
*
* returns:
* real value result of trig function on q with error epsilon
*
* returns:
* != NULL ==> real value result of trig function on q with error epsilon,
* NULL ==> trig function value cannot be expressed as a NUMBER
*
* NOTE: If this function returns NULL, consider calling the equivalent
* COMPLEX function from comfunc.c. See the help file for the
* related builtin for details.
*/
NUMBER *
qacovercos_or_NULL(NUMBER *q, NUMBER *epsilon)
{
NUMBER *res; /* inverse trig value result */
NUMBER *x; /* argument to inverse trig function */
/*
* firewall
*/
if (q == NULL) {
math_error("q is NULL for %s", __func__);
not_reached();
}
if (check_epsilon(epsilon) == false) {
math_error("Invalid epsilon arg for %s", __func__);
not_reached();
}
/*
* calculate inverse trig function value
*/
x = qsub(&_qone_, q);
res = qasin(x, epsilon);
qfree(x);
if (res == NULL) {
return NULL;
}
/*
* return asin(x - 1)
*/
return res;
}
/*
* qacovercos - inverse coversed sine for NUMBER values
*
* This uses the formula:
*
* acovercos(x) = asin(x - 1)
*
* given:
* q real value to pass to the trig function
* epsilon error tolerance / precision for trig calculation
*
* returns:
* real value result of trig function on q with error epsilon
*/
NUMBER *
qacovercos(NUMBER *q, NUMBER *epsilon)
{
NUMBER *res; /* inverse trig value result */
/*
* firewall
*/
if (q == NULL) {
math_error("q is NULL for %s", __func__);
not_reached();
}
if (check_epsilon(epsilon) == false) {
math_error("Invalid epsilon arg for %s", __func__);
not_reached();
}
/*
* calculate inverse trig function value
*/
res = qacovercos_or_NULL(q, epsilon);
if (res == NULL) {
math_error("cannot compute inverse sin for acovercos");
not_reached();
}
/*
* return asin(x - 1)
*/
return res;
}