dcsimg
Results 1 to 5 of 5

Thread: [VB6] - Module with advanced mathematical functions for real and complex numbers.

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,367

    [VB6] - Module with advanced mathematical functions for real and complex numbers.

    Code:
    '+=====================================================================================================================================+
    '|                                                                                                                                     |
    '|                                    An additional set of mathematical functions for Visual Basic 6                                   |
    '|                                                                                                                                     |
    '|                                           Кривоус Анатолий Анатольевич (The trick)                                                  |
    '|                                                                                                                                     |
    '+=====================================================================================================================================+
    
    Private Declare Function GetMem2 Lib "msvbvm60" (pSrc As Any, pDst As Any) As Long
    Private Declare Function GetMem4 Lib "msvbvm60" (pSrc As Any, pDst As Any) As Long
    Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long
    
    Public Type Complex
        R   As Double
        I   As Double
    End Type
    
    Public Type Matrix
        Col As Long                 ' Number of columns
        Row As Long                 ' Number of rows
        D() As Double
    End Type
    
    Public Const PI = 3.14159265358979
    Public Const E = 2.71828182845905
    
    Private Const PI2 = PI / 2
    
    '+=====================================================================================================================================+
    '|                                                            Real numbers                                                             |
    '+=====================================================================================================================================+
    
    ' // From degree to radians
    Public Function Deg(ByVal Value As Double) As Double
        Deg = 1.74532925199433E-02 * Value
    End Function
    
    ' // The logarithm to the base of a real number X
    Public Function LogX(ByVal Value As Double, ByVal Base As Double) As Double
        LogX = Log(Value) / Log(Base)
    End Function
    
    ' // The decimal logarithm of a real number
    Public Function Log10(ByVal Value As Double) As Double
        Log10 = Log(Value) / 2.30258509299405
    End Function
    
    ' // The binary logarithm of a real number
    Public Function Log2(ByVal Value As Double) As Double
        Log2 = Log(Value) / 0.693147180559945
    End Function
    
    ' // Rounding up
    Public Function Ceil(ByVal Value As Double) As Double
        Ceil = -Int(-Value)
    End Function
    
    ' // Rounding down (Int)
    Public Function Floor(ByVal Value As Double) As Double
        Floor = Int(Value)
    End Function
    
    ' // Secant of a real number
    Public Function Sec(ByVal Value As Double) As Double
        Sec = 1 / Cos(Value)
    End Function
    
    ' // Cosecant of a real number
    Public Function Csc(ByVal Value As Double) As Double
        Csc = 1 / Sin(Value)
    End Function
    
    ' // Cotangent of a real number
    Public Function Ctg(ByVal Value As Double) As Double
        Ctg = 1 / Tan(Value)
    End Function
    
    ' // Arcsine of a real number
    Public Function Asin(ByVal Value As Double) As Double
        If Value = -1 Then Asin = -PI2: Exit Function
        If Value = 1 Then Asin = PI2: Exit Function
        Asin = Atn(Value / Sqr(-Value * Value + 1))
    End Function
    
    ' // Arccosine of a real number
    Public Function Acos(ByVal Value As Double) As Double
        If CSng(Value) = -1# Then Acos = PI: Exit Function
        If CSng(Value) = 1# Then Acos = 0: Exit Function
        Acos = Atn(-Value / Sqr(-Value * Value + 1)) + 2 * Atn(1)
    End Function
    
    ' // Arcsecant of a real number
    Public Function Asec(ByVal Value As Double) As Double
        Asec = 1.5707963267949 - Atn(Sgn(Value) / Sqr(Value * Value - 1))
    End Function
    
    ' // Arccosecant of a real number
    Public Function Acsc(ByVal Value As Double) As Double
        Acsc = Atn(Sgn(Value) / Sqr(Value * Value - 1))
    End Function
    
    ' // Returns the angle whose tangent is the ratio of the two numbers
    Public Function Atan2(ByVal Y As Double, ByVal X As Double) As Double
        If Y > 0 Then
            If X >= Y Then
                Atan2 = Atn(Y / X)
            ElseIf X <= -Y Then
                Atan2 = Atn(Y / X) + PI
            Else
                Atan2 = PI / 2 - Atn(X / Y)
            End If
        Else
            If X >= -Y Then
                Atan2 = Atn(Y / X)
            ElseIf X <= Y Then
                Atan2 = Atn(Y / X) - PI
            Else
                Atan2 = -Atn(X / Y) - PI / 2
            End If
        End If
    End Function
    
    ' // Arccotangent of a real number
    Public Function Actg(ByVal Value As Double) As Double
        Actg = 1.5707963267949 - Atn(Value)
    End Function
    
    ' // Hyperbolic sine of a real number
    Public Function Sinh(ByVal Value As Double) As Double
        Sinh = (Exp(Value) - Exp(-Value)) / 2
    End Function
    
    ' // Hyperbolic cosine of a real number
    Public Function Cosh(ByVal Value As Double) As Double
        Cosh = (Exp(Value) + Exp(-Value)) / 2
    End Function
    
    ' // Hyperbolic tangent of a real number
    Public Function Tanh(ByVal Value As Double) As Double
        Tanh = (Exp(2 * Value) - 1) / (Exp(2 * Value) + 1)
    End Function
    
    ' // Hyperbolic cotangent of a real number
    Public Function Ctgh(ByVal Value As Double) As Double
        Ctgh = 1 / (Exp(2 * Value) + 1) / (Exp(2 * Value) - 1)
    End Function
    
    ' // Hyperbolic secant of a real number
    Public Function Sech(ByVal Value As Double) As Double
        Sech = 2 / (Exp(Value) + Exp(-Value))
    End Function
    
    ' // Hyperbolic cosecant of a real number
    Public Function Csch(ByVal Value As Double) As Double
        Csch = 2 / (Exp(Value) - Exp(-Value))
    End Function
    
    ' // Hyperbolic arcsine of a real number
    Public Function Asinh(ByVal Value As Double) As Double
        Asinh = Log(Value + Sqr(Value * Value + 1))
    End Function
    
    ' // Hyperbolic arcosine of a real number
    Public Function Acosh(ByVal Value As Double) As Double
        Acosh = Log(Value + Sqr(Value * Value - 1))
    End Function
    
    ' // Hyperbolic arctangent of a real number
    Public Function Atanh(ByVal Value As Double) As Double
        Atanh = Log((1 + Value) / (1 - Value)) / 2
    End Function
    
    ' // Hyperbolic arccotangent of a real number
    Public Function Actan(ByVal Value As Double) As Double
        Actan = Log((Value + 1) / (Value - 1)) / 2
    End Function
    
    ' // Hyperbolic arcsecant of a real number
    Public Function Asech(ByVal Value As Double) As Double
        Asech = Log((Sqr(-Value * Value + 1) + 1) / Value)
    End Function
    
    ' // Hyperbolic arccosecant of a real number
    Public Function Acsch(ByVal Value As Double) As Double
        Acsch = Log((Sgn(Value) * Sqr(Value * Value + 1) + 1) / Value)
    End Function
    
    ' // Return maximum of two numbers
    Public Function Max(ByVal Op1 As Double, ByVal Op2 As Double) As Double
        Max = IIf(Op1 > Op2, Op1, Op2)
    End Function
    
    ' // Return maximum of three numbers
    Public Function Max3(ByVal Op1 As Double, ByVal Op2 As Double, ByVal Op3 As Double) As Double
        Max3 = IIf(Op1 > Op2, IIf(Op1 > Op3, Op1, Op3), IIf(Op2 > Op3, Op2, Op3))
    End Function
    
    ' // Return maximum of four numbers
    Public Function Max4(ByVal Op1 As Double, ByVal Op2 As Double, ByVal Op3 As Double, ByVal Op4 As Double) As Double
        Max4 = Max(Max3(Op1, Op2, Op3), Op4)
    End Function
    
    ' // Return minimum of two numbers
    Public Function Min(ByVal Op1 As Double, ByVal Op2 As Double) As Double
        Min = IIf(Op1 < Op2, Op1, Op2)
    End Function
    
    ' // Return minimum of three numbers
    Public Function Min3(ByVal Op1 As Double, ByVal Op2 As Double, ByVal Op3 As Double) As Double
        Min3 = IIf(Op1 < Op2, IIf(Op1 < Op3, Op1, Op3), IIf(Op2 < Op3, Op2, Op3))
    End Function
    
    ' // Return minimum of four numbers
    Public Function Min4(ByVal Op1 As Double, ByVal Op2 As Double, ByVal Op3 As Double, ByVal Op4 As Double) As Double
        Min4 = Min(Min3(Op1, Op2, Op3), Op4)
    End Function
    
    ' // Returns the remainder of dividing one specified number by another specified number.
    Public Function IEEERemainder(ByVal Op1 As Double, ByVal Op2 As Double) As Double
        IEEERemainder = Op1 - (Op2 * Round(Op1 / Op2))
    End Function
    
    ' // Returns the remainder of dividing one specified number by another specified number.
    Public Function rMod(ByVal Op1 As Double, ByVal Op2 As Double) As Double
        rMod = (Abs(Op1) - (Abs(Op2) * (Int(Abs(Op1) / Abs(Op2))))) * Sgn(Op1)
    End Function

  2. #2

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,367

    Re: [VB6] - Module with advanced mathematical functions for real and complex numbers.

    Code:
    '+=====================================================================================================================================+
    '|                                                          Complex numbers                                                            |
    '+=====================================================================================================================================+
    
    ' // R = 1, I = 0
    Public Function cxOne() As Complex
        cxOne.R = 1
    End Function
    
    ' // R = 0, I = 1
    Public Function cxImgOne() As Complex
        cxOne.I = 1
    End Function
    
    ' // R = 0, I = 0
    Public Function cxZero() As Complex
    End Function
    
    ' // Creating a new complex number
    Public Function cxNew(ByVal Real As Double, ByVal Imaginary As Double) As Complex
        cxNew.R = Real: cxNew.I = Imaginary
    End Function
    
    ' // Creating a new complex number by polar coordinates
    Public Function cxPolar(ByVal Magnitude As Double, ByVal Phase As Double) As Complex
        cxPolar.R = Magnitude * Cos(Phase): cxPolar.I = Magnitude * Sin(Phase)
    End Function
    
    ' // Return the additive inverse of a specified complex number
    Public Function cxNeg(Op As Complex) As Complex
        cxNeg.R = -Op.R: cxNeg.I = -Op.I
    End Function
    
    ' // Return the inverse value of a complex number
    Public Function cxInv(Op As Complex) As Complex
        Dim Ab2 As Double
        Ab2 = Op.R * Op.R + Op.I * Op.I
        cxInv.R = Op.R / Ab2: cxInv.I = -Op.I / Ab2
    End Function
    
    ' // Addition of two complex numbers
    Public Function cxAdd(Op1 As Complex, Op2 As Complex) As Complex
        cxAdd.R = Op1.R + Op2.R
        cxAdd.I = Op1.I + Op2.I
    End Function
    
    ' // Subtraction of two complex numbers
    Public Function cxSub(Op1 As Complex, Op2 As Complex) As Complex
        cxSub.R = Op1.R - Op2.R
        cxSub.I = Op1.I - Op2.I
    End Function
    
    ' // Multiplication of two complex numbers
    Public Function cxMul(Op1 As Complex, Op2 As Complex) As Complex
        cxMul.R = Op1.R * Op2.R - Op1.I * Op2.I
        cxMul.I = Op1.R * Op2.I + Op1.I * Op2.R
    End Function
    
    ' // Division of two complex numbers
    Public Function cxDiv(Op1 As Complex, Op2 As Complex) As Complex
        Dim R2 As Double, i2 As Double
        R2 = Op2.R * Op2.R: i2 = Op2.I * Op2.I
        cxDiv.R = (Op1.R * Op2.R + Op1.I * Op2.I) / (R2 + i2)
        cxDiv.I = (Op1.I * Op2.R - Op1.R * Op2.I) / (R2 + i2)
    End Function
    
    ' // Exponentiation of a complex number
    Public Function cxDgr(Op As Complex, ByVal Degree As Long) As Complex
        Dim Md As Double, Ar As Double
        Md = cxMod(Op): Ar = cxArg(Op): Md = Md ^ Degree: Ar = Ar * Degree
        cxDgr.R = Md * Cos(Ar): cxDgr.I = Md * Sin(Ar)
    End Function
    
    ' // The square root of a complex number
    Public Function cxSqr(Op As Complex) As Complex
        Dim M As Double, A As Double
        M = Sqr(cxMod(Op)): A = cxArg(Op) / 2
        cxSqr.R = M * Cos(A): cxSqr.I = M * Sin(A)
    End Function
    
    ' // Module of a complex number
    Public Function cxMod(Op As Complex) As Double
        Dim R2 As Double, i2 As Double
        R2 = Op.R * Op.R: i2 = Op.I * Op.I
        cxMod = Sqr(R2 + i2)
    End Function
    
    ' // Phase of a complex number
    Public Function cxPhase(Op As Complex) As Double
        cxPhase = Atan2(Op.I, Op.R)
    End Function
    
    ' // Argument of a complex number (equal phase)
    Public Function cxArg(Op As Complex) As Double
        If Op.I = 0 Then
            If Op.R >= 0 Then cxArg = 0 Else cxArg = PI
        ElseIf Op.R = 0 Then
            If Op.I >= 0 Then cxArg = PI2 Else cxArg = -PI2
        Else
            If Op.R > 0 Then
                cxArg = Atn(Op.I / Op.R)
            ElseIf Op.R < 0 And Op.I > 0 Then
                cxArg = PI + Atn(Op.I / Op.R)
            ElseIf Op.R < 0 And Op.I < 0 Then
                cxArg = -PI + Atn(Op.I / Op.R)
            End If
        End If
    End Function
    
    ' // Returns the number e, raised to power by complex number
    Public Function cxExp(Op As Complex) As Complex
        cxExp.R = Exp(Op.R) * Cos(Op.I): cxExp.I = Exp(Op.R) * Sin(Op.I)
    End Function
    
    ' // Addition real number and complex number
    Public Function cxAddReal(Op1 As Complex, ByVal Op2 As Double) As Complex
        cxAddReal.R = Op1.R + Op2
        cxAddReal.I = Op1.I
    End Function
    
    ' // Subtraction from complex number a real number
    Public Function cxSubReal(Op1 As Complex, ByVal Op2 As Double) As Complex
        cxSubReal.R = Op1.R - Op2
        cxSubReal.I = Op1.I
    End Function
    
    ' // Subtraction from real number a complex number
    Public Function cxRealSub(ByVal Op1 As Double, Op2 As Complex) As Complex
        cxRealSub.R = Op1 - Op2.R
        cxRealSub.I = -Op2.I
    End Function
    
    ' // Multiplication complex number on a real number
    Public Function cxMulReal(Op1 As Complex, ByVal Op2 As Double) As Complex
        cxMulReal.R = Op1.R * Op2
        cxMulReal.I = Op1.I * Op2
    End Function
    
    ' // Division a complex number on a real number
    Public Function cxDivReal(Op1 As Complex, ByVal Op2 As Double) As Complex
        Dim R2 As Double
        R2 = Op2 * Op2
        cxDivReal.R = (Op1.R * Op2) / R2
        cxDivReal.I = (Op1.I * Op2) / R2
    End Function
    
    ' // Division a real number on a complex number
    Public Function cxRealDiv(ByVal Op1 As Double, Op2 As Complex) As Complex
        Dim R2 As Double, i2 As Double
        R2 = Op2.R * Op2.R: i2 = Op2.I * Op2.I
        cxRealDiv.R = (Op1 * Op2.R) / (R2 + i2)
        cxRealDiv.I = (-Op1 * Op2.I) / (R2 + i2)
    End Function
    
    ' // Addition of a complex number and imaginary part
    Public Function cxAddImg(Op1 As Complex, ByVal Op2 As Double) As Complex
        cxAddImg.R = Op1.R
        cxAddImg.I = Op1.I + Op2
    End Function
    
    ' // Subtraction from a complex number a imaginary part
    Public Function cxSubImg(ByVal Op1 As Complex, Op2 As Double) As Complex
        cxSubImg.R = Op1.R
        cxSubImg.I = Op1.I - Op2
    End Function
    
    ' // Subtraction from imaginary part a complex number
    Public Function cxImgSub(ByVal Op1 As Double, Op2 As Complex) As Complex
        cxImgSub.R = -Op2.R
        cxImgSub.I = Op1 - Op2.I
    End Function
    
    ' // Multiplication complex number on a imaginary part
    Public Function cxMulImg(Op1 As Complex, ByVal Op2 As Double) As Complex
        cxMulImg.R = -Op1.I * Op2
        cxMulImg.I = Op1.R * Op2
    End Function
    
    ' // Division a complex number on a imaginary part
    Public Function cxDivImg(Op1 As Complex, ByVal Op2 As Double) As Complex
        Dim i2 As Double
        i2 = Op2 * Op2
        cxDivImg.R = (Op1.I * Op2) / i2
        cxDivImg.I = (-Op1.R * Op2) / i2
    End Function
    
    ' // Division imaginary part on a complex number
    Public Function cxImgDiv(ByVal Op1 As Double, Op2 As Complex) As Complex
        Dim R2 As Double, i2 As Double
        R2 = Op2.R * Op2.R: i2 = Op2.I * Op2.I
        cxImgDiv.R = (Op1 * Op2.I) / (R2 + i2)
        cxImgDiv.I = (Op1 * Op2.R) / (R2 + i2)
    End Function
    
    ' // Return true if complex number is equal
    Public Function cxEq(Op1 As Complex, Op2 As Complex, _
                    Optional NumDigitsAfterDecimal As Long = -1) As Boolean
        If NumDigitsAfterDecimal = -1 Then
            If Op1.R = Op2.R And Op1.I = Op2.I Then cxEq = True
        Else
            If Round(Op1.R, NumDigitsAfterDecimal) = Round(Op2.R, NumDigitsAfterDecimal) And _
               Round(Op1.I, NumDigitsAfterDecimal) = Round(Op2.I, NumDigitsAfterDecimal) Then cxEq = True
        End If
    End Function
    
    ' // Return absolute value of a complex number
    Public Function cxAbs(Op As Complex) As Double
        If Op.I = 0 Then
            cxAbs = 0
        ElseIf Op.R > Op.I Then
            cxAbs = Sqr(1 + (Op.I * Op.I) / (Op.R * Op.R))
        ElseIf Op.R <= Op.I Then
            cxAbs = Sqr(1 + (Op.R * Op.R) / (Op.I * Op.I))
        End If
    End Function
    
    ' // Return complex conjugate of complex number
    Public Function cxConj(Op As Complex) As Complex
        cxConj.R = Op.R
        cxConj.I = -Op.I
    End Function
    
    ' // The natural logarithm of a complex number
    Public Function cxLog(Op As Complex) As Complex
        Dim M As Double, A As Double
        M = cxMod(Op): A = cxArg(Op)
        cxLog.R = Log(M): cxLog.I = A
    End Function
    
    ' // The logarithm of a complex number by base X
    Public Function cxLogX(Op As Complex, ByVal Base As Double) As Complex
        Dim M As Double, A As Double, Nc As Complex
        M = cxMod(Op): A = cxArg(Op): Nc.R = Log(Base)
        cxLogX.R = Log(M): cxLogX.I = A
        cxLogX = cxDiv(cxLogX, Nc)
    End Function
    
    ' // Sine of a complex number
    Public Function cxSin(Op As Complex) As Complex
        cxSin.R = Sin(Op.R) * Cosh(Op.I): cxSin.I = Cos(Op.R) * Sinh(Op.I)
    End Function
     
    ' // Cosine of a complex number
    Public Function cxCos(Op As Complex) As Complex
        cxCos.R = Cos(Op.R) * Cosh(Op.I): cxCos.I = -Sin(Op.R) * Sinh(Op.I)
    End Function
    
    ' // Tangent of a complex number
    Public Function cxTan(Op As Complex) As Complex
        Dim C2 As Double, S2 As Double
        C2 = Cos(Op.R): C2 = C2 * C2: S2 = Sinh(Op.I): S2 = S2 * S2
        cxTan.R = (Sin(Op.R) * Cos(Op.R)) / (C2 + S2)
        cxTan.I = (Sinh(Op.I) * Cosh(Op.I)) / (C2 + S2)
    End Function
    
    ' // Cotangent of a complex number
    Public Function cxCtg(Op As Complex) As Complex
        Dim C2 As Double, S2 As Double
        C2 = Sin(Op.R): C2 = C2 * C2: S2 = Sinh(Op.I): S2 = S2 * S2
        cxCtg.R = (Sin(Op.R) * Cos(Op.R)) / (C2 + S2)
        cxCtg.I = -(Sinh(Op.I) * Cosh(Op.I)) / (C2 + S2)
    End Function
    
    ' // Secant of a complex number
    Public Function cxSec(Op As Complex) As Complex
        Dim C2 As Double, S2 As Double
        C2 = Cos(Op.R): C2 = C2 * C2: S2 = Sinh(Op.I): S2 = S2 * S2
        cxSec.R = (Cos(Op.R) * Cosh(Op.I)) / (C2 + S2)
        cxSec.I = -(Sin(Op.R) * Sinh(Op.I)) / (C2 + S2)
    End Function
    
    ' // Cosecant of a complex number
    Public Function cxCsc(Op As Complex) As Complex
        Dim C2 As Double, S2 As Double
        C2 = Sin(Op.R): C2 = C2 * C2: S2 = Sinh(Op.I): S2 = S2 * S2
        cxCsc.R = (Sin(Op.R) * Cosh(Op.I)) / (C2 + S2)
        cxCsc.I = (Cos(Op.R) * Sinh(Op.I)) / (C2 + S2)
    End Function
    
    ' // Arcsine of a complex number
    Public Function cxAsin(Op As Complex) As Complex
        cxAsin = cxMulImg(cxLog(cxAdd(cxMulImg(Op, 1), cxSqr(cxRealSub(1, cxMul(Op, Op))))), -1)
    End Function
    
    ' // Arccosine of a complex number
    Public Function cxAcos(Op As Complex) As Complex
        cxAcos = cxAddReal(cxMulImg(cxLog(cxAdd(cxMulImg(Op, 1), cxSqr(cxRealSub(1, cxMul(Op, Op))))), 1), PI2)
    End Function
    
    ' // Arctangent of a complex number
    Public Function cxAtan(Op As Complex) As Complex
        Dim Iz As Complex
        Iz = cxMulImg(Op, 1)
        cxAtan = cxMulImg(cxSub(cxLog(cxRealSub(1, Iz)), cxLog(cxAddReal(Iz, 1))), 0.5)
    End Function
    
    ' // Arccotangent of a complex number
    Public Function cxActg(Op As Complex) As Complex
        cxActg = cxMulImg(cxSub(cxLog(cxDiv(cxSubImg(Op, 1), Op)), cxLog(cxDiv(cxAddImg(Op, 1), Op))), 0.5)
    End Function
    
    ' // Arcsecant of a complex number
    Public Function cxAsec(Op As Complex) As Complex
        cxAsec = cxAcos(cxDgr(Op, -1))
    End Function
    
    ' // Arccosecant of a complex number
    Public Function cxAcsc(Op As Complex) As Complex
        cxAcsc = cxAsin(cxDgr(Op, -1))
    End Function
    
    ' // Hyperbolic sine of a complex number
    Public Function cxSinh(Op As Complex) As Complex
        cxSinh = cxMulImg(cxSin(cxMulImg(Op, 1)), -1)
    End Function
    
    ' // Hyperbolic cosine of a complex number
    Public Function cxCosh(Op As Complex) As Complex
        cxCosh = cxCos(cxMulImg(Op, 1))
    End Function
    
    ' // Hyperbolic tangent of a complex number
    Public Function cxTanh(Op As Complex) As Complex
        cxTanh = cxMulImg(cxTan(cxMulImg(Op, 1)), -1)
    End Function
    
    ' // Hyperbolic cotangent of a complex number
    Public Function cxCtgh(Op As Complex) As Complex
        cxCtgh = cxRealDiv(1, cxTanh(Op))
    End Function
    
    ' // Hyperbolic secant of a complex number
    Public Function cxSech(Op As Complex) As Complex
        cxSech = cxRealDiv(1, cxCosh(Op))
    End Function
    
    ' // Hyperbolic cosecant of a complex number
    Public Function cxCsch(Op As Complex) As Complex
        cxCsch = cxRealDiv(1, cxSinh(Op))
    End Function
    
    ' // Hyperbolic arcsine of a complex number
    Public Function cxAsinh(Op As Complex) As Complex
        cxAsinh = cxLog(cxAdd(Op, cxSqr(cxAddReal(cxMul(Op, Op), 1))))
    End Function
    
    ' // Hyperbolic arccosine of a complex number
    Public Function cxAcosh(Op As Complex) As Complex
        cxAcosh = cxLog(cxAdd(Op, cxMul(cxSqr(cxAddReal(Op, 1)), cxSqr(cxSubReal(Op, 1)))))
    End Function
    
    ' // Hyperbolic arctangent of a complex number
    Public Function cxAtanh(Op As Complex) As Complex
        cxAtanh = cxMulReal(cxLog(cxDiv(cxAddReal(Op, 1), cxRealSub(1, Op))), 0.5)
    End Function
    
    ' // Hyperbolic arccotangent of a complex number
    Public Function cxActgh(Op As Complex) As Complex
        cxActgh = cxMulReal(cxLog(cxDiv(cxAddReal(Op, 1), cxSubReal(Op, 1))), 0.5)
    End Function
    
    ' // Hyperbolic arcsecant of a complex number
    Public Function cxAsech(Op As Complex) As Complex
        Dim Z As Complex
        Z = cxRealDiv(1, Op)
        cxAsech = cxLog(cxAdd(Z, cxSqr(cxAddReal(cxMul(Z, Z), 1))))
    End Function
    
    ' // Hyperbolic arccosecant of a complex number
    Public Function cxAcsch(Op As Complex) As Complex
        Dim Z As Complex
        Z = cxRealDiv(1, Op)
        cxAcsch = cxLog(cxAdd(Z, cxMul(cxSqr(cxAddReal(Z, 1)), cxSqr(cxSubReal(Z, 1)))))
    End Function

  3. #3

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,367

    Re: [VB6] - Module with advanced mathematical functions for real and complex numbers.

    Code:
    ' // Print matrix to immediate window
    Public Function PrintMtrx(Op As Matrix)
        Dim Ts As String, I As Long, j As Long
        Debug.Print vbNewLine
        Debug.Print "Col= " & Op.Col & " ; Row= " & Op.Row
        For I = 0 To Op.Row - 1: For j = 0 To Op.Col - 1
            Ts = Space(10)
            LSet Ts = Str(Round(Op.D(I * Op.Col + j), 3))
            Debug.Print Ts;
        Next: Debug.Print vbNewLine;: Next
    End Function
    
    ' // Creating a matrix
    Public Function mxCreate(ByVal Row As Long, ByVal Col As Long, ParamArray Y()) As Matrix
        Dim P As Variant, C As Long
        If Row <= 0 Or Col <= 0 Then Exit Function
        If Row * Col < UBound(Y) + 1 Then Exit Function
        mxCreate.Row = Row: mxCreate.Col = Col
        ReDim mxCreate.D(Row * Col - 1): C = 0
        For Each P In Y
            mxCreate.D(C) = P: C = C + 1
        Next
    End Function
    
    ' // Creating the null-matrix
    Public Function mxNull(ByVal Row As Long, ByVal Col As Long) As Matrix
        If Row <= 0 Or Col <= 0 Then Exit Function
        ReDim mxNull.D(Row * Col - 1): mxNull.Col = Col: mxNull.Row = Row
    End Function
    
    ' // Creating the identity matrix
    Public Function mxIdt(ByVal Size As Long) As Matrix
        Dim ij As Long
        If Size <= 0 Then Exit Function
        ReDim mxIdt.D(Size * Size - 1): mxIdt.Col = Size: mxIdt.Row = Size
        For ij = 0 To Size - 1: mxIdt.D(ij + (ij * Size)) = 1: Next
    End Function
    
    ' // Transpose matrix
    Public Function mxTrans(Op As Matrix) As Matrix
        Dim I As Long, j As Long, P As Long
        GetMem4 ByVal ArrPtr(Op.D), P: If P = 0 Then Exit Function
        mxTrans.Row = Op.Col: mxTrans.Col = Op.Row: ReDim mxTrans.D(UBound(Op.D))
        For j = 0 To mxTrans.Col - 1: For I = 0 To mxTrans.Row - 1
            mxTrans.D(I + j * mxTrans.Row) = Op.D(j + I * Op.Row)
        Next: Next
    End Function
    
    ' // Multiplication matrix on a real number
    Public Function mxMulReal(Op As Matrix, Op2 As Double) As Matrix
        Dim P As Long, ij As Long
        GetMem4 ByVal ArrPtr(Op.D), P: If P = 0 Then Exit Function
        ReDim mxMulReal.D(UBound(Op.D)): mxMulReal.Col = Op.Col: mxMulReal.Row = Op.Row
        For ij = 0 To UBound(Op.D): mxMulReal.D(ij) = Op.D(ij) * Op2: Next
    End Function
    
    ' // Addition of a two matrix
    Public Function mxAdd(Op1 As Matrix, Op2 As Matrix) As Matrix
        Dim P As Long, ij As Long
        GetMem4 ByVal ArrPtr(Op1.D), P: If P = 0 Then Exit Function
        GetMem4 ByVal ArrPtr(Op2.D), P: If P = 0 Then Exit Function
        If Op1.Col <> Op2.Col Or Op1.Row <> Op2.Row Then Exit Function
        ReDim mxAdd.D(UBound(Op1.D)): mxAdd.Col = Op1.Col: mxAdd.Row = Op1.Row
        For ij = 0 To UBound(Op1.D): mxAdd.D(ij) = Op1.D(ij) + Op2.D(ij): Next
    End Function
    
    ' // Subtaction of a two matrix
    Public Function mxSub(Op1 As Matrix, Op2 As Matrix) As Matrix
        Dim P As Long, ij As Long
        GetMem4 ByVal ArrPtr(Op1.D), P: If P = 0 Then Exit Function
        GetMem4 ByVal ArrPtr(Op2.D), P: If P = 0 Then Exit Function
        If Op1.Col <> Op2.Col Or Op1.Row <> Op2.Row Then Exit Function
        ReDim mxSub.D(UBound(Op1.D)): mxSub.Col = Op1.Col: mxSub.Row = Op1.Row
        For ij = 0 To UBound(Op1.D): mxSub.D(ij) = Op1.D(ij) - Op2.D(ij): Next
    End Function
    
    ' // Multiplication of a two matrix
    Public Function mxMul(Op1 As Matrix, Op2 As Matrix) As Matrix
        Dim P As Long, I As Long, j As Long, k As Long, iM As Long, i1 As Long, i2 As Long
        GetMem4 ByVal ArrPtr(Op1.D), P: If P = 0 Then Exit Function
        GetMem4 ByVal ArrPtr(Op2.D), P: If P = 0 Then Exit Function
        If Op1.Col <> Op2.Row Then Exit Function
        ReDim mxMul.D(Op1.Row * Op2.Col - 1): mxMul.Col = Op2.Col: mxMul.Row = Op1.Row
    '    For i = 0 To Op1.Row - 1: For j = 0 To Op2.Col - 1: mxMul.D(i * Op2.Col + j) = 0
    '        For k = 0 To Op1.Col - 1
    '            mxMul.D(i * mxMul.Col + j) = mxMul.D(i * mxMul.Col + j) + Op1.D(i * Op1.Col + k) * Op2.D(k * Op2.Col + j)
    '        Next
    '    Next: Next
        For I = 0 To Op1.Row - 1
            For j = 0 To Op2.Col - 1
            i2 = j
            For k = 0 To Op1.Col - 1
                mxMul.D(iM) = mxMul.D(iM) + Op1.D(i1 + k) * Op2.D(i2)
                i2 = i2 + Op2.Col
            Next
            iM = iM + 1
            Next
        i1 = i1 + Op1.Col
        Next
    End Function
    
    ' // Determinant of a square matrix
    Public Function mxDtm(Op As Matrix) As Double
        Dim P1 As Long, P2 As Long, ij1 As Long, ij2 As Long, Ct As Long, L As Long, T1 As Double, T2 As Double
        GetMem4 ByVal ArrPtr(Op.D), P1: If P1 = 0 Then Exit Function
        If Op.Col <> Op.Row Then Exit Function
        P2 = Op.Col - 1: ij1 = 0: ij2 = P2: Ct = Op.Col * Op.Row: P1 = Op.Col + 1
        For k = 0 To Op.Col - 1
            T1 = Op.D(ij1): T2 = Op.D(ij2)
            For L = 1 To Op.Col - 1
                ij1 = (ij1 + P1) Mod Ct: ij2 = (ij2 + P2) Mod Ct
                T1 = T1 * Op.D(ij1): T2 = T2 * Op.D(ij2)
            Next
            mxDtm = mxDtm + T1 - T2: ij1 = (ij1 + P1) Mod Ct: ij2 = (ij2 + P2) Mod Ct
        Next
    End Function
    Attached Files Attached Files

  4. #4
    Hyperactive Member Daniel Duta's Avatar
    Join Date
    Feb 2011
    Location
    Bucharest, Romania
    Posts
    341

    Re: [VB6] - Module with advanced mathematical functions for real and complex numbers.

    Hi Anatoly,
    Regarding your functions of min/max, I just wonder why didn't you build only one function, both for max and min, without any limitation on how many numbers are compared (number of parameters). Just imagine that instead of this inequality nb1>nb2 I would like to know who is the oldest/youngest person in a group and that group has 100 persons. In this case, the current logic of your function is no longer working properly. Maybe would be more useful to have a function of max/min with a 2D array as parameter having possibility to choose a certain column in analysis.
    Last edited by Daniel Duta; Apr 7th, 2015 at 09:23 AM.

  5. #5
    Member
    Join Date
    Mar 2015
    Posts
    58

    Re: [VB6] - Module with advanced mathematical functions for real and complex numbers.

    Wow, some useful functions. Thanks Anatoly.

    I wondered about the min/max functions as well.

    Some other desirable functions that I would like to see are some reliable Statistics ones, like Mean, Median and Mode. I came across a few functions like these, but they seemed to give differing results depending on the format of the input numbers like 01, 2, 1.00, 1.
    These would give results differently to a list without spaces like 1,2,1,1. I'm not really sure why, other than perhaps because of the spacing between the numbers? I tried making a basic statistics program that works out the min, max, mean, mode median, range and quartiles, but the answers differed when inputting the numbers in different ways.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width