From 1ff9d3f304688d917967199e03720116a5634701 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 30 Sep 2008 12:47:46 -0500 Subject: [PATCH 1/4] fixed taxes --- extra/taxes/usa/federal/federal.factor | 47 +++++++++ extra/taxes/usa/fica/fica.factor | 17 ++++ extra/taxes/usa/futa/futa.factor | 15 +++ extra/taxes/usa/medicare/medicare.factor | 8 ++ extra/taxes/usa/mn/mn.factor | 33 +++++++ extra/taxes/usa/usa-tests.factor | 118 +++++++++++++++++++++++ extra/taxes/usa/usa.factor | 41 ++++++++ extra/taxes/usa/w4/w4.factor | 13 +++ extra/taxes/utils/utils.factor | 10 ++ 9 files changed, 302 insertions(+) create mode 100644 extra/taxes/usa/federal/federal.factor create mode 100644 extra/taxes/usa/fica/fica.factor create mode 100644 extra/taxes/usa/futa/futa.factor create mode 100644 extra/taxes/usa/medicare/medicare.factor create mode 100644 extra/taxes/usa/mn/mn.factor create mode 100644 extra/taxes/usa/usa-tests.factor create mode 100644 extra/taxes/usa/usa.factor create mode 100644 extra/taxes/usa/w4/w4.factor create mode 100644 extra/taxes/utils/utils.factor diff --git a/extra/taxes/usa/federal/federal.factor b/extra/taxes/usa/federal/federal.factor new file mode 100644 index 0000000000..91d22ee828 --- /dev/null +++ b/extra/taxes/usa/federal/federal.factor @@ -0,0 +1,47 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs kernel math math.intervals +namespaces sequences combinators.lib money math.order +taxes.usa.fica taxes.usa.medicare taxes.usa taxes.usa.w4 ; +IN: taxes.usa.federal + +! http://www.irs.gov/pub/irs-pdf/p15.pdf +! Table 7 ANNUAL Payroll Period + +: federal-single ( -- triples ) + { + { 0 2650 DECIMAL: 0 } + { 2650 10300 DECIMAL: .10 } + { 10300 33960 DECIMAL: .15 } + { 33960 79725 DECIMAL: .25 } + { 79725 166500 DECIMAL: .28 } + { 166500 359650 DECIMAL: .33 } + { 359650 1/0. DECIMAL: .35 } + } ; + +: federal-married ( -- triples ) + { + { 0 8000 DECIMAL: 0 } + { 8000 23550 DECIMAL: .10 } + { 23550 72150 DECIMAL: .15 } + { 72150 137850 DECIMAL: .25 } + { 137850 207700 DECIMAL: .28 } + { 207700 365100 DECIMAL: .33 } + { 365100 1/0. DECIMAL: .35 } + } ; + +SINGLETON: federal +: ( -- obj ) + federal federal-single federal-married ; + +: federal-tax ( salary w4 tax-table -- n ) + [ adjust-allowances ] 2keep marriage-table tax ; + +M: federal adjust-allowances* ( salary w4 collector entity -- newsalary ) + 2drop calculate-w4-allowances - ; + +M: federal withholding* ( salary w4 tax-table entity -- x ) + drop + [ federal-tax ] 3keep drop + [ fica-tax ] 2keep + medicare-tax + + ; diff --git a/extra/taxes/usa/fica/fica.factor b/extra/taxes/usa/fica/fica.factor new file mode 100644 index 0000000000..69a62753f2 --- /dev/null +++ b/extra/taxes/usa/fica/fica.factor @@ -0,0 +1,17 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors math math.order assocs.lib money ; +IN: taxes.usa.fica + +: fica-tax-rate ( -- x ) DECIMAL: .062 ; inline + +ERROR: fica-base-unknown year ; + +: fica-base-rate ( year -- x ) + H{ + { 2008 102000 } + { 2007 97500 } + } [ fica-base-unknown ] unless-at ; + +: fica-tax ( salary w4 -- x ) + year>> fica-base-rate min fica-tax-rate * ; diff --git a/extra/taxes/usa/futa/futa.factor b/extra/taxes/usa/futa/futa.factor new file mode 100644 index 0000000000..36d3097007 --- /dev/null +++ b/extra/taxes/usa/futa/futa.factor @@ -0,0 +1,15 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs kernel math math.intervals +namespaces sequences combinators.lib money math.order ; +IN: taxes.usa.futa + +! Employer tax only, not withheld +: futa-tax-rate ( -- x ) DECIMAL: .062 ; inline +: futa-base-rate ( -- x ) 7000 ; inline +: futa-tax-offset-credit ( -- x ) DECIMAL: .054 ; inline + +: futa-tax ( salary w4 -- x ) + drop futa-base-rate min + futa-tax-rate futa-tax-offset-credit - + * ; diff --git a/extra/taxes/usa/medicare/medicare.factor b/extra/taxes/usa/medicare/medicare.factor new file mode 100644 index 0000000000..ea95224456 --- /dev/null +++ b/extra/taxes/usa/medicare/medicare.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math money ; +IN: taxes.usa.medicare + +! No base rate for medicare; all wages subject +: medicare-tax-rate ( -- x ) DECIMAL: .0145 ; inline +: medicare-tax ( salary w4 -- x ) drop medicare-tax-rate * ; diff --git a/extra/taxes/usa/mn/mn.factor b/extra/taxes/usa/mn/mn.factor new file mode 100644 index 0000000000..8bb629efcd --- /dev/null +++ b/extra/taxes/usa/mn/mn.factor @@ -0,0 +1,33 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs kernel math math.intervals +namespaces sequences money math.order usa-cities +taxes.usa taxes.usa.w4 ; +IN: taxes.usa.mn + +! Minnesota +: mn-single ( -- triples ) + { + { 0 1950 DECIMAL: 0 } + { 1950 23750 DECIMAL: .0535 } + { 23750 73540 DECIMAL: .0705 } + { 73540 1/0. DECIMAL: .0785 } + } ; + +: mn-married ( -- triples ) + { + { 0 7400 DECIMAL: 0 } + { 7400 39260 DECIMAL: .0535 } + { 39260 133980 DECIMAL: .0705 } + { 133980 1/0. DECIMAL: .0785 } + } ; + +: ( -- obj ) + MN mn-single mn-married ; + +M: MN adjust-allowances* ( salary w4 collector entity -- newsalary ) + 2drop calculate-w4-allowances - ; + +M: MN withholding* ( salary w4 collector entity -- x ) + drop + [ adjust-allowances ] 2keep marriage-table tax ; diff --git a/extra/taxes/usa/usa-tests.factor b/extra/taxes/usa/usa-tests.factor new file mode 100644 index 0000000000..6aac4b928c --- /dev/null +++ b/extra/taxes/usa/usa-tests.factor @@ -0,0 +1,118 @@ +USING: kernel money tools.test +taxes.usa taxes.usa.federal taxes.usa.mn +taxes.utils taxes.usa.w4 usa-cities ; +IN: taxes.usa.tests + +[ + 426 23 +] [ + 12000 2008 3 f net biweekly + dollars/cents +] unit-test + +[ + 426 23 +] [ + 12000 2008 3 t net biweekly + dollars/cents +] unit-test + +[ + 684 4 +] [ + 20000 2008 3 f net biweekly + dollars/cents +] unit-test + + + +[ + 804 58 +] [ + 24000 2008 3 f net biweekly + dollars/cents +] unit-test + +[ + 831 31 +] [ + 24000 2008 3 t net biweekly + dollars/cents +] unit-test + + +[ + 780 81 +] [ + 24000 2008 3 f net biweekly + dollars/cents +] unit-test + +[ + 818 76 +] [ + 24000 2008 3 t net biweekly + dollars/cents +] unit-test + + +[ + 2124 39 +] [ + 78250 2008 3 f net biweekly + dollars/cents +] unit-test + +[ + 2321 76 +] [ + 78250 2008 3 t net biweekly + dollars/cents +] unit-test + + +[ + 2612 63 +] [ + 100000 2008 3 f net biweekly + dollars/cents +] unit-test + +[ + 22244 52 +] [ + 1000000 2008 3 f net biweekly + dollars/cents +] unit-test + +[ + 578357 40 +] [ + 1000000 2008 3 f net + dollars/cents +] unit-test + +[ + 588325 41 +] [ + 1000000 2008 3 t net + dollars/cents +] unit-test + + +[ 30 97 ] [ + 24000 2008 2 f MN withholding* biweekly dollars/cents +] unit-test + +[ 173 66 ] [ + 78250 2008 2 f MN withholding* biweekly dollars/cents +] unit-test + + +[ 138 69 ] [ + 24000 2008 2 f withholding biweekly dollars/cents +] unit-test + +[ 754 72 ] [ + 78250 2008 2 f withholding biweekly dollars/cents +] unit-test diff --git a/extra/taxes/usa/usa.factor b/extra/taxes/usa/usa.factor new file mode 100644 index 0000000000..1d21524b45 --- /dev/null +++ b/extra/taxes/usa/usa.factor @@ -0,0 +1,41 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs kernel math math.intervals +namespaces sequences money math.order taxes.usa.w4 +taxes.usa.federal ; +IN: taxes.usa + +! Withhold: FICA, Medicare, Federal (FICA is social security) + +TUPLE: tax-table entity single married ; +C: tax-table + +GENERIC: adjust-allowances* ( salary w4 tax-table entity -- newsalary ) +GENERIC: withholding* ( salary w4 tax-table entity -- x ) + +: adjust-allowances ( salary w4 tax-table -- newsalary ) + dup entity>> adjust-allowances* ; + +: withholding ( salary w4 tax-table -- x ) + dup entity>> federal = [ + dup entity>> withholding* + ] [ + [ dup entity>> withholding* ] + [ drop federal withholding* ] 3bi + + ] if ; + +: tax-bracket-range ( pair -- n ) first2 swap - ; + +: tax-bracket ( tax salary triples -- tax salary ) + [ [ tax-bracket-range min ] keep third * + ] 2keep + tax-bracket-range [-] ; + +: tax ( salary triples -- x ) + 0 -rot [ tax-bracket ] each drop ; + +: marriage-table ( w4 tax-table -- triples ) + swap married?>> + [ married>> ] [ single>> ] if ; + +: net ( salary w4 collector -- x ) + >r dupd r> withholding - ; diff --git a/extra/taxes/usa/w4/w4.factor b/extra/taxes/usa/w4/w4.factor new file mode 100644 index 0000000000..aad3773220 --- /dev/null +++ b/extra/taxes/usa/w4/w4.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors kernel math ; +IN: taxes.usa.w4 + +! Each employee fills out a w4 +TUPLE: w4 year allowances married? ; +C: w4 + +: allowance ( -- x ) 3500 ; inline + +: calculate-w4-allowances ( w4 -- x ) allowances>> allowance * ; + diff --git a/extra/taxes/utils/utils.factor b/extra/taxes/utils/utils.factor new file mode 100644 index 0000000000..a5c2240625 --- /dev/null +++ b/extra/taxes/utils/utils.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: math ; +IN: taxes.utils + +: monthly ( x -- y ) 12 / ; +: semimonthly ( x -- y ) 24 / ; +: biweekly ( x -- y ) 26 / ; +: weekly ( x -- y ) 52 / ; +: daily ( x -- y ) 360 / ; From cb8e58ba0d7c39869e9373010439b5075a5480f0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 30 Sep 2008 12:48:22 -0500 Subject: [PATCH 2/4] remove old taxes --- unmaintained/taxes/authors.txt | 1 - unmaintained/taxes/summary.txt | 1 - unmaintained/taxes/tags.txt | 1 - unmaintained/taxes/taxes-tests.factor | 116 --------------------- unmaintained/taxes/taxes.factor | 145 -------------------------- 5 files changed, 264 deletions(-) delete mode 100644 unmaintained/taxes/authors.txt delete mode 100644 unmaintained/taxes/summary.txt delete mode 100644 unmaintained/taxes/tags.txt delete mode 100644 unmaintained/taxes/taxes-tests.factor delete mode 100644 unmaintained/taxes/taxes.factor diff --git a/unmaintained/taxes/authors.txt b/unmaintained/taxes/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/unmaintained/taxes/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/unmaintained/taxes/summary.txt b/unmaintained/taxes/summary.txt deleted file mode 100644 index e983139ccb..0000000000 --- a/unmaintained/taxes/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Calculate federal and state tax withholdings diff --git a/unmaintained/taxes/tags.txt b/unmaintained/taxes/tags.txt deleted file mode 100644 index 2964ef21b1..0000000000 --- a/unmaintained/taxes/tags.txt +++ /dev/null @@ -1 +0,0 @@ -taxes diff --git a/unmaintained/taxes/taxes-tests.factor b/unmaintained/taxes/taxes-tests.factor deleted file mode 100644 index 17d1998f67..0000000000 --- a/unmaintained/taxes/taxes-tests.factor +++ /dev/null @@ -1,116 +0,0 @@ -USING: kernel money taxes tools.test ; -IN: taxes.tests - -[ - 426 23 -] [ - 12000 2008 3 f net biweekly - dollars/cents -] unit-test - -[ - 426 23 -] [ - 12000 2008 3 t net biweekly - dollars/cents -] unit-test - -[ - 684 4 -] [ - 20000 2008 3 f net biweekly - dollars/cents -] unit-test - - - -[ - 804 58 -] [ - 24000 2008 3 f net biweekly - dollars/cents -] unit-test - -[ - 831 31 -] [ - 24000 2008 3 t net biweekly - dollars/cents -] unit-test - - -[ - 780 81 -] [ - 24000 2008 3 f net biweekly - dollars/cents -] unit-test - -[ - 818 76 -] [ - 24000 2008 3 t net biweekly - dollars/cents -] unit-test - - -[ - 2124 39 -] [ - 78250 2008 3 f net biweekly - dollars/cents -] unit-test - -[ - 2321 76 -] [ - 78250 2008 3 t net biweekly - dollars/cents -] unit-test - - -[ - 2612 63 -] [ - 100000 2008 3 f net biweekly - dollars/cents -] unit-test - -[ - 22244 52 -] [ - 1000000 2008 3 f net biweekly - dollars/cents -] unit-test - -[ - 578357 40 -] [ - 1000000 2008 3 f net - dollars/cents -] unit-test - -[ - 588325 41 -] [ - 1000000 2008 3 t net - dollars/cents -] unit-test - - -[ 30 97 ] [ - 24000 2008 2 f withholding biweekly dollars/cents -] unit-test - -[ 173 66 ] [ - 78250 2008 2 f withholding biweekly dollars/cents -] unit-test - - -[ 138 69 ] [ - 24000 2008 2 f withholding biweekly dollars/cents -] unit-test - -[ 754 72 ] [ - 78250 2008 2 f withholding biweekly dollars/cents -] unit-test diff --git a/unmaintained/taxes/taxes.factor b/unmaintained/taxes/taxes.factor deleted file mode 100644 index 5e2a395c40..0000000000 --- a/unmaintained/taxes/taxes.factor +++ /dev/null @@ -1,145 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs kernel math math.intervals -namespaces sequences combinators.lib money math.order ; -IN: taxes - -: monthly ( x -- y ) 12 / ; -: semimonthly ( x -- y ) 24 / ; -: biweekly ( x -- y ) 26 / ; -: weekly ( x -- y ) 52 / ; -: daily ( x -- y ) 360 / ; - -! Each employee fills out a w4 -TUPLE: w4 year allowances married? ; -C: w4 - -: allowance ( -- x ) 3500 ; inline - -: calculate-w4-allowances ( w4 -- x ) allowances>> allowance * ; - -! Withhold: FICA, Medicare, Federal (FICA is social security) -: fica-tax-rate ( -- x ) DECIMAL: .062 ; inline - -! Base rate -- income over this rate is not taxed -ERROR: fica-base-unknown ; -: fica-base-rate ( year -- x ) - H{ - { 2008 102000 } - { 2007 97500 } - } at* [ fica-base-unknown ] unless ; - -: fica-tax ( salary w4 -- x ) - year>> fica-base-rate min fica-tax-rate * ; - -! Employer tax only, not withheld -: futa-tax-rate ( -- x ) DECIMAL: .062 ; inline -: futa-base-rate ( -- x ) 7000 ; inline -: futa-tax-offset-credit ( -- x ) DECIMAL: .054 ; inline - -: futa-tax ( salary w4 -- x ) - drop futa-base-rate min - futa-tax-rate futa-tax-offset-credit - - * ; - -! No base rate for medicare; all wages subject -: medicare-tax-rate ( -- x ) DECIMAL: .0145 ; inline -: medicare-tax ( salary w4 -- x ) drop medicare-tax-rate * ; - -MIXIN: collector -GENERIC: adjust-allowances ( salary w4 collector -- newsalary ) -GENERIC: withholding ( salary w4 collector -- x ) - -TUPLE: tax-table single married ; - -: ( single married class -- obj ) - >r tax-table boa r> construct-delegate ; - -: tax-bracket-range ( pair -- n ) dup second swap first - ; - -: tax-bracket ( tax salary triples -- tax salary ) - [ [ tax-bracket-range min ] keep third * + ] 2keep - tax-bracket-range [-] ; - -: tax ( salary triples -- x ) - 0 -rot [ tax-bracket ] each drop ; - -: marriage-table ( w4 tax-table -- triples ) - swap married?>> [ married>> ] [ single>> ] if ; - -: federal-tax ( salary w4 tax-table -- n ) - [ adjust-allowances ] 2keep marriage-table tax ; - -! http://www.irs.gov/pub/irs-pdf/p15.pdf -! Table 7 ANNUAL Payroll Period - -: federal-single ( -- triples ) - { - { 0 2650 DECIMAL: 0 } - { 2650 10300 DECIMAL: .10 } - { 10300 33960 DECIMAL: .15 } - { 33960 79725 DECIMAL: .25 } - { 79725 166500 DECIMAL: .28 } - { 166500 359650 DECIMAL: .33 } - { 359650 1/0. DECIMAL: .35 } - } ; - -: federal-married ( -- triples ) - { - { 0 8000 DECIMAL: 0 } - { 8000 23550 DECIMAL: .10 } - { 23550 72150 DECIMAL: .15 } - { 72150 137850 DECIMAL: .25 } - { 137850 207700 DECIMAL: .28 } - { 207700 365100 DECIMAL: .33 } - { 365100 1/0. DECIMAL: .35 } - } ; - -TUPLE: federal ; -INSTANCE: federal collector -: ( -- obj ) - federal-single federal-married federal ; - -M: federal adjust-allowances ( salary w4 collector -- newsalary ) - drop calculate-w4-allowances - ; - -M: federal withholding ( salary w4 tax-table -- x ) - [ federal-tax ] 3keep drop - [ fica-tax ] 2keep - medicare-tax + + ; - - -! Minnesota -: minnesota-single ( -- triples ) - { - { 0 1950 DECIMAL: 0 } - { 1950 23750 DECIMAL: .0535 } - { 23750 73540 DECIMAL: .0705 } - { 73540 1/0. DECIMAL: .0785 } - } ; - -: minnesota-married ( -- triples ) - { - { 0 7400 DECIMAL: 0 } - { 7400 39260 DECIMAL: .0535 } - { 39260 133980 DECIMAL: .0705 } - { 133980 1/0. DECIMAL: .0785 } - } ; - -TUPLE: minnesota ; -INSTANCE: minnesota collector -: ( -- obj ) - minnesota-single minnesota-married minnesota ; - -M: minnesota adjust-allowances ( salary w4 collector -- newsalary ) - drop calculate-w4-allowances - ; - -M: minnesota withholding ( salary w4 collector -- x ) - [ adjust-allowances ] 2keep marriage-table tax ; - -: employer-withhold ( salary w4 collector -- x ) - [ withholding ] 3keep - dup federal? [ 3drop ] [ drop withholding + ] if ; - -: net ( salary w4 collector -- x ) - >r dupd r> employer-withhold - ; From 1b7c0b78573feae5b812b9c13df6f2adbc08ec15 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 30 Sep 2008 13:33:32 -0500 Subject: [PATCH 3/4] remove lib usage --- extra/taxes/usa/federal/federal.factor | 4 ++-- extra/taxes/usa/fica/fica.factor | 2 +- extra/taxes/usa/futa/futa.factor | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/taxes/usa/federal/federal.factor b/extra/taxes/usa/federal/federal.factor index 91d22ee828..5274535f81 100644 --- a/extra/taxes/usa/federal/federal.factor +++ b/extra/taxes/usa/federal/federal.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs kernel math math.intervals -namespaces sequences combinators.lib money math.order -taxes.usa.fica taxes.usa.medicare taxes.usa taxes.usa.w4 ; +namespaces sequences money math.order taxes.usa.fica +taxes.usa.medicare taxes.usa taxes.usa.w4 ; IN: taxes.usa.federal ! http://www.irs.gov/pub/irs-pdf/p15.pdf diff --git a/extra/taxes/usa/fica/fica.factor b/extra/taxes/usa/fica/fica.factor index 69a62753f2..e71b2723a3 100644 --- a/extra/taxes/usa/fica/fica.factor +++ b/extra/taxes/usa/fica/fica.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors math math.order assocs.lib money ; +USING: accessors math math.order money ; IN: taxes.usa.fica : fica-tax-rate ( -- x ) DECIMAL: .062 ; inline diff --git a/extra/taxes/usa/futa/futa.factor b/extra/taxes/usa/futa/futa.factor index 36d3097007..7368aef825 100644 --- a/extra/taxes/usa/futa/futa.factor +++ b/extra/taxes/usa/futa/futa.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs kernel math math.intervals -namespaces sequences combinators.lib money math.order ; +namespaces sequences money math.order ; IN: taxes.usa.futa ! Employer tax only, not withheld From 4c8ff1e2897a6409525b5c21994454110aab856c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 19:03:57 -0500 Subject: [PATCH 4/4] fix taxes --- extra/taxes/usa/federal/federal.factor | 12 ++++++++++++ extra/taxes/usa/fica/fica.factor | 2 +- extra/taxes/usa/usa-tests.factor | 4 ++-- extra/taxes/usa/usa.factor | 13 ++----------- 4 files changed, 17 insertions(+), 14 deletions(-) diff --git a/extra/taxes/usa/federal/federal.factor b/extra/taxes/usa/federal/federal.factor index 5274535f81..b71b831ca6 100644 --- a/extra/taxes/usa/federal/federal.factor +++ b/extra/taxes/usa/federal/federal.factor @@ -45,3 +45,15 @@ M: federal withholding* ( salary w4 tax-table entity -- x ) [ federal-tax ] 3keep drop [ fica-tax ] 2keep medicare-tax + + ; + +: total-withholding ( salary w4 tax-table -- x ) + dup entity>> dup federal = [ + withholding* + ] [ + drop + [ drop federal withholding* ] + [ dup entity>> withholding* ] 3bi + + ] if ; + +: net ( salary w4 collector -- x ) + >r dupd r> total-withholding - ; diff --git a/extra/taxes/usa/fica/fica.factor b/extra/taxes/usa/fica/fica.factor index e71b2723a3..c1e85b75b4 100644 --- a/extra/taxes/usa/fica/fica.factor +++ b/extra/taxes/usa/fica/fica.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors math math.order money ; +USING: accessors assocs.lib math math.order money ; IN: taxes.usa.fica : fica-tax-rate ( -- x ) DECIMAL: .062 ; inline diff --git a/extra/taxes/usa/usa-tests.factor b/extra/taxes/usa/usa-tests.factor index 6aac4b928c..a529762c81 100644 --- a/extra/taxes/usa/usa-tests.factor +++ b/extra/taxes/usa/usa-tests.factor @@ -110,9 +110,9 @@ IN: taxes.usa.tests [ 138 69 ] [ - 24000 2008 2 f withholding biweekly dollars/cents + 24000 2008 2 f total-withholding biweekly dollars/cents ] unit-test [ 754 72 ] [ - 78250 2008 2 f withholding biweekly dollars/cents + 78250 2008 2 f total-withholding biweekly dollars/cents ] unit-test diff --git a/extra/taxes/usa/usa.factor b/extra/taxes/usa/usa.factor index 1d21524b45..27ff4aef98 100644 --- a/extra/taxes/usa/usa.factor +++ b/extra/taxes/usa/usa.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs kernel math math.intervals -namespaces sequences money math.order taxes.usa.w4 -taxes.usa.federal ; +namespaces sequences money math.order taxes.usa.w4 ; IN: taxes.usa ! Withhold: FICA, Medicare, Federal (FICA is social security) @@ -17,12 +16,7 @@ GENERIC: withholding* ( salary w4 tax-table entity -- x ) dup entity>> adjust-allowances* ; : withholding ( salary w4 tax-table -- x ) - dup entity>> federal = [ - dup entity>> withholding* - ] [ - [ dup entity>> withholding* ] - [ drop federal withholding* ] 3bi + - ] if ; + dup entity>> withholding* ; : tax-bracket-range ( pair -- n ) first2 swap - ; @@ -36,6 +30,3 @@ GENERIC: withholding* ( salary w4 tax-table entity -- x ) : marriage-table ( w4 tax-table -- triples ) swap married?>> [ married>> ] [ single>> ] if ; - -: net ( salary w4 collector -- x ) - >r dupd r> withholding - ;