Tcl Library Source Code

Artifact [e71d208760]
Login

Artifact e71d20876049f147a301c4abc0afa576aec6076d75e9ec5c675abb007615691e:

Attachment "proportional_weighted_shares_for_submit_TCLLIB_math_stats.tcl" to ticket [e6b2685388] added by anonymous 2018-08-06 23:21:06. (unpublished)
        # pretty print from autoindent and ased editor
        # proportional_weighted_shares for submit TCLLIB math::stats? package?
        # possibly related rational_funcs.tcl and geometry.tcl
        # seen similar problems in high school algebra and geometry texts
        # working under TCL version 8.6.4
        # console program written on Windows XP on TCL
        # test statements and designated errors hard wired at end
        # This code is copyrighted same as TCL version 8.6.4
        # 3aug2018, copyrighted under and same as TCL license.
        # Editorial rights are reserved under TCL license
        # De and Mad Max on Facebook TCL club, 2aug2018
        package require Tk
        console show
        package require math::numtheory
        namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory }
        set tcl_precision 17
        # adapted from tcl-wiki Stats 2011-05-22, arithmetic mean  [RLE]
        #
        # ::math::stats::proportional_weighted_shares --
        #
        # Return the proportional_weighted_shares from quantity by two or more given ratios
        #
        # Arguments:
        #    quantity   first value is quantity
        #    args       second, third,  and sucessive values
        #               are two or more given ratios (usually integers in high school)
        #               However, decimal fractions for both quantity and args seem
        #               to be reasonably accurate to TCL precison.     
        # Conditions and answer checks
        #       The quantity must be larger than 0
        #       The number of args must be larger than 2
        #       If sum of parts equals zero, formula is undefined
        #       Number of parts should be equal to [ llength $args ] 
        #       Total value of parts should be equal to quantity entry
        #       The solution may not be unique in that more than one
        #       set of shares may have or generate the same multiple ratios. 
        # Results: parts of quantity into proportional weighted shares
        #    
        proc ::math::proportional_weighted_shares {quantity args} {
        if { $quantity <= 0 } {
 return -code error "The quantity must be larger than 0"
 }

        if { [ llength $args ] <= 1.9 } {
 return -code error "The number of args must be 2 or more"
 }

        if { [ expr ([join $args +]) ] <= 0 } {
 return -code error "The sum of args must be more than zero"
 }
 
            set sum 0.
            set N [ expr { [ llength $args ] + 1 } ]
            if { $N == 1  } { return 0 }
            foreach val $args {
                set sum [ expr { $sum + ($val*1.) } ]
            }
            foreach val $args {
                lappend answer [ expr { $quantity * ((1.*$val)/$sum) } ]
            }
            set answer
        }
        console eval {.console config -bg palegreen}
        console eval {.console config -font {fixed 20 bold}}
        console eval {wm geometry . 40x20}
        console eval {wm title . "Quantity into Parts Calculator , cut and paste from console 1"}      
        console eval {. configure -background orange -highlightcolor brown -relief raised -border 30}
        puts "  ::math::proportional_weighted_shares ( 84 1 2 4  )  answer 12.0 24.0 48.0    "
        puts " [ ::math::proportional_weighted_shares 84 1 2 4  ]  " 
        puts "  ::math::proportional_weighted_shares ( 14 1 2 4  )  answer   2.0 4.0 8.0    "
        puts " [ ::math::proportional_weighted_shares 14 1 2 4  ]  " 
        puts "  ::math::proportional_weighted_shares ( 10 2 3   )  answer    4.0 6.0     "
        puts " [ ::math::proportional_weighted_shares 10 2 3   ]  " 
        puts "  ::math::proportional_weighted_shares ( 11 2 3   )  answer   4.40 6.59     "
        puts " [ ::math::proportional_weighted_shares 11 2 3   ]  "
        puts "  ::math::proportional_weighted_shares ( 9 1 1 1  )  answer   3.0 3.0 3.0   "
        puts " [ ::math::proportional_weighted_shares 9 1 1 1  ]  " 
        puts "  ::math::proportional_weighted_shares ( 10 1 1 1 1 1 1 1 1 1 1  )  answer    1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0    "
        puts " [ ::math::proportional_weighted_shares 10 1 1 1 1 1 1 1 1 1 1   ]  " 
        puts "  ::math::proportional_weighted_shares ( 0.10 .1 .1 .1 .1 .1 .1 .1 .1 .1 .1  )  answer  0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.01    "
        puts " [ ::math::proportional_weighted_shares 0.10 .1 .1 .1 .1 .1 .1 .1 .1 .1 .1    ]  " 
        # following return designated errors
        #puts "  ::math::proportional_weighted_shares ( 10 1   )  answer   returns error    "
        #puts " [ ::math::proportional_weighted_shares 10 1   ]  " 
        #puts " [ ::math::proportional_weighted_shares 84 1 ] for (::math::proportional_weighted_shares 84 1) returns error "
        #puts " [ ::math::proportional_weighted_shares 84 ] for (::math::proportional_weighted_shares 84 0) returns error "
        #puts " [ ::math::proportional_weighted_shares -2 1 2 3 ] for (::math::proportional_weighted_shares -2 1 2 3) returns error "
        #end of deck