01 将来推計人口 - プログラム倉庫

Function pop(year As Single, m, f) As Single
Dim p1 As Single
p1 = 0
For age = 0 To 99
p1 = p1 + m(year, age) + f(year, age)
Next
pop = Int(p1)
End Function
Private Sub Command1_Click()
Dim m(-5 To 99, 0 To 99) As Single
Dim f(-5 To 99, 0 To 99) As Single
Dim de(1 To 2, -5 To 99, 0 To 99) As Single
Dim sde(0 To 99) As Single
Dim mde(0 To 99) As Single
Dim birth(-5 To 99, 15 To 49) As Single
Dim year As Single
Dim age As Single
Dim z1 As Single
Dim a1 As Single
Dim a2 As Single
Open "c:/simple/data/1995年人口.txt" For Input As #12
Do Until EOF(12)
Input #12, x, y, z
age = x
m(-5, age) = y / 10
f(-5, age) = z / 10
Loop
Close #12
Open "c:/simple/data/男性死亡.txt" For Input As #1
Do Until EOF(1)
Input #1, a1, a2, a3
age = a1
sde(age) = a2
mde(age) = a3
Loop
Close #1
For year = 0 To 50
For age = 0 To 99
de(1, year, age) = sde(age) + year * (mde(age) - sde(age)) / 50
Next
Next
For year = -5 To 0
For age = 0 To 99
de(1, year, age) = sde(age)
Next
Next
For year = 51 To 99
For age = 0 To 99
de(1, year, age) = mde(age)
Next
Next
Open "c:/simple/data/女性死亡.txt" For Input As #3
Do Until EOF(3)
Input #3, a1, a2, a3
age = a1
sde(age) = a2
mde(age) = a3
Loop
Close #3
For year = 0 To 50
For age = 0 To 99
de(2, year, age) = sde(age) + year * (mde(age) - sde(age)) / 50
Next
Next
For year = -5 To 0
For age = 0 To 99
de(2, year, age) = sde(age)
Next
Next
For year = 51 To 99
For age = 0 To 99
de(2, year, age) = mde(age)
Next
Next
Dim bb(15 To 49) As Single
Dim cc(15 To 49) As Single
Dim dd(15 To 49) As Single
Dim y1 As Single
Dim y2 As Single
Open "c:/simple/data/出生率.txt" For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3, a4
age = a1
bb(age) = a2
cc(age) = a3
dd(age) = a4
Loop
Close #2
For year = -5 To 99
For age = 15 To 49
y1 = year / 25
If y1 < 0 Then y1 = 0
y2 = (year - 25) / 25
If y2 > 1 Then y2 = 1
If year < 26 Then birth(year, age) = bb(age) + y1 * (cc(age) - bb(age))
If year > 25 Then birth(year, age) = cc(age) + y2 * (dd(age) - cc(age))
Next
Next
year = -5
z1 = 0
For age = 15 To 49
z1 = z1 + birth(year, age) * f(year, age)
Next
m(year, 0) = 1.05 * z1 / 2.05
f(year, 0) = z1 / 2.05
For year = -4 To 99
For age = 1 To 99
m(year, age) = (1 - de(1, year - 1, age - 1)) * m(year - 1, age - 1)
f(year, age) = (1 - de(2, year - 1, age - 1)) * f(year - 1, age - 1)
Next
z1 = 0
For age = 15 To 49
z1 = z1 + birth(year, age) * f(year, age)
Next
m(year, 0) = 1.05 * z1 / 2.05
f(year, 0) = z1 / 2.05
Next
Dim q(0 To 100) As Single
Dim q1(0 To 100) As Single
Dim q2(0 To 100) As Single
Dim q3(0 To 100) As Single
Dim p1(0 To 100) As Single
Dim p2(0 To 100) As Single
Dim p3(0 To 100) As Single
Dim r1(0 To 100) As Single
Dim r2(0 To 100) As Single
Dim r3(0 To 100) As Single
Open "c:/simple/data/将来推計.txt" For Input As #12
Do Until EOF(12)
Input #12, a1, a2, a3, a4, a5
year = a1
q(year) = a2
q1(year) = a3
q2(year) = a4
q3(year) = a5
Loop
Close #12
For year = 0 To 99
p1(year) = 0
For age = 0 To 15
p1(year) = p1(year) + m(year, age) + f(year, age)
Next
p2(year) = 0
For age = 16 To 64
p2(year) = p2(year) + m(year, age) + f(year, age)
Next
p3(year) = 0
For age = 65 To 99
p3(year) = p3(year) + m(year, age) + f(year, age)
Next
Next
For year = 0 To 99
r1(year) = 0.1 * q1(year) / p1(year)
r2(year) = 0.1 * q2(year) / p2(year)
r3(year) = 0.1 * q3(year) / p3(year)
Next
For year = 0 To 99
For age = 0 To 15
m(year, age) = r1(year) * m(year, age)
f(year, age) = r1(year) * f(year, age)
Next
For age = 16 To 64
m(year, age) = r2(year) * m(year, age)
f(year, age) = r2(year) * f(year, age)
Next
For age = 65 To 99
m(year, age) = r3(year) * m(year, age)
f(year, age) = r3(year) * f(year, age)
Next
Next
Open "c:/simple/gdata/将来推計人口.txt" For Output As #11
For year = -5 To 99
For age = 0 To 99
Write #11, year, age, m(year, age), f(year, age)
Next
Next
Close #11
For n = 1 To 5
year = 5 * n
Debug.Print year, pop(year, m, f)
Next
For n = 3 To 5
year = 10 * n
Debug.Print year, pop(year, m, f)
Next
End Sub