VB6Parse / Library / Math / exp

VB6 Library Reference

Exp Function

Returns e (the base of natural logarithms) raised to a power.

Syntax

Exp(number)

Parameters

Return Value

Returns a Double representing e raised to the specified power (e^number). The constant e is approximately 2.718282.

Remarks

The Exp function complements the action of the Log function and is sometimes referred to as the antilogarithm. It calculates e raised to a power, where e is the base of natural logarithms (approximately 2.718282).

Important Characteristics:

Mathematical Properties

Common Applications

Examples

Basic Usage

Dim result As Double

' Basic exponential calculation
result = Exp(1)           ' Returns e ≈ 2.718282
result = Exp(0)           ' Returns 1
result = Exp(2)           ' Returns e² ≈ 7.389056

' Negative exponents
result = Exp(-1)          ' Returns 1/e ≈ 0.367879
result = Exp(-2)          ' Returns 1/e² ≈ 0.135335

Exponential Growth

Function ExponentialGrowth(initial As Double, rate As Double, time As Double) As Double
' Calculate exponential growth: A = A₀ * e^(rt)
' initial = initial amount
' rate = growth rate (as decimal, e.g., 0.05 for 5%)
' time = time period

ExponentialGrowth = initial * Exp(rate * time)
End Function

' Example: Population growth
' Initial population: 1000, growth rate: 3% per year, time: 10 years
Dim population As Double
population = ExponentialGrowth(1000, 0.03, 10)  ' ≈ 1349.86

Compound Interest

Function ContinuousCompoundInterest(principal As Double, rate As Double, _
time As Double) As Double
' Calculate continuously compounded interest: A = P * e^(rt)
' principal = initial investment
' rate = annual interest rate (as decimal)
' time = time in years

ContinuousCompoundInterest = principal * Exp(rate * time)
End Function

' Example: $1000 at 5% for 10 years
Dim amount As Double
amount = ContinuousCompoundInterest(1000, 0.05, 10)  ' ≈ $1648.72

Common Patterns

Radioactive Decay

Function RadioactiveDecay(initialAmount As Double, decayConstant As Double, _
time As Double) As Double
' Calculate remaining amount: N = N₀ * e^(-λt)
' initialAmount = initial quantity
' decayConstant = decay constant (λ)
' time = elapsed time

RadioactiveDecay = initialAmount * Exp(-decayConstant * time)
End Function

' Example: Half-life calculation
Function HalfLife(decayConstant As Double) As Double
' t₁/₂ = ln(2) / λ
HalfLife = Log(2) / decayConstant
End Function

Normal Distribution

Function NormalDistribution(x As Double, mean As Double, stdDev As Double) As Double
' Calculate normal (Gaussian) distribution PDF
' f(x) = (1 / (σ√(2π))) * e^(-(x-μ)²/(2σ²))

Dim pi As Double
Dim exponent As Double

pi = 4 * Atn(1)  ' Calculate π
exponent = -((x - mean) ^ 2) / (2 * stdDev ^ 2)

NormalDistribution = (1 / (stdDev * Sqr(2 * pi))) * Exp(exponent)
End Function

Exponential Smoothing

Function ExponentialSmoothing(data() As Double, alpha As Double) As Variant
' Apply exponential smoothing to data
' alpha = smoothing factor (0 < α < 1)

Dim smoothed() As Double
Dim i As Long

ReDim smoothed(LBound(data) To UBound(data))

' First value is same as original
smoothed(LBound(data)) = data(LBound(data))

' Apply smoothing formula: S_t = α * Y_t + (1-α) * S_{t-1}
For i = LBound(data) + 1 To UBound(data)
smoothed(i) = alpha * data(i) + (1 - alpha) * smoothed(i - 1)
Next i

ExponentialSmoothing = smoothed
End Function

Temperature Cooling (Newton's Law)

Function CoolingTemperature(initialTemp As Double, ambientTemp As Double, _
coolingConstant As Double, time As Double) As Double
' Newton's Law of Cooling: T(t) = T_ambient + (T₀ - T_ambient) * e^(-kt)
' initialTemp = initial temperature
' ambientTemp = surrounding temperature
' coolingConstant = cooling constant (k)
' time = elapsed time

CoolingTemperature = ambientTemp + (initialTemp - ambientTemp) * Exp(-coolingConstant * time)
End Function

' Example: Coffee cooling from 90°C to room temperature (20°C)
Dim temp As Double
temp = CoolingTemperature(90, 20, 0.1, 10)  ' Temperature after 10 minutes

Convert Between Log Bases

Function LogBase(number As Double, base As Double) As Double
' Calculate logarithm with arbitrary base
' log_base(number) = ln(number) / ln(base)

If number <= 0 Or base <= 0 Or base = 1 Then
Err.Raise 5, , "Invalid argument"
End If

LogBase = Log(number) / Log(base)
End Function

Function PowerWithBase(base As Double, exponent As Double) As Double
' Calculate base^exponent using Exp and Log
' base^exponent = e^(exponent * ln(base))

If base <= 0 Then
Err.Raise 5, , "Base must be positive"
End If

PowerWithBase = Exp(exponent * Log(base))
End Function

Sigmoid Function

Function Sigmoid(x As Double) As Double
' Logistic sigmoid function: σ(x) = 1 / (1 + e^(-x))
' Used in neural networks and machine learning

Sigmoid = 1 / (1 + Exp(-x))
End Function

Function SigmoidDerivative(x As Double) As Double
' Derivative of sigmoid: σ'(x) = σ(x) * (1 - σ(x))
Dim s As Double
s = Sigmoid(x)
SigmoidDerivative = s * (1 - s)
End Function

Exponential Moving Average

Function CalculateEMA(prices() As Double, periods As Integer) As Variant
' Calculate Exponential Moving Average
' Commonly used in financial analysis

Dim ema() As Double
Dim multiplier As Double
Dim i As Long

ReDim ema(LBound(prices) To UBound(prices))

' Calculate multiplier: 2 / (periods + 1)
multiplier = 2 / (periods + 1)

' First EMA is simple moving average
ema(LBound(prices)) = prices(LBound(prices))

' Calculate EMA for remaining values
For i = LBound(prices) + 1 To UBound(prices)
ema(i) = (prices(i) - ema(i - 1)) * multiplier + ema(i - 1)
Next i

CalculateEMA = ema
End Function

Black-Scholes Option Pricing

Function BlackScholesCall(stockPrice As Double, strikePrice As Double, _
timeToExpiry As Double, riskFreeRate As Double, _
volatility As Double) As Double
' Simplified Black-Scholes formula for call option
Dim d1 As Double, d2 As Double
Dim pi As Double

pi = 4 * Atn(1)

d1 = (Log(stockPrice / strikePrice) + (riskFreeRate + 0.5 * volatility ^ 2) * timeToExpiry) / _
(volatility * Sqr(timeToExpiry))
d2 = d1 - volatility * Sqr(timeToExpiry)

' Using normal CDF approximation (simplified)
BlackScholesCall = stockPrice * NormalCDF(d1) - _
strikePrice * Exp(-riskFreeRate * timeToExpiry) * NormalCDF(d2)
End Function

Poisson Distribution

Function PoissonProbability(k As Long, lambda As Double) As Double
' Calculate Poisson probability: P(X=k) = (λ^k * e^(-λ)) / k!
' k = number of occurrences
' lambda = average rate

Dim i As Long
Dim factorial As Double

' Calculate k!
factorial = 1
For i = 2 To k
factorial = factorial * i
Next i

' Calculate probability
PoissonProbability = (lambda ^ k * Exp(-lambda)) / factorial
End Function

Advanced Usage

Hyperbolic Functions

Function Sinh(x As Double) As Double
' Hyperbolic sine: sinh(x) = (e^x - e^(-x)) / 2
Sinh = (Exp(x) - Exp(-x)) / 2
End Function

Function Cosh(x As Double) As Double
' Hyperbolic cosine: cosh(x) = (e^x + e^(-x)) / 2
Cosh = (Exp(x) + Exp(-x)) / 2
End Function

Function Tanh(x As Double) As Double
' Hyperbolic tangent: tanh(x) = sinh(x) / cosh(x)
Dim ex As Double
ex = Exp(x)
Tanh = (ex - 1 / ex) / (ex + 1 / ex)
End Function

Function ArcSinh(x As Double) As Double
' Inverse hyperbolic sine: asinh(x) = ln(x + √(x² + 1))
ArcSinh = Log(x + Sqr(x * x + 1))
End Function

Function ArcCosh(x As Double) As Double
' Inverse hyperbolic cosine: acosh(x) = ln(x + √(x² - 1))
If x < 1 Then
Err.Raise 5, , "Argument must be >= 1"
End If
ArcCosh = Log(x + Sqr(x * x - 1))
End Function

Function ArcTanh(x As Double) As Double
' Inverse hyperbolic tangent: atanh(x) = 0.5 * ln((1+x)/(1-x))
If Abs(x) >= 1 Then
Err.Raise 5, , "Argument must be in (-1, 1)"
End If
ArcTanh = 0.5 * Log((1 + x) / (1 - x))
End Function

Taylor Series Approximation

Function ExpTaylor(x As Double, terms As Integer) As Double
' Calculate Exp(x) using Taylor series
' e^x = 1 + x + x²/2! + x³/3! + x⁴/4! + ...

Dim result As Double
Dim term As Double
Dim i As Integer

result = 1  ' First term
term = 1

For i = 1 To terms
term = term * x / i
result = result + term
Next i

ExpTaylor = result
End Function

Sub CompareTaylorWithBuiltIn()
Dim x As Double
Dim terms As Integer

x = 2

Debug.Print "Comparing Taylor series with built-in Exp:"
For terms = 1 To 20
Debug.Print "Terms: " & terms & ", Taylor: " & ExpTaylor(x, terms) & _
", Built-in: " & Exp(x) & ", Error: " & Abs(ExpTaylor(x, terms) - Exp(x))
Next terms
End Sub

Numerical Integration Using Exponential

Function IntegrateExp(lowerBound As Double, upperBound As Double, _
intervals As Long) As Double
' Numerical integration of e^x using trapezoidal rule
' ∫e^x dx from a to b

Dim h As Double
Dim sum As Double
Dim x As Double
Dim i As Long

h = (upperBound - lowerBound) / intervals
sum = (Exp(lowerBound) + Exp(upperBound)) / 2

For i = 1 To intervals - 1
x = lowerBound + i * h
sum = sum + Exp(x)
Next i

IntegrateExp = sum * h
End Function

Sub VerifyIntegration()
Dim a As Double, b As Double
Dim numerical As Double
Dim analytical As Double

a = 0
b = 1

numerical = IntegrateExp(a, b, 1000)
analytical = Exp(b) - Exp(a)  ' Analytical solution: e^b - e^a

Debug.Print "Numerical: " & numerical
Debug.Print "Analytical: " & analytical
Debug.Print "Error: " & Abs(numerical - analytical)
End Sub

Population Dynamics Model

Function LogisticGrowth(initialPop As Double, carryingCapacity As Double, _
growthRate As Double, time As Double) As Double
' Logistic growth model: P(t) = K / (1 + ((K - P₀) / P₀) * e^(-rt))
' initialPop = initial population (P₀)
' carryingCapacity = maximum sustainable population (K)
' growthRate = intrinsic growth rate (r)
' time = time

Dim ratio As Double

ratio = (carryingCapacity - initialPop) / initialPop
LogisticGrowth = carryingCapacity / (1 + ratio * Exp(-growthRate * time))
End Function

Sub PlotLogisticGrowth()
Dim t As Double
Dim population As Double

Debug.Print "Time", "Population"
Debug.Print String(40, "-")

For t = 0 To 50 Step 5
population = LogisticGrowth(100, 10000, 0.1, t)
Debug.Print t, Format(population, "#,##0.00")
Next t
End Sub

Complex Exponential (Euler's Formula)

Type ComplexNumber
Real As Double
Imaginary As Double
End Type

Function ComplexExp(z As ComplexNumber) As ComplexNumber
' Calculate e^z for complex number z = a + bi
' e^(a+bi) = e^a * (cos(b) + i*sin(b))  [Euler's formula]

Dim result As ComplexNumber
Dim magnitude As Double

magnitude = Exp(z.Real)
result.Real = magnitude * Cos(z.Imaginary)
result.Imaginary = magnitude * Sin(z.Imaginary)

ComplexExp = result
End Function

Sub DemonstrateEulerFormula()
Dim z As ComplexNumber
Dim result As ComplexNumber
Dim pi As Double

pi = 4 * Atn(1)

' e^(i*π) = -1 (Euler's identity)
z.Real = 0
z.Imaginary = pi
result = ComplexExp(z)

Debug.Print "e^(i*π) = " & Format(result.Real, "0.0000") & " + " & _
Format(result.Imaginary, "0.0000") & "i"
Debug.Print "Should be approximately -1 + 0i"
End Sub

Financial Option Greeks

Function CalculateDelta(stockPrice As Double, strikePrice As Double, _
timeToExpiry As Double, riskFreeRate As Double, _
volatility As Double) As Double
' Calculate Delta (rate of change of option price with respect to stock price)
Dim d1 As Double

d1 = (Log(stockPrice / strikePrice) + (riskFreeRate + 0.5 * volatility ^ 2) * timeToExpiry) / _
(volatility * Sqr(timeToExpiry))

CalculateDelta = NormalCDF(d1)
End Function

Function CalculateTheta(stockPrice As Double, strikePrice As Double, _
timeToExpiry As Double, riskFreeRate As Double, _
volatility As Double) As Double
' Calculate Theta (rate of change of option price with respect to time)
' Involves exponential decay term
Dim d1 As Double, d2 As Double
Dim pi As Double

pi = 4 * Atn(1)

d1 = (Log(stockPrice / strikePrice) + (riskFreeRate + 0.5 * volatility ^ 2) * timeToExpiry) / _
(volatility * Sqr(timeToExpiry))
d2 = d1 - volatility * Sqr(timeToExpiry)

CalculateTheta = -(stockPrice * NormalPDF(d1) * volatility) / (2 * Sqr(timeToExpiry)) - _
riskFreeRate * strikePrice * Exp(-riskFreeRate * timeToExpiry) * NormalCDF(d2)
End Function

Error Handling

Function SafeExp(x As Double) As Double
On Error GoTo ErrorHandler

' Check for potential overflow
If x > 709.78 Then
Err.Raise 6, , "Overflow: exponent too large"
End If

SafeExp = Exp(x)
Exit Function

ErrorHandler:
Select Case Err.Number
Case 6  ' Overflow
MsgBox "Exponential overflow. Result is too large to represent.", vbExclamation
SafeExp = 0
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
SafeExp = 0
End Select
End Function

Common Errors

Performance Considerations

Best Practices

Check for Overflow

' Good - Check before calculation
If x <= 709 Then
result = Exp(x)
Else
MsgBox "Value too large for Exp function"
End If

' Or use error handling
On Error Resume Next
result = Exp(x)
If Err.Number = 6 Then
MsgBox "Exponential overflow"
result = 0
End If
On Error GoTo 0

Use with Log for Powers

' Calculate a^b where a and b are any real numbers
' Good - Use Exp and Log
Function Power(base As Double, exponent As Double) As Double
If base <= 0 Then
Err.Raise 5, , "Base must be positive"
End If
Power = Exp(exponent * Log(base))
End Function

' For integer exponents, use ^ operator
result = base ^ intExponent  ' More efficient

Comparison with Other Functions

Exp vs ^ Operator

' Exp - Natural exponential (base e)
result = Exp(2)              ' e^2 ≈ 7.389056

' ^ - General power operator
result = 2.718282 ^ 2        ' Approximately same
result = 10 ^ 2              ' 100 (different base)

Exp vs Log

' Exp and Log are inverse functions
x = 5
result = Exp(Log(x))         ' Returns 5
result = Log(Exp(x))         ' Returns 5

Limitations

← Back to Math | View all functions