Attachment "proc_t_combined_market_rate.txt" to
ticket [67b7bafb20]
added by
anonymous
2018-09-24 18:07:24.
# adapted from tcl Stats 2011-05-22, arithmetic mean [RLE]
# ::math::combined_market_rate --
#
# Return the combined_market_rate by one,two, or more given rates
# market rate defined as quantity per price
# or 1 over (price per quantity)
#
# Arguments:
#
# args values are one, two, or more given rates
#
# Results: combined_market_rate
# works for positive numbers, negative numbers,
# and mixed positive & negative numbers.
# arg of zero returns zero
# arg of null returns zero
# filter foreach drops irregular zero elements from argument
proc ::math::combined_market_rate { args} {
set sum 0.
set N [ expr { [ llength $args ] } ]
if { $N == 0 } { return 0 }
if { $N == 1 || [ lindex $args 0 ] == 0 } { return 0 }
set res {};set counter2 0;
# filter foreach drops irregular zero elements
foreach item $args {if {$item != 0 } {incr counter2 1; lappend res $item } }
set counter 0
foreach val $res {
set sum [ expr { $sum + 1./$val } ]
incr counter 1
}
set combined_market_rate1 [ expr { 1./(($sum*1.)/$counter2) } ]
return $combined_market_rate1
}
# various testcases on combined_market_rate
# puts [::math::combined_market_rate 0.5524 0.4807 0.42918 0.47846 ]
# answer 0.48131 "
# puts [ ::math::combined_market_rate .1 .2 .3 .4 ]
# answer 0.192
# ::math::combined_market_rate -.1 -.2 -.3 -.4
# answer -0.192, correct
# operator math formula follows
# check [/ 1. [/ [+ [/ 1. -.1] [/ 1. -.2] [/ 1. -0.3 ] [/ 1. -0.4] ] 4. ] ]
# returns -0.192, correct
# puts " [ ::math::combined_market_rate .1 ] "
# :math::combined_market_rate -.1 -.2 .3 .4
# answer -0.4363636363636364
# operator math formula follows
# set check [/ 1. [/ [+ [/ 1. -.1] [/ 1. -.2] [/ 1. 0.3 ] [/ 1. 0.4] ] 4. ] ]
# check equals -0.4363636363636364
# puts " for (::math::combined_market_rates .1)
# returns .1 "
# ::math::combined_market_rate {}
# null returns zero, correct.
# ::math::combined_market_rate 0
# arg 0 returns zero, correct.
# addition dated 24sep2018
# added filter foreach to remove zero's
# irregular zeros,
# test on zero's 0.1 0.0 0.0 0.2 0.3 0.4
# returns 0.192 , correct
# test on zero's 0.1 0.0 0.0 0.2 0.3 0.4
# returns 0.192 , correct
