--- /dev/null
+! 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
+: <federal> ( -- obj )
+ federal federal-single federal-married <tax-table> ;
+
+: 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 + + ;
--- /dev/null
+! 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 * ;
--- /dev/null
+! 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 -
+ * ;
--- /dev/null
+! 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 * ;
--- /dev/null
+! 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 }
+ } ;
+
+: <mn> ( -- obj )
+ MN mn-single mn-married <tax-table> ;
+
+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 ;
--- /dev/null
+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 <w4> <federal> net biweekly
+ dollars/cents
+] unit-test
+
+[
+ 426 23
+] [
+ 12000 2008 3 t <w4> <federal> net biweekly
+ dollars/cents
+] unit-test
+
+[
+ 684 4
+] [
+ 20000 2008 3 f <w4> <federal> net biweekly
+ dollars/cents
+] unit-test
+
+
+
+[
+ 804 58
+] [
+ 24000 2008 3 f <w4> <federal> net biweekly
+ dollars/cents
+] unit-test
+
+[
+ 831 31
+] [
+ 24000 2008 3 t <w4> <federal> net biweekly
+ dollars/cents
+] unit-test
+
+
+[
+ 780 81
+] [
+ 24000 2008 3 f <w4> <mn> net biweekly
+ dollars/cents
+] unit-test
+
+[
+ 818 76
+] [
+ 24000 2008 3 t <w4> <mn> net biweekly
+ dollars/cents
+] unit-test
+
+
+[
+ 2124 39
+] [
+ 78250 2008 3 f <w4> <mn> net biweekly
+ dollars/cents
+] unit-test
+
+[
+ 2321 76
+] [
+ 78250 2008 3 t <w4> <mn> net biweekly
+ dollars/cents
+] unit-test
+
+
+[
+ 2612 63
+] [
+ 100000 2008 3 f <w4> <mn> net biweekly
+ dollars/cents
+] unit-test
+
+[
+ 22244 52
+] [
+ 1000000 2008 3 f <w4> <mn> net biweekly
+ dollars/cents
+] unit-test
+
+[
+ 578357 40
+] [
+ 1000000 2008 3 f <w4> <mn> net
+ dollars/cents
+] unit-test
+
+[
+ 588325 41
+] [
+ 1000000 2008 3 t <w4> <mn> net
+ dollars/cents
+] unit-test
+
+
+[ 30 97 ] [
+ 24000 2008 2 f <w4> <mn> MN withholding* biweekly dollars/cents
+] unit-test
+
+[ 173 66 ] [
+ 78250 2008 2 f <w4> <mn> MN withholding* biweekly dollars/cents
+] unit-test
+
+
+[ 138 69 ] [
+ 24000 2008 2 f <w4> <federal> withholding biweekly dollars/cents
+] unit-test
+
+[ 754 72 ] [
+ 78250 2008 2 f <w4> <federal> withholding biweekly dollars/cents
+] unit-test
--- /dev/null
+! 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> 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> 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 - ;
--- /dev/null
+! 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> w4
+
+: allowance ( -- x ) 3500 ; inline
+
+: calculate-w4-allowances ( w4 -- x ) allowances>> allowance * ;
+
--- /dev/null
+! 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 / ;
projects / factor.git / commitdiff