diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor index 1f979ffaa0..ae3a69beb2 100644 --- a/extra/math/extras/extras-tests.factor +++ b/extra/math/extras/extras-tests.factor @@ -33,3 +33,30 @@ IN: math.extras.test { { 0 2/3 2/3 0 } } [ 4 bartlett ] unit-test { { 0 1/2 1 1/2 0 } } [ 5 bartlett ] unit-test { { 0 2/5 4/5 4/5 2/5 0 } } [ 6 bartlett ] unit-test + +{ 2819/3914 } [ + { + 998,000 + 20,000 + 17,500 + 70,000 + 23,500 + 45,200 + } gini +] unit-test + +{ 8457/9785 } [ + { + 998,000 + 20,000 + 17,500 + 70,000 + 23,500 + 45,200 + } concentration-coefficient +] unit-test + +{ 0 } [ { 1 } gini ] unit-test +{ 0 } [ { 1 1 1 1 1 1 } gini ] unit-test +{ 0 } [ { 10 10 10 10 } gini ] unit-test +{ 0 } [ { } gini ] unit-test diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor index 74e27c7a18..005a924453 100644 --- a/extra/math/extras/extras.factor +++ b/extra/math/extras/extras.factor @@ -4,7 +4,7 @@ USING: combinators.short-circuit grouping kernel locals math math.combinatorics math.constants math.functions math.order math.primes math.ranges math.statistics math.vectors memoize -sequences ; +sequences sequences.extras sorting assocs ; IN: math.extras @@ -154,3 +154,20 @@ PRIVATE> : until-zero ( n quot -- ) [ dup zero? ] swap until drop ; inline + + sorted + seq length :> len + len [1,b] sorted zip 0 [ * + ] assoc-reduce :> sum0 + 2 sum0 * sorted sum len * / :> G + G 1 - 1 len / - ; inline + +PRIVATE> + +: gini ( seq -- x ) + dup length 1 <= [ drop 0 ] [ (gini) ] if ; + +: concentration-coefficient ( seq -- x ) + [ gini ] [ length [ ] [ 1 - ] bi / ] bi * ;