diff --git a/extra/taxes/usa/federal/federal.factor b/extra/taxes/usa/federal/federal.factor new file mode 100644 index 0000000000..b71b831ca6 --- /dev/null +++ b/extra/taxes/usa/federal/federal.factor @@ -0,0 +1,59 @@ +! 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.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 + + ; + +: 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 new file mode 100644 index 0000000000..c1e85b75b4 --- /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 assocs.lib math math.order 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..7368aef825 --- /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 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/unmaintained/taxes/taxes-tests.factor b/extra/taxes/usa/usa-tests.factor similarity index 56% rename from unmaintained/taxes/taxes-tests.factor rename to extra/taxes/usa/usa-tests.factor index 17d1998f67..a529762c81 100644 --- a/unmaintained/taxes/taxes-tests.factor +++ b/extra/taxes/usa/usa-tests.factor @@ -1,5 +1,7 @@ -USING: kernel money taxes tools.test ; -IN: taxes.tests +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 @@ -42,14 +44,14 @@ IN: taxes.tests [ 780 81 ] [ - 24000 2008 3 f net biweekly + 24000 2008 3 f net biweekly dollars/cents ] unit-test [ 818 76 ] [ - 24000 2008 3 t net biweekly + 24000 2008 3 t net biweekly dollars/cents ] unit-test @@ -57,14 +59,14 @@ IN: taxes.tests [ 2124 39 ] [ - 78250 2008 3 f net biweekly + 78250 2008 3 f net biweekly dollars/cents ] unit-test [ 2321 76 ] [ - 78250 2008 3 t net biweekly + 78250 2008 3 t net biweekly dollars/cents ] unit-test @@ -72,45 +74,45 @@ IN: taxes.tests [ 2612 63 ] [ - 100000 2008 3 f net biweekly + 100000 2008 3 f net biweekly dollars/cents ] unit-test [ 22244 52 ] [ - 1000000 2008 3 f net biweekly + 1000000 2008 3 f net biweekly dollars/cents ] unit-test [ 578357 40 ] [ - 1000000 2008 3 f net + 1000000 2008 3 f net dollars/cents ] unit-test [ 588325 41 ] [ - 1000000 2008 3 t net + 1000000 2008 3 t net dollars/cents ] unit-test [ 30 97 ] [ - 24000 2008 2 f withholding biweekly dollars/cents + 24000 2008 2 f MN withholding* biweekly dollars/cents ] unit-test [ 173 66 ] [ - 78250 2008 2 f withholding biweekly dollars/cents + 78250 2008 2 f MN withholding* biweekly dollars/cents ] unit-test [ 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 new file mode 100644 index 0000000000..27ff4aef98 --- /dev/null +++ b/extra/taxes/usa/usa.factor @@ -0,0 +1,32 @@ +! 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 ; +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>> withholding* ; + +: 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 ; 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 / ; 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.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 - ;