'税収弾性値のコンピュータ・プログラム
'　以下のプログラムでは、データセットが外部ファイルとなっているため、そのままでは税収の弾性値を
'計算'できない。しかし、『家計調査年報』などの所得階級別の所得と世帯数のデータを用いれば税収の
'弾性値を計'算することができる。                     Copyright(c) 1998  by Kyoji Hashimoto
'--------所得税の弾性値プログラム--------------------
DECLARE SUB Mtax5 (II, w, tax!, LTAX!, MEN!)
DECLARE SUB Mtax9 (II, w, tax!, LTAX!, MEN!)
DECLARE SUB LTAX5 (II, w, tax, LTAX)
DECLARE SUB LTAX9 (II, w, tax, LTAX)
DECLARE SUB KYUYO.49 (WAGE!, income!, WB!(), WR!(), II!, LKY!)
DECLARE SUB TAXRATE (n!, taxbase!, tax!, A(), T())
CLS:PRINT TIME$:CONST mm = 289
DIM ITAXM5(mm), ITAXL5(mm), LTAXM5(mm), LTAXL5(mm),ITAXM52(mm), ITAXL52(mm)
DIM  ltaxm52(mm), ltaxl52(mm),TAX5(mm), tax52(mm)
DIM SHARED age(mm), MEN(mm), KODOMO(mm), EDU(mm), MWAGE(mm), LWAGE(mm)
DIM SHARED MNENKIN(mm), LNENKIN(mm), MSHAHO(mm), LSHAHO(mm),SONPO(mm)
DIM SHARED SEIHO(mm),incomel(mm),mwage2(mm), lwage2(mm), 
DIM SHARED MNENKIN2(mm), LNENKIN2(mm)
OPEN "c:\KODOMO.txt" FOR INPUT AS #1: FOR i = 1 TO mm: INPUT #1, KODOMO(i): NEXT i
OPEN "c:\men.txt" FOR INPUT AS #2: FOR i = 1 TO mm: INPUT #2, MEN(i): NEXT i
OPEN "c:\age.txt" FOR INPUT AS #3: FOR i = 1 TO mm: INPUT #3, age(i): NEXT i
OPEN "c:\1622.txt" FOR INPUT AS #4: FOR i = 1 TO mm: INPUT #4, EDU(i): NEXT i
OPEN "c:\MWAGE.txt" FOR INPUT AS #5: FOR i = 1 TO mm: INPUT #5, MWAGE(i): MWAGE(i) = MWAGE(i) / 10000: NEXT i
OPEN "c:\LWAGE.txt" FOR INPUT AS #6: FOR i = 1 TO mm: INPUT #6, LWAGE(i): LWAGE(i) = LWAGE(i) / 10000: NEXT i
OPEN "c:\MNENKIN.txt" FOR INPUT AS #7: FOR i = 1 TO mm: INPUT #7, MNENKIN(i): MNENKIN(i) = MNENKIN(i) / 10000: NEXT i
OPEN "c:\LNENKIN.txt" FOR INPUT AS #8: FOR i = 1 TO mm: INPUT #8, LNENKIN(i): LNENKIN(i) = LNENKIN(i) / 10000: NEXT i
FOR i = 1 TO mm
  mwage2(i) = MWAGE(i) * 1.01: lwage2(i) = LWAGE(i) * 1.01
  MNENKIN2(i) = MNENKIN(i) * 1.01: LNENKIN2(i) = LNENKIN(i) * 1.01
NEXT i
OPEN "c:\MSHAHO.txt" FOR INPUT AS #9:FOR i=1 TO mm: INPUT #9, MSHAHO(i): MSHAHO(i) =MSHAHO(i)/10000: NEXT i
OPEN "c:\LSHAHO.txt" FOR INPUT AS #10: FOR i=1 TO mm: INPUT #10, LSHAHO(i): LSHAHO(i) =LSHAHO(i)/10000: NEXT i
OPEN "c:\SONPO.txt" FOR INPUT AS #11:FOR i=1 TO mm: INPUT #11, SONPO(i): SONPO(i)=SONPO(i)/10000: NEXT i
OPEN "c:\SEIHO.txt" FOR INPUT AS #12:FOR i=1 TO mm: INPUT #12, SEIHO(i): SEIHO(i)= SEIHO(i)/10000: NEXT i:CLOSE
total5 = 0:total52 = 0
FOR i = 1 TO mm
  w = LWAGE(i)
  CALL LTAX5(i, w, ITAXL5(i), LTAXL5(i))
  w = MWAGE(i): m = KODOMO(i)
  CALL Mtax5(i, w, ITAXM5(i), LTAXM5(i), m)
  TAX5(i) = ITAXM5(i) + LTAXM5(i) + ITAXL5(i) + LTAXL5(i)
  total5 = total5 + TAX5(i)  :  w = lwage2(i)
  CALL LTAX5(i, w, ITAXL52(i), ltaxl52(i))
  w = mwage2(i):  m = KODOMO(i)
  CALL Mtax5(i, w, ITAXM52(i), ltaxm52(i), m)
  tax52(i) = ITAXM52(i) + ltaxm52(i) + ITAXL52(i) + ltaxl52(i)
  total52 = total52 + tax52(i)
NEXT i
PRINT ((total52 - total5) / total5) / .01
END
    '----------------INCOME TAX DATA----------------------------------
WAGE.RATE55:
    DATA 0.4,0.3,0.2,0.10,0.05
WAGE.BRA59:
    DATA 0,165,330,600,1000,10000000000
WAGE.BRA7:
    DATA 0,180,360,660,1000,10000000000
PREM.RATE59:
    DATA 0.07,0.02
PREM.BRA59:
    DATA 0,500,100000000000000
TAX.RATE6:
   DATA 0.10,0.20,0.30,0.40,0.50
INCOME.BRA6:
   DATA 0,300,600,1000,2000,1000000000
INCOME.BRA7:
   DATA 0,330,900,1800,3000,1000000000
KTAX.RATE6:
   DATA 0.02,0.04
KINCOME.BRA6:
   DATA 0,550,1000000
KINCOME.BRA7:
   DATA 0,700,1000000
CTAX.RATE6:
   DATA 0.03,0.08,0.11
CINCOME.BRA6:
   DATA 0,160,550,10000000000
CINCOME.BRA7:
   DATA 0,200,700,10000000000
SUB KYUYO.49 (WAGE, income, WB(), WR(), II, LKY)
TT = 0
FOR i = 1 TO II
  IF WAGE>WB(i) AND WAGE<=WB(i+1) THEN WAGE.DEDUCTION=TT+(WAGE-WB(i))*WR(i)
     TT = TT + (WB(i + 1) - WB(i)) * WR(i)
NEXT i
IF WAGE.DEDUCTION < LKY THEN WAGE.DEDUCTION = LKY
income = WAGE - WAGE.DEDUCTION: IF income < 0 THEN income = 0
END SUB
SUB LTAX5 (III, WAGE, tax, LTAX)
DIM SB(14), SR(13), A(20), T(20), WB(20), WR(20), KB(20), KR(20), CB(20), CR(20)
jj = III:n = 5: NN = 2: CC = 3: KK = 2: II = 5
RESTORE INCOME.BRA6: FOR i = 1 TO n + 1: READ A(i): NEXT i
RESTORE TAX.RATE6: FOR i = 1 TO n: READ T(i): NEXT i
RESTORE CINCOME.BRA6: FOR i = 1 TO CC + 1: READ CB(i): NEXT i
RESTORE CTAX.RATE6: FOR i = 1 TO CC: READ CR(i): NEXT i
RESTORE KINCOME.BRA6: FOR i = 1 TO KK + 1: READ KB(i): NEXT i
RESTORE KTAX.RATE6: FOR i = 1 TO KK: READ KR(i): NEXT i
RESTORE WAGE.BRA59: FOR i = 1 TO II + 1: READ WB(i): NEXT i
RESTORE WAGE.RATE55: FOR i = 1 TO II: READ WR(i): NEXT i
GENZEI = 0:GENZEIL = 0:LKY = 65:teigaku = 0:NDED = 0:LROUNEN = 0:ROUNEN = 0
nincome = 0:ROUHAI = 0:LROUHAI = 0:income = 0:HAITOKU = 0
CALL KYUYO.49(WAGE, income, WB(), WR(), II, LKY)
IF LNENKIN(jj) > 0 THEN
    teigaku = 100
    IF age(jj) < 65 THEN teigaku = 50
    nincome = MNENKIN(jj) - teigaku
    IF nincome < 0 THEN nincome = 0
    IF nincome <= 360 THEN NDED = nincome * .25
    IF 360 < nincome AND nincome <= 720 THEN NDED = 360 * .25 + (nincome - 360) * .15
    IF 720 < nincome THEN NDED = 360 * .25 + (720 - 360) * .15 + (nincome - 720) * .05
    NDED = NDED + teigaku
    IF NDED < 140 THEN NDED = 140
    IF age(jj) < 65 THEN NDED = 70
    nincome = LNENKIN(jj) - NDED
    IF nincome < 0 THEN nincome = 0
    income = income + nincome
END IF
incomel(jj)=income:KISO=38:DEDUCTION=KISO+LSHAHO(jj):taxbase=income-DEDUCTION
CALL TAXRATE(n, taxbase, tax, A(), T())
KISO=33:LDEDUCTION=KISO+LSHAHO(jj):LBASE=income-LDEDUCTION
CALL TAXRATE(CC, LBASE, CTAX, CB(), CR())
CALL TAXRATE(KK, LBASE, PTAX, KB(), KR())
LTAX = CTAX + PTAX
END SUB
SUB LTAX9 (III, WAGE, tax, LTAX)
DIM SB(14), SR(13), A(20), T(20), WB(20), WR(20), KB(20), KR(20), CB(20), CR(20)
jj = III:n = 5: NN = 2: CC = 3: KK = 2: II = 5
RESTORE INCOME.BRA7: FOR i = 1 TO n + 1: READ A(i): NEXT i
RESTORE TAX.RATE6: FOR i = 1 TO n: READ T(i): NEXT i
RESTORE CINCOME.BRA7: FOR i = 1 TO CC + 1: READ CB(i): NEXT i
RESTORE CTAX.RATE6: FOR i = 1 TO CC: READ CR(i): NEXT i
RESTORE KINCOME.BRA7: FOR i = 1 TO KK + 1: READ KB(i): NEXT i
RESTORE KTAX.RATE6: FOR i = 1 TO KK: READ KR(i): NEXT i
RESTORE WAGE.BRA7: FOR i = 1 TO II + 1: READ WB(i): NEXT i
RESTORE WAGE.RATE55: FOR i = 1 TO II: READ WR(i): NEXT i
GENZEI = 0:GENZEIL = 0:LKY = 65:teigaku = 0:NDED = 0:LROUNEN=0:ROUNEN = 0
nincome = 0:ROUHAI = 0:LROUHAI = 0:income = 0:HAITOKU = 0
CALL KYUYO.49(WAGE, income, WB(), WR(), II, LKY)
IF LNENKIN(jj) > 0 THEN
    teigaku = 100
    IF age(jj) < 65 THEN teigaku = 50
    nincome = MNENKIN(jj) - teigaku
    IF nincome < 0 THEN nincome = 0
    IF nincome <= 360 THEN NDED = nincome * .25
    IF 360 < nincome AND nincome <= 720 THEN NDED = 360 * .25 + (nincome - 360) * .15
    IF 720 < nincome THEN NDED = 360 * .25 + (720 - 360) * .15 + (nincome - 720) * .05
    NDED = NDED + teigaku
    IF NDED < 140 THEN NDED = 140
    IF age(jj) < 65 THEN NDED = 70
    nincome = LNENKIN(jj) - NDED
    IF nincome < 0 THEN nincome = 0
    income = income + nincome
END IF
incomel(jj)=income:KISO=38:DEDUCTION=KISO+LSHAHO(jj):taxbase=income-DEDUCTION
CALL TAXRATE(n, taxbase, tax, A(), T())
KISO = 33:LDEDUCTION = KISO + LSHAHO(jj):LBASE = income - LDEDUCTION
CALL TAXRATE(CC, LBASE, CTAX, CB(), CR())
CALL TAXRATE(KK, LBASE, PTAX, KB(), KR())
LTAX = CTAX + PTAX
END SUB
SUB Mtax5 (III, WAGE, tax, LTAX, MEN)
DIM SB(14), SR(13), A(20), T(20), PB(15), PR(15),WB(20), WR(20), KB(20), KR(20), CB(20), CR(20)
jj = III:n = 5: NN = 2: CC = 3: KK = 2: II = 5
RESTORE INCOME.BRA6: FOR i = 1 TO n + 1: READ A(i): NEXT i
RESTORE TAX.RATE6: FOR i = 1 TO n: READ T(i): NEXT i
RESTORE CINCOME.BRA6: FOR i = 1 TO CC + 1: READ CB(i): NEXT i
RESTORE CTAX.RATE6: FOR i = 1 TO CC: READ CR(i): NEXT i
RESTORE KINCOME.BRA6: FOR i = 1 TO KK + 1: READ KB(i): NEXT i
RESTORE KTAX.RATE6: FOR i = 1 TO KK: READ KR(i): NEXT i
RESTORE WAGE.BRA59: FOR i = 1 TO II + 1: READ WB(i): NEXT i
RESTORE WAGE.RATE55: FOR i = 1 TO II: READ WR(i): NEXT i
GENZEI = 0:GENZEIL = 0:LKY = 65:teigaku = 0:NDED = 0:LROUNEN = 0:ROUNEN = 0
nincome = 0:ROUHAI = 0:LROUHAI = 0:income = 0:HAITOKU = 0
CALL KYUYO.49(WAGE, income, WB(), WR(), II, LKY)
IF MNENKIN(jj) > 0 THEN
    teigaku = 100
    IF age(jj) < 65 THEN teigaku = 0
    nincome = MNENKIN(jj) - teigaku: IF nincome < 0 THEN NIINCOME = 0
    IF nincome <= 360 THEN NDED = nincome * .25
    IF 360 < nincome AND nincome <= 720 THEN NDED = 360 * .25 + (nincome - 360) * .15
    IF 720 < nincome THEN NDED = 360 * .25 + (720 - 360) * .15 + (nincome - 720) * .05
    NDED = NDED + teigaku
    IF NDED < 140 THEN NDED = 140
    IF age(jj) < 65 THEN NDED = 70
    nincome = MNENKIN(jj) - NDED
    IF nincome < 0 THEN nincome = 0
    income = income + nincome
END IF
 IF MEN < 0 THEN MEN = 0
 KISO = 38: HAIGU = 38: HAITOKU = 38: FUYOU = 38 * MEN
 IF age(jj) >= 65 AND income <= 1000 THEN ROUNEN = 50
 IF age(jj) >= 75 THEN ROUHAI = 10
IF 40 <= incomel(jj) AND incomel(jj) < 45 THEN HAIGU = 36
IF 45 <= incomel(jj) AND incomel(jj) < 50 THEN HAIGU = 31
IF 50 <= incomel(jj) AND incomel(jj) < 55 THEN HAIGU = 26
IF 55 <= incomel(jj) AND incomel(jj) < 60 THEN HAIGU = 21
IF 60 <= incomel(jj) AND incomel(jj) < 65 THEN HAIGU = 16
IF 65 <= incomel(jj) AND incomel(jj) < 70 THEN HAIGU = 11
IF 70 <= incomel(jj) AND incomel(jj) < 60 THEN HAIGU = 6
IF 75 <= incomel(jj) AND incomel(jj) < 65 THEN HAIGU = 3
IF 76 <= incomel(jj) THEN HAIGU = 0
IF incomel(jj) > 0 THEN
   HAITOKU = HAITOKU - incomel(jj)
   IF HAITOKU < 0 THEN HAITOKU = 0
   BAIRITU=incomel(jj)/5:SEISUBAI = INT(BAIRITU):HAITOKU=38-SEISUBAI*5
   IF HAITOKU < 0 THEN HAITOKU = 0
END IF
IF income <= 1000 THEN HAITOKU = 0
IF EDU(jj) = 1 THEN FUYOU = FUYOU + 15
IF EDU(jj) = 2 THEN FUYOU = FUYOU + 30
 SEIHO = SEIHO(jj)
 IF 2.5 < SEIHO AND SEIHO < 5 THEN SEIHO = 2.5 + (SEIHO - 2.5) * .5
 IF 5 < SEIHO AND SEIHO < 10 THEN SEIHO = 2.5 + 2.5 * .5 + (SEIHO - 5) * .25
 IF SEIHO > 5 THEN SEIHO = 5
 SONPO = SONPO(jj)
 IF 1 < SONPO AND SONPO <= 2 THEN SONPO = 1 + (SONPO - 1) * .5
 IF SONPO > 2 THEN SONPO = 1.5
 DEDUCTION=KISO+HAIGU+HAITOKU+MSHAHO(jj)+FUYOU+SEIHO+SONPO+ROUNEN
           +ROUHAI
 taxbase = income - DEDUCTION
CALL TAXRATE(n, taxbase, tax, A(), T())
KISO = 33: HAIGU = 33: HAITOKU = 33: FUYOU = 33 * MEN
IF age(jj) >= 65 AND income <= 1000 THEN LROUNEN = 48
IF age(jj) >= 75 THEN LROUHAI = 5
IF MEN = 0 THEN HAIGU = 0
IF incomel(jj) > 33 THEN HAIGU = 0
IF incomel(jj) > 10 THEN
   HAITOKU = HAITOKU - incomel(jj)
   IF HAITOKU < 0 THEN HAITOKU = 0
   BAIRITU=(incomel(jj)-10)/5:SEISUBAI = INT(BAIRITU):HAITOKU=33-SEISUBAI*5
   IF HAITOKU < 0 THEN HAITOKU = 0
END IF
IF income <= 1000 THEN HAITOKU = 0
IF EDU(jj) > 0 THEN FUYOU = FUYOU + 15
IF EDU(jj) > 0 THEN FUYOU = FUYOU + 30
LDEDUCTION=KISO+HAIGU+HAITOKU+MSHAHO(jj)+FUYOU+SEIHO+SONPO+LROUNEN
           +LROUHAI
LBASE = income - LDEDUCTION
CALL TAXRATE(CC, LBASE, CTAX, CB(), CR())
CALL TAXRATE(KK, LBASE, PTAX, KB(), KR())
LTAX = CTAX + PTAX
END SUB
SUB Mtax9 (III, WAGE, tax, LTAX, MEN)
DIM SB(14), SR(13), A(20), T(20), PB(15), PR(15),WB(20), WR(20), KB(20), KR(20), CB(20), CR(20)
jj = III:n = 5: NN = 2: CC = 3: KK = 2: II = 5
RESTORE INCOME.BRA7: FOR i = 1 TO n + 1: READ A(i): NEXT i
RESTORE TAX.RATE6: FOR i = 1 TO n: READ T(i): NEXT i
RESTORE CINCOME.BRA7: FOR i = 1 TO CC + 1: READ CB(i): NEXT i
RESTORE CTAX.RATE6: FOR i = 1 TO CC: READ CR(i): NEXT i
RESTORE KINCOME.BRA7: FOR i = 1 TO KK + 1: READ KB(i): NEXT i
RESTORE KTAX.RATE6: FOR i = 1 TO KK: READ KR(i): NEXT i
RESTORE WAGE.BRA7: FOR i = 1 TO II + 1: READ WB(i): NEXT i
RESTORE WAGE.RATE55: FOR i = 1 TO II: READ WR(i): NEXT i
GENZEI = 0:GENZEIL = 0:LKY = 65:teigaku = 0:NDED = 0:LROUNEN = 0:ROUNEN = 0
nincome = 0:ROUHAI = 0:LROUHAI = 0:income = 0:HAITOKU = 0
CALL KYUYO.49(WAGE, income, WB(), WR(), II, LKY)
IF MNENKIN(jj) > 0 THEN
    teigaku = 100
    IF age(jj) < 65 THEN teigaku = 0
    nincome=MNENKIN(jj)-teigaku: IF nincome < 0 THEN NIINCOME = 0
    IF nincome<= 360 THEN NDED=nincome* .25
    IF 360 < nincome AND nincome <= 720 THEN NDED = 360 * .25 + (nincome - 360) * .15
    IF 720 < nincome THEN NDED = 360 * .25 + (720 - 360) * .15 + (nincome - 720) * .05
    NDED = NDED + teigaku
    IF NDED < 140 THEN NDED = 140
    IF age(jj) < 65 THEN NDED = 70
    nincome = MNENKIN(jj) - NDED
    IF nincome < 0 THEN nincome = 0
    income = income + nincome
END IF
 IF MEN < 0 THEN MEN = 0
 KISO = 38: HAIGU = 38: HAITOKU = 38: FUYOU = 38 * MEN
 IF age(jj) >= 65 AND income <= 1000 THEN ROUNEN = 50
 IF age(jj) >= 75 THEN ROUHAI = 10
IF 40 <= incomel(jj) AND incomel(jj) < 45 THEN HAIGU = 36
IF 45 <= incomel(jj) AND incomel(jj) < 50 THEN HAIGU = 31
IF 50 <= incomel(jj) AND incomel(jj) < 55 THEN HAIGU = 26
IF 55 <= incomel(jj) AND incomel(jj) < 60 THEN HAIGU = 21
IF 60 <= incomel(jj) AND incomel(jj) < 65 THEN HAIGU = 16
IF 65 <= incomel(jj) AND incomel(jj) < 70 THEN HAIGU = 11
IF 70 <= incomel(jj) AND incomel(jj) < 60 THEN HAIGU = 6
IF 75 <= incomel(jj) AND incomel(jj) < 65 THEN HAIGU = 3
IF 76 <= incomel(jj) THEN HAIGU = 0
IF incomel(jj) > 0 THEN
   HAITOKU = HAITOKU - incomel(jj)
   IF HAITOKU < 0 THEN HAITOKU = 0
   BAIRITU = incomel(jj) / 5: SEISUBAI = INT(BAIRITU):HAITOKU = 38 - SEISUBAI * 5
   IF HAITOKU < 0 THEN HAITOKU = 0
END IF
IF income <= 1000 THEN HAITOKU = 0
IF EDU(jj) = 1 THEN FUYOU = FUYOU + 15
IF EDU(jj) = 2 THEN FUYOU = FUYOU + 30
 SEIHO = SEIHO(jj)
 IF 2.5 < SEIHO AND SEIHO < 5 THEN SEIHO = 2.5 + (SEIHO - 2.5) * .5
 IF 5 < SEIHO AND SEIHO < 10 THEN SEIHO = 2.5 + 2.5 * .5 + (SEIHO - 5) * .25
 IF SEIHO > 5 THEN SEIHO = 5
 SONPO = SONPO(jj)
 IF 1 < SONPO AND SONPO <= 2 THEN SONPO = 1 + (SONPO - 1) * .5
 IF SONPO > 2 THEN SONPO = 1.5
 DEDUCTION = KISO + HAIGU + HAITOKU + MSHAHO(jj) + FUYOU + SEIHO + SONPO + ROUNEN + ROUHAI
 taxbase = income - DEDUCTION
CALL TAXRATE(n, taxbase, tax, A(), T())
KISO = 33: HAIGU = 33: HAITOKU = 33: FUYOU = 33 * MEN
IF age(jj) >= 65 AND income <= 1000 THEN LROUNEN = 48
IF age(jj) >= 75 THEN LROUHAI = 5
IF MEN = 0 THEN HAIGU = 0
IF incomel(jj) > 33 THEN HAIGU = 0
IF incomel(jj) > 10 THEN
   HAITOKU = HAITOKU - incomel(jj)
   IF HAITOKU < 0 THEN HAITOKU = 0
   BAIRITU = (incomel(jj) - 10) / 5: SEISUBAI = INT(BAIRITU):HAITOKU = 33 - SEISUBAI * 5
   IF HAITOKU < 0 THEN HAITOKU = 0
END IF
IF income <= 1000 THEN HAITOKU = 0
IF EDU(jj) > 0 THEN FUYOU = FUYOU + 15
IF EDU(jj) > 0 THEN FUYOU = FUYOU + 30
LDEDUCTION = KISO + HAIGU + HAITOKU + MSHAHO(jj) + FUYOU + SEIHO + SONPO + LROUNEN + LROUHAI
LBASE = income - LDEDUCTION
CALL TAXRATE(CC, LBASE, CTAX, CB(), CR())
CALL TAXRATE(KK, LBASE, PTAX, KB(), KR())
LTAX = CTAX + PTAX
END SUB
SUB TAXRATE (n, taxbase, tax, A(), T())
T = 0: tax = 0: IF taxbase <= 0 THEN taxbase = 0
FOR i = 1 TO n
  IF taxbase>A(i) AND taxbase<=A(i+1) THEN tax=T+(taxbase-A(i))*T(i): MT=T(i)
  T=T+(A(i+1)-A(i))*T(i)
NEXT i
IF tax < 0 THEN tax = 0
END SUB