unmaintained/taxes/taxes.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs kernel math math.intervals
   4 namespaces sequences combinators.lib money math.order ;
   5 IN: taxes
   6
   7 : monthly ( x -- y ) 12 / ;
   8 : semimonthly ( x -- y ) 24 / ;
   9 : biweekly ( x -- y ) 26 / ;
  10 : weekly ( x -- y ) 52 / ;
  11 : daily ( x -- y ) 360 / ;
  12
  13 ! Each employee fills out a w4
  14 TUPLE: w4 year allowances married? ;
  15 C: <w4> w4
  16
  17 : allowance ( -- x ) 3500 ; inline
  18
  19 : calculate-w4-allowances ( w4 -- x ) allowances>> allowance * ;
  20
  21 ! Withhold: FICA, Medicare, Federal (FICA is social security)
  22 : fica-tax-rate ( -- x ) DECIMAL: .062 ; inline
  23
  24 ! Base rate -- income over this rate is not taxed
  25 ERROR: fica-base-unknown ;
  26 : fica-base-rate ( year -- x )
  27     H{
  28         { 2008 102000 }
  29         { 2007  97500 }
  30     } at* [ fica-base-unknown ] unless ;
  31
  32 : fica-tax ( salary w4 -- x )
  33     year>> fica-base-rate min fica-tax-rate * ;
  34
  35 ! Employer tax only, not withheld
  36 : futa-tax-rate ( -- x ) DECIMAL: .062 ; inline
  37 : futa-base-rate ( -- x ) 7000 ; inline
  38 : futa-tax-offset-credit ( -- x ) DECIMAL: .054 ; inline
  39
  40 : futa-tax ( salary w4 -- x )
  41     drop futa-base-rate min
  42     futa-tax-rate futa-tax-offset-credit -
  43     * ;
  44
  45 ! No base rate for medicare; all wages subject
  46 : medicare-tax-rate ( -- x ) DECIMAL: .0145 ; inline
  47 : medicare-tax ( salary w4 -- x ) drop medicare-tax-rate * ;
  48
  49 MIXIN: collector
  50 GENERIC: adjust-allowances ( salary w4 collector -- newsalary )
  51 GENERIC: withholding ( salary w4 collector -- x )
  52
  53 TUPLE: tax-table single married ;
  54
  55 : <tax-table> ( single married class -- obj )
  56     >r tax-table boa r> construct-delegate ;
  57
  58 : tax-bracket-range ( pair -- n ) dup second swap first - ;
  59
  60 : tax-bracket ( tax salary triples -- tax salary )
  61     [ [ tax-bracket-range min ] keep third * + ] 2keep
  62     tax-bracket-range [-] ;
  63
  64 : tax ( salary triples -- x )
  65     0 -rot [ tax-bracket ] each drop ;
  66
  67 : marriage-table ( w4 tax-table -- triples )
  68     swap married?>> [ married>> ] [ single>> ] if ;
  69
  70 : federal-tax ( salary w4 tax-table -- n )
  71     [ adjust-allowances ] 2keep marriage-table tax ;
  72
  73 ! http://www.irs.gov/pub/irs-pdf/p15.pdf
  74 ! Table 7 ANNUAL Payroll Period
  75
  76 : federal-single ( -- triples )
  77     {
  78         {      0   2650 DECIMAL: 0   }
  79         {   2650  10300 DECIMAL: .10 }
  80         {  10300  33960 DECIMAL: .15 }
  81         {  33960  79725 DECIMAL: .25 }
  82         {  79725 166500 DECIMAL: .28 }
  83         { 166500 359650 DECIMAL: .33 }
  84         { 359650   1/0. DECIMAL: .35 }
  85     } ;
  86
  87 : federal-married ( -- triples )
  88     {
  89         {      0   8000 DECIMAL: 0   }
  90         {   8000  23550 DECIMAL: .10 }
  91         {  23550  72150 DECIMAL: .15 }
  92         {  72150 137850 DECIMAL: .25 }
  93         { 137850 207700 DECIMAL: .28 }
  94         { 207700 365100 DECIMAL: .33 }
  95         { 365100   1/0. DECIMAL: .35 }
  96     } ;
  97
  98 TUPLE: federal ;
  99 INSTANCE: federal collector
 100 : <federal> ( -- obj )
 101     federal-single federal-married federal <tax-table> ;
 102
 103 M: federal adjust-allowances ( salary w4 collector -- newsalary )
 104     drop calculate-w4-allowances - ;
 105
 106 M: federal withholding ( salary w4 tax-table -- x )
 107     [ federal-tax ] 3keep drop
 108     [ fica-tax ] 2keep
 109     medicare-tax + + ;
 110
 111
 112 ! Minnesota
 113 : minnesota-single ( -- triples )
 114     {
 115         {     0  1950  DECIMAL: 0     }
 116         {  1950 23750  DECIMAL: .0535 }
 117         { 23750 73540  DECIMAL: .0705 }
 118         { 73540 1/0.   DECIMAL: .0785 }
 119     } ;
 120
 121 : minnesota-married ( -- triples )
 122     {
 123         {      0   7400 DECIMAL: 0     }
 124         {   7400  39260 DECIMAL: .0535 }
 125         {  39260 133980 DECIMAL: .0705 }
 126         { 133980   1/0. DECIMAL: .0785 }
 127     } ;
 128
 129 TUPLE: minnesota ;
 130 INSTANCE: minnesota collector
 131 : <minnesota> ( -- obj )
 132     minnesota-single minnesota-married minnesota <tax-table> ;
 133
 134 M: minnesota adjust-allowances ( salary w4 collector -- newsalary )
 135     drop calculate-w4-allowances - ;
 136
 137 M: minnesota withholding ( salary w4 collector -- x )
 138     [ adjust-allowances ] 2keep marriage-table tax ;
 139
 140 : employer-withhold ( salary w4 collector -- x )
 141     [ withholding ] 3keep
 142     dup federal? [ 3drop ] [ drop <federal> withholding + ] if ;
 143
 144 : net ( salary w4 collector -- x )
 145     >r dupd r> employer-withhold - ;