steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-10-03 00:41:47 -05:00
parent ec31e23ca7 ae60340653
commit e7a785c58f
13 changed files with 203 additions and 162 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
extra/taxes/usa/federal/federal.factor Normal file
View File

@ -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
: <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 + + ;
: total-withholding ( salary w4 tax-table -- x )
dup entity>> dup federal = [
withholding*
] [
drop
[ drop <federal> federal withholding* ]
[ dup entity>> withholding* ] 3bi +
] if ;
: net ( salary w4 collector -- x )
>r dupd r> total-withholding - ;

17
extra/taxes/usa/fica/fica.factor Normal file
View File

@ -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 * ;

15
extra/taxes/usa/futa/futa.factor Normal file
View File

@ -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 -
* ;

8
extra/taxes/usa/medicare/medicare.factor Normal file
View File

@ -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 * ;

33
extra/taxes/usa/mn/mn.factor Normal file
View File

@ -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 }
} ;
: <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 ;

30
unmaintained/taxes/taxes-tests.factor → extra/taxes/usa/usa-tests.factor
View File

@ -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 <w4> <minnesota> net biweekly
24000 2008 3 f <w4> <mn> net biweekly
dollars/cents
] unit-test
[
818 76
] [
24000 2008 3 t <w4> <minnesota> net biweekly
24000 2008 3 t <w4> <mn> net biweekly
dollars/cents
] unit-test
@ -57,14 +59,14 @@ IN: taxes.tests
[
2124 39
] [
78250 2008 3 f <w4> <minnesota> net biweekly
78250 2008 3 f <w4> <mn> net biweekly
dollars/cents
] unit-test
[
2321 76
] [
78250 2008 3 t <w4> <minnesota> net biweekly
78250 2008 3 t <w4> <mn> net biweekly
dollars/cents
] unit-test
@ -72,45 +74,45 @@ IN: taxes.tests
[
2612 63
] [
100000 2008 3 f <w4> <minnesota> net biweekly
100000 2008 3 f <w4> <mn> net biweekly
dollars/cents
] unit-test
[
22244 52
] [
1000000 2008 3 f <w4> <minnesota> net biweekly
1000000 2008 3 f <w4> <mn> net biweekly
dollars/cents
] unit-test
[
578357 40
] [
1000000 2008 3 f <w4> <minnesota> net
1000000 2008 3 f <w4> <mn> net
dollars/cents
] unit-test
[
588325 41
] [
1000000 2008 3 t <w4> <minnesota> net
1000000 2008 3 t <w4> <mn> net
dollars/cents
] unit-test
[ 30 97 ] [
24000 2008 2 f <w4> <minnesota> withholding biweekly dollars/cents
24000 2008 2 f <w4> <mn> MN withholding* biweekly dollars/cents
] unit-test
[ 173 66 ] [
78250 2008 2 f <w4> <minnesota> withholding biweekly dollars/cents
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
24000 2008 2 f <w4> <federal> total-withholding biweekly dollars/cents
] unit-test
[ 754 72 ] [
78250 2008 2 f <w4> <federal> withholding biweekly dollars/cents
78250 2008 2 f <w4> <federal> total-withholding biweekly dollars/cents
] unit-test

32
extra/taxes/usa/usa.factor Normal file
View File

@ -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> 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 ;

13
extra/taxes/usa/w4/w4.factor Normal file
View File

@ -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> w4
: allowance ( -- x ) 3500 ; inline
: calculate-w4-allowances ( w4 -- x ) allowances>> allowance * ;

10
extra/taxes/utils/utils.factor Normal file
View File

@ -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 / ;

1
unmaintained/taxes/authors.txt
View File

@ -1 +0,0 @@
Doug Coleman

1
unmaintained/taxes/summary.txt
View File

@ -1 +0,0 @@
Calculate federal and state tax withholdings

1
unmaintained/taxes/tags.txt
View File

@ -1 +0,0 @@
taxes

145
unmaintained/taxes/taxes.factor
View File

@ -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> 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 ;
: <tax-table> ( 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
: <federal> ( -- obj )
federal-single federal-married federal <tax-table> ;
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
: <minnesota> ( -- obj )
minnesota-single minnesota-married minnesota <tax-table> ;
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 <federal> withholding + ] if ;
: net ( salary w4 collector -- x )
>r dupd r> employer-withhold - ;