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

diff --git a/extra/taxes/usa/federal/federal.factor b/extra/taxes/usa/federal/federal.factor
new file mode 100644 (file)
index 0000000..5274535
--- /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 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 + + ;

diff --git a/extra/taxes/usa/fica/fica.factor b/extra/taxes/usa/fica/fica.factor
new file mode 100644 (file)
index 0000000..e71b272
--- /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 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 (file)
index 0000000..7368aef
--- /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 (file)
index 0000000..ea95224
--- /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 (file)
index 0000000..8bb629e
--- /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 }
+    } ;
+
+: <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 ;

diff --git a/extra/taxes/usa/usa-tests.factor b/extra/taxes/usa/usa-tests.factor
new file mode 100644 (file)
index 0000000..6aac4b9
--- /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 <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

diff --git a/extra/taxes/usa/usa.factor b/extra/taxes/usa/usa.factor
new file mode 100644 (file)
index 0000000..1d21524
--- /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> 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 - ;

diff --git a/extra/taxes/usa/w4/w4.factor b/extra/taxes/usa/w4/w4.factor
new file mode 100644 (file)
index 0000000..aad3773
--- /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> 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 (file)
index 0000000..a5c2240
--- /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 (file)
index 7c1b2f2..0000000
--- 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 (file)
index e983139..0000000
--- 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 (file)
index 2964ef2..0000000
--- 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 (file)
index 17d1998..0000000
--- 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 <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> <minnesota> net biweekly
-    dollars/cents
-] unit-test
-
-[
-    818 76
-] [
-    24000 2008 3 t <w4> <minnesota> net biweekly
-    dollars/cents
-] unit-test
-
-
-[
-    2124 39
-] [
-    78250 2008 3 f <w4> <minnesota> net biweekly
-    dollars/cents
-] unit-test
-
-[
-    2321 76
-] [
-    78250 2008 3 t <w4> <minnesota> net biweekly
-    dollars/cents
-] unit-test
-
-
-[
-    2612 63
-] [
-    100000 2008 3 f <w4> <minnesota> net biweekly
-    dollars/cents
-] unit-test
-
-[
-    22244 52
-] [
-    1000000 2008 3 f <w4> <minnesota> net biweekly
-    dollars/cents
-] unit-test
-
-[
-    578357 40
-] [
-    1000000 2008 3 f <w4> <minnesota> net
-    dollars/cents
-] unit-test
-
-[
-    588325 41
-] [
-    1000000 2008 3 t <w4> <minnesota> net
-    dollars/cents
-] unit-test
-
-
-[ 30 97 ] [
-    24000 2008 2 f <w4> <minnesota> withholding biweekly dollars/cents
-] unit-test
-
-[ 173 66 ] [
-    78250 2008 2 f <w4> <minnesota> 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

diff --git a/unmaintained/taxes/taxes.factor b/unmaintained/taxes/taxes.factor
deleted file mode 100644 (file)
index 5e2a395..0000000
--- 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> 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 - ;