Index: openacs-4/packages/accounts-finance/tcl/modeling.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/accounts-finance/tcl/Attic/modeling.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/accounts-finance/tcl/modeling.tcl 17 May 2010 23:07:35 -0000 1.3 +++ openacs-4/packages/accounts-finance/tcl/modeling.tcl 19 May 2010 10:27:06 -0000 1.4 @@ -7,14 +7,164 @@ namespace eval acc_fin {} -ad_proc -private acc_fin::qaf_process_model { model } { +ad_proc -public acc_fin::fp { + number +} { + returns a floating point version a number, if the number is an integer (no decimal point). + tcl math can truncate a floating point in certain cases, such as when the divisor is an integer. +} { + if { [string first "." $number] < 0 } { + # append number ".0" + set number [expr { double( $number ) } ] + } + return $number +} + + +ad_proc -private acc_fin::qaf_npv { + net_period_list + discount_rate_list + {intervals_per_year 1} + } { + Returns the Net Present Value + In net_period_list, first value is current year, second value is first interval of second year.. + discount_rate_list re-uses the last rate in the list if the list has fewer members than in the cash_flow_list + Assumes 1 interval per year unless specified + } { + set np_sum 0 + set interval 0 + set period_list_count [llength $net_period_list] + # make lists same length to decrease loop calc time + set last_supplied_rate [lindex $discount_rate_list end] + set discount_list_count [llength $discount_rate_list] + while { $discount_list_count < $period_list_count } { + lappend discount_rate_list $last_supplied_rate + incr discount_list_count + } + + foreach net_period $net_period_list { + set year_nbr [expr { floor( ( $interval + $intervals_per_year - 1 ) / $intervals_per_year ) } ] + set discount_rate [lindex $discount_rate_list $internval] + set current_value [expr { ${net_period} / pow( 1. + $discount_rate , $year_nbr ) } ] + incr interval + set np_sum [expr { $np_sum + $current_value } ] + } + return $np_sum + } + +ad_proc -private acc_fin::qaf_sign { + number +} { + Returns the sign of the number represented as -1, 0, or 1 +} { + set sign [expr { $number / double( abs ( $number ) ) } ] + return $sign +} + +ad_proc -private acc_fin::qaf_discount_npv_curve { + net_period_list + {discounts ""} + {intervals_per_year 1} + } { + Returns a list pair of discounts, NPVs + uses acc_fin::qaf_npv + } { + if { $discounts eq "" } { + # let's make a sample from a practical range of discounts: + #0., 0.01, 0.03, 0.07, 0.15, 0.31, 0.63, 1.27, 2.55, 5.11, 10.23, 20.47, 40.95, 81.91 + for {set i 0. } { $i < 100. } { + lappend discount_list $i + } + } else { + set discount_list [split $discounts " "] + } + + foreach $i $discount_list { + lappend irr_curve_list [list $i [acc_fin::qaf_npv $net_period_list [list $i] $intervals_per_year ]] + } + return $irr_curve_list + } + +ad_proc -private acc_fin::qaf_irr { + net_period_list + {intervals_per_year 1} + } { + Returns a list of Internal Rate of Returns, ie where NPV = 0. + Hint: There can be more than one in complex cases. + uses acc_fin::qaf_npv + } { + # let's get a sample from a practical range of discounts: + #0., 0.01, 0.03, 0.07, 0.15, 0.31, 0.63, 1.27, 2.55, 5.11, 10.23, 20.47, 40.95, 81.91 + + array npv_test_value + array npv_test_discount + set test_nbr 1 + set sign_change_count 0 + for {set i 0. } { $i < 100. } { + set npv_test_discount(${test_nbr}) $i + set npv_test_value($test_nbr) [acc_fin::qaf_npv $net_period_list [list $i] $intervals_per_year ] + + if { $test_nbr > 1 } { + if { [expr { [acc_fin::qaf_sign $npv_test_value($test_nbr)] * [acc_fin::qaf::sign $npv_test_value($prev_nbr)] } ] < 0 } { + incr sign_change_count + lappend start_range $prev_nbr + } + } + set prev_nbr $test_nbr + } + + # if $sign_change_count = 0, then there are likely no practical solutions for NPV = 0 within the range + # find solution through iteration, where npv is Y and discount is X + set irr_list [list] + foreach i_begin $start_range { + set count 0 + set i_end [expr { $i_begin + 1 } ] + + set test_discount $npv_test_discount($i_begin) + set discount_incr [expr { $test_discount + ( $npv_test_discount($i_end) - $test_discount ) / 10. } ] + set test_npv npv_tst_value($i_begin) + set abs_test_npv [expr { abs( $test_npv ) } ] + # iterate test_discount + while { $count < 20 and $test_npv ne 0 } { + incr count + set new_test_discount [expr { $test_discount + $discount_incr } ] + set new_test_npv [acc_fin::qaf_npv $net_period_list [$new_test_discount] $intervals_per_year ] + set abs_new_test_npv [expr { abs( $new_test_npv ) } ] + if { $abs_test_npv <= $abs_new_test_npv } { + # switch direction, and lower increment + set discount_incr [expr ( $discount_incr * -0.5 ) ] + } + set test_discount $new_test_discount + set test_npv $new_test_npv + } + if { $test_npv eq 0 } { + lappend irr_list $test_discount + } + } + return $irr_list + } + +ad_proc -private acc_fin::qaf_mirr { +list1 +list2 + } { + returns the Modified Internal Rate of Return ... + } { + +# code + } + + +ad_proc -private acc_fin::qaf_compile_model { + model +} { returns calculation friendly list of lists from model represented in shorthand shorthand consists of these parts: section 1: initial calculations and conditions section 2: repeating calculations (in order calculated) section 3: list of variables to report with iterations section 4: analysis calculations - Each section is separated by a line with '\#'. + Each section is separated by a line with '\#'. Be sure to separate variables and operators etc by a space (or more). reserved variables: i current iteration number, initial conditions are at iteraton 0, whole numbers h is i - 1 @@ -154,7 +304,7 @@ } else { - set output "Unable to compile model. ${err_state} Errors. \n ${err_text}" + set output [list "ERROR: Unable to compile model. ${err_state} Errors. \n ${err_text}" $model_sections_list] return $output }