1' 2' Financial.vb 3' 4' Author: 5' Mizrahi Rafael (rafim@mainsoft.com) 6' Boris Kirzner (borisk@mainsoft.com) 7' 8 9' 10' Copyright (C) 2002-2006 Mainsoft Corporation. 11' Copyright (C) 2004-2006 Novell, Inc (http://www.novell.com) 12' 13' Permission is hereby granted, free of charge, to any person obtaining 14' a copy of this software and associated documentation files (the 15' "Software"), to deal in the Software without restriction, including 16' without limitation the rights to use, copy, modify, merge, publish, 17' distribute, sublicense, and/or sell copies of the Software, and to 18' permit persons to whom the Software is furnished to do so, subject to 19' the following conditions: 20' 21' The above copyright notice and this permission notice shall be 22' included in all copies or substantial portions of the Software. 23' 24' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 25' EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 26' MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 27' NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 28' LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 29' OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 30' WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 31' 32Imports Microsoft.VisualBasic.CompilerServices 33Imports System 34 35Namespace Microsoft.VisualBasic 36 <StandardModule()> _ 37 Public NotInheritable Class Financial 38 39 Public Shared Function DDB(ByVal Cost As Double, ByVal Salvage As Double, _ 40 ByVal Life As Double, ByVal Period As Double, _ 41 Optional ByVal Factor As Double = 2.0) As Double 42 If Period > Life Or Factor <= 0 Or Salvage < 0 Or Life < 0 Or Period <= 0 Then 43 Throw New ArgumentException("Argument 'Factor' is not a valid value.") 44 End If 45 46 ' LAMESPEC: MSDN claims the exception should be thrown in this case 47 'If Cost < 0 Then 48 'Throw New ArgumentException("Argument 'Factor' is not a valid value.") 49 'End If 50 51 ' Below we use power of (Period - 1). 52 ' Tested Period < 1 and it behaves like Period = 1 53 If Period < 1 Then 54 Period = 1 55 End If 56 57 Dim Rate As Double = Factor / Life 58 Dim PreviousValue As Double = Cost * (1 - Rate) ^ (Period - 1) 59 PreviousValue = Math.Max(PreviousValue, Salvage) 60 Dim CurrentValue As Double = Cost * (1 - Rate) ^ Period 61 CurrentValue = Math.Max(CurrentValue, Salvage) 62 Return PreviousValue - CurrentValue 63 64 End Function 65 66 Public Shared Function SLN(ByVal Cost As Double, ByVal Salvage As Double, _ 67 ByVal Life As Double) As Double 68 If Life = 0 Then 69 Throw New ArgumentException("Argument 'Life' cannot be zero.") 70 End If 71 72 Return ((Cost - Salvage) / Life) 73 End Function 74 75 Public Shared Function SYD(ByVal Cost As Double, ByVal Salvage As Double, _ 76 ByVal Life As Double, ByVal Period As Double) As Double 77 If Salvage < 0 Then 78 Throw New ArgumentException("Argument 'Salvage' must be greater than or equal to zero.") 79 End If 80 If Period > Life Then 81 Throw New ArgumentException("Argument 'Period' must be less than or equal to argument 'Life'.") 82 End If 83 If Period <= 0 Then 84 Throw New ArgumentException("Argument 'Period' must be greater than zero.") 85 End If 86 Return ((Cost - Salvage) * (Life - Period + 1) * 2 / Life) / (Life + 1) 87 End Function 88 89 Public Shared Function FV(ByVal Rate As Double, ByVal NPer As Double, ByVal Pmt As Double, _ 90 Optional ByVal PV As Double = 0, Optional ByVal Due As DueDate = DueDate.EndOfPeriod) As Double 91 92 If NPer < 0 Then 93 If Due = DueDate.EndOfPeriod Then 94 Due = DueDate.BegOfPeriod 95 Else 96 Due = DueDate.EndOfPeriod 97 End If 98 Return FV(1 / (1 + Rate) - 1, -NPer, -Pmt, PV, Due) 99 End If 100 101 If NPer = 0 Or Rate = 0 Then 102 Return -(PV + Pmt * NPer) 103 End If 104 105 If Due = DueDate.BegOfPeriod Then 106 Pmt = Pmt * (1 + Rate) 107 End If 108 109 Dim ExpRate As Double = (1 + Rate) ^ NPer 110 Return -(PV * ExpRate + Pmt * (ExpRate - 1) / Rate) 111 112 End Function 113 114 Public Shared Function Rate(ByVal NPer As Double, ByVal Pmt As Double, ByVal PV As Double, _ 115 Optional ByVal FV As Double = 0, Optional ByVal Due As DueDate = DueDate.EndOfPeriod, _ 116 Optional ByVal Guess As Double = 0.1) As Double 117 Throw New NotImplementedException 118 End Function 119 120 Public Shared Function IRR(ByRef ValueArray() As Double, Optional ByVal Guess As Double = 0.1) As Double 121 Throw New NotImplementedException 122 End Function 123 124 Public Shared Function MIRR(ByRef ValueArray() As Double, ByVal FinanceRate As Double, _ 125 ByVal ReinvestRate As Double) As Double 126 127 If FinanceRate <= -1 Then 128 Throw New ArgumentException("Argument 'FinanceRate' is not a valid value.") 129 End If 130 If ReinvestRate <= -1 Then 131 Throw New ArgumentException("Argument 'ReinvestRate' is not a valid value.") 132 End If 133 134 Dim pnpv1 As Double = PNPV(ValueArray, ReinvestRate) 135 Dim nnpv1 As Double = NNPV(ValueArray, FinanceRate) 136 137 Dim n As Integer = ValueArray.Length 138 Dim intermediate As Double = (-pnpv1 * (1 + ReinvestRate) ^ n) / (nnpv1 * (1 + FinanceRate)) 139 Dim result As Double = Math.Abs(intermediate) ^ (1 / (n - 1)) - 1 140 141 If intermediate < 0 Then 142 Return -result 143 Else 144 Return result 145 End If 146 147 End Function 148 149 Private Shared Function PNPV(ByVal ValueArray() As Double, ByVal Rate As Double) As Double 150 Dim result As Double = 0 151 For i As Integer = 1 To ValueArray.Length 152 Dim value As Double = ValueArray(i - 1) 153 If value >= 0 Then 154 result = result + value / (1 + Rate) ^ i 155 End If 156 Next 157 Return result 158 End Function 159 160 Private Shared Function NNPV(ByVal ValueArray() As Double, ByVal Rate As Double) As Double 161 Dim result As Double = 0 162 For i As Integer = 1 To ValueArray.Length 163 Dim value As Double = ValueArray(i - 1) 164 If value < 0 Then 165 result = result + value / (1 + Rate) ^ i 166 End If 167 Next 168 Return result 169 End Function 170 171 Public Shared Function NPer(ByVal Rate As Double, ByVal Pmt As Double, ByVal PV As Double, _ 172 Optional ByVal FV As Double = 0, Optional ByVal Due As DueDate = DueDate.EndOfPeriod) As Double 173 174 175 If Rate = -1 Then 176 Throw New ArgumentException("Argument 'Rate' is not a valid value.") 177 End If 178 If Pmt = 0 Then 179 If Rate = 0 Then 180 Throw New ArgumentException("Argument 'Pmt' is not a valid value.") 181 Else 182 Throw New ArgumentException("Cannot calculate number of periods using the arguments provided.") 183 End If 184 End If 185 Dim iDue As Integer = Due 186 Dim tmp As Double = (Pmt * (1D + Rate * iDue)) / Rate 187 Dim ret As Double = Math.Log((tmp - FV) / (tmp + PV)) / Math.Log(1D + Rate) 188 Return ret 189 'If Rate = -1 Then 190 ' Throw New ArgumentException("Argument 'Rate' is not a valid value.") 191 'End If 192 'If Pmt = 0 Then 193 ' If Rate = 0 Then 194 ' Throw New ArgumentException("Argument 'Pmt' is not a valid value.") 195 ' Else 196 ' Throw New ArgumentException("Cannot calculate number of periods using the arguments provided.") 197 ' End If 198 'End If 199 200 'Dim current As Double = 0 201 '' FIXME : what is the meaning of double period value ? 202 'Dim pperiod As Integer = 0 203 'Dim fperiod As Integer = 0 204 'Dim apmt As Double = Math.Abs(Pmt) 205 206 'If PV <> 0 Then 207 ' If PV * Pmt < 0 Then 208 ' current = Math.Abs(PV) 209 ' If Due = DueDate.BegOfPeriod Then 210 ' current = current - current * Rate 211 ' End If 212 ' While current > 0 213 ' current = current + current * Rate 214 ' current = current + apmt 215 ' pperiod = pperiod + 1 216 ' End While 217 ' Else 218 ' current = apmt 219 ' If Due = DueDate.BegOfPeriod Then 220 ' PV = PV * (1 + Rate) 221 ' End If 222 ' While current < Math.Abs(PV) 223 ' current = current + current * Rate 224 ' current = current + apmt 225 ' pperiod = pperiod - 1 226 ' End While 227 ' End If 228 'End If 229 230 'If FV <> 0 Then 231 ' If FV * Pmt < 0 Then 232 ' current = apmt 233 ' If Due = DueDate.EndOfPeriod Then 234 ' current = 0 235 ' End If 236 ' While current < Math.Abs(FV) 237 ' current = current + current * Rate 238 ' current = current + apmt 239 ' fperiod = fperiod + 1 240 ' End While 241 ' Else 242 ' fperiod = 1 243 ' current = Math.Abs(FV) 244 ' If Due = DueDate.BegOfPeriod Then 245 ' current = current - current * Rate 246 ' End If 247 ' While current > 0 248 ' current = current + current * Rate 249 ' current = current - apmt 250 ' fperiod = fperiod - 1 251 ' End While 252 ' End If 253 'End If 254 'Return pperiod + fperiod 255 End Function 256 257 Public Shared Function IPmt(ByVal Rate As Double, ByVal Per As Double, ByVal NPer As Double, _ 258 ByVal PV As Double, Optional ByVal FV As Double = 0, _ 259 Optional ByVal Due As DueDate = DueDate.EndOfPeriod) As Double 260 261 If Per <= 0 Or Per > NPer Or NPer < 0 Then 262 Throw New ArgumentException("Argument 'Per' is not a valid value.") 263 End If 264 265 If Per = 1 AndAlso Due = DueDate.BegOfPeriod Then 266 Return 0 ' The formula below doesn't cover this special case 267 End If 268 269 Dim Pmt As Double = Financial.Pmt(Rate, NPer, PV, FV, Due) 270 Dim PreviousPV As Double = Financial.FV(Rate, Per - 1, Pmt, PV, Due) 271 If Due = DueDate.BegOfPeriod Then 272 PreviousPV = PreviousPV / (1 + Rate) 273 End If 274 Return PreviousPV * Rate 275 276 End Function 277 278 Public Shared Function Pmt(ByVal Rate As Double, ByVal NPer As Double, ByVal PV As Double, _ 279 Optional ByVal FV As Double = 0, _ 280 Optional ByVal Due As DueDate = DueDate.EndOfPeriod) As Double 281 282 If NPer = 0 Then 283 Throw New ArgumentException("Argument 'NPer' is not a valid value.") 284 End If 285 286 If NPer < 0 Then 287 Return -Pmt(Rate, -NPer, FV, PV, Due) 288 End If 289 290 If Rate = 0 Then 291 Return -(PV + FV) / NPer 292 End If 293 294 Dim ExpRate As Double = (1 + Rate) ^ NPer 295 Dim dfpv As Double = (1 - 1 / ExpRate) / Rate 296 Dim dffv As Double = (ExpRate - 1) / Rate 297 298 If Due = DueDate.BegOfPeriod Then 299 dffv = dffv * (1 + Rate) 300 dfpv = dfpv * (1 + Rate) 301 End If 302 303 Return -(PV / dfpv + FV / dffv) 304 305 End Function 306 307 Public Shared Function PPmt(ByVal Rate As Double, ByVal Per As Double, ByVal NPer As Double, _ 308 ByVal PV As Double, Optional ByVal FV As Double = 0, _ 309 Optional ByVal Due As DueDate = DueDate.EndOfPeriod) As Double 310 311 Return Pmt(Rate, NPer, PV, FV, Due) - IPmt(Rate, Per, NPer, PV, FV, Due) 312 End Function 313 314 Public Shared Function NPV(ByVal Rate As Double, ByRef ValueArray() As Double) As Double 315 316 If ValueArray Is Nothing Then 317 Throw New ArgumentException("Argument 'ValueArray' is Nothing.") 318 End If 319 If Rate = -1 Then 320 Throw New ArgumentException("Argument 'Rate' is not a valid value.") 321 End If 322 323 Dim result As Double = 0 324 For i As Integer = 1 To ValueArray.Length 325 result = result + (ValueArray(i - 1) / ((1 + Rate) ^ i)) 326 Next 327 Return result 328 329 End Function 330 331 Public Shared Function PV(ByVal Rate As Double, ByVal NPer As Double, ByVal Pmt As Double, _ 332 Optional ByVal FV As Double = 0, _ 333 Optional ByVal Due As DueDate = DueDate.EndOfPeriod) As Double 334 Dim result As Double = 0 335 Dim d As Double = (1 + Rate) ^ NPer 336 Dim n As Double 337 If Due = DueDate.EndOfPeriod Then 338 n = -FV - Pmt * (d - 1) / Rate 339 Else 340 n = -FV - Pmt * (1 + Rate) * (d - 1) / Rate 341 End If 342 result = n / d 343 Return result 344 End Function 345 End Class 346End Namespace 347