a02_Economics_2; a01_Economics_2.bas
Attribute VB_Name = "a02_Economics_2"
Option Explicit
' -- Global variables below calculated in Call Calculate_Deltal
Public dtalip(50 To 106) As Double
Public dtalpp(50 To 106) As Double
Public explife(50 To 106) As Double
Public Arvsvinstfaktor(0 To 106) As Double
'This variable is used to generate sigma_my from Init-module. It is redimensioned _
too zero when not needed anymore.
Public randomValues() As Single
Public helpArrayRandomValues() As Single
Public lnesumma As Double
Public estlnesumma As Double
Public numberofln As Long
Public Sub new_economy_2()
'! Calculate various income for different status
Dim i As Long
Dim grund_niv As Double
Dim max_niv As Long
Dim ak_min As Double
Dim ak_max As Double
Dim ak_lev As Double
Dim ak_sjuk As Double
Dim dagers As Long
Dim ZTAK As Double
Dim CSGIMA As Double
Dim DPLA As Long
Dim inc_sickness As Long
status "Economy 2"
Printdok "new_economy_2"
'-- Initialization of pension parameters and macrodata
Call Calculate_Deltal(m_ap_norm, 1 + ((m_interest_long / 100) - m_favg_pp))
m_dtalip_65 = dtalip(65) '-- For reporting
m_dtalpp_65 = dtalpp(65) '-- For reporting
m_arvsvinst_60 = Arvsvinstfaktor(60) '-- For reporting
'*** Update h_max_inc_taxable and h_sum_inc_taxable
ReDim h_max_inc_taxable(1 To m_hcount)
ReDim h_sum_inc_taxable(1 To m_hcount)
Printdok " -- i loop in new_economy_2: Update_Survivors_pension"
Printdok " -- i loop in new_economy_2: Calculate_Occupational_pension_benefits"
Printdok " -- i loop in new_economy_2: Calculate_Public_Pension_Benefits"
Printdok " -- i loop in new_economy_2: Calculate_Disability_Pension"
For i = 1 To m_icount
' -- Updating survivors pension (Note: All individualls in all status)
Call Update_Survivors_pension(i)
i_inc_earning(i) = 0
i_inc_selfemployed(i) = 0
i_inc_taxable(i) = 0
i_inc_taxed(i) = 0
i_inc_market(i) = 0
i_inc_work(i) = 0
i_trf_parentleave(i) = 0
i_trf_unemployed(i) = 0
i_trf_pension(i) = 0
i_trf_sickleave(i) = 0
i_income(i) = income_2(i) * m_wage_change99
Select Case i_status(i)
'*** Children have no income
'Case 1
'*** Retired
Case 2
'Call Calculate_Occupational_pension_benefits(i)
'-- Private pension payout time
If i_status1(i) <> 2 And i_wealth_pension_total(i) > 0 Then
If Rnd > 0.7 Or i_wealth_pension_total(i) > 20 * m_basbelopp_income Then
i_pp_payout_time(i) = -99 '-- Annuity
Else
i_pp_payout_time(i) = 5 '-- Fixed 5 year period
End If
End If
i_trf_pension(i) = f_Public_Pension_Benefits(i) + _
f_Private_Pension_Benefits(i, i_pp_payout_time(i)) + _
f_Occupational_pension_benefits(i)
'*** Students
Case 3
i_inc_earning(i) = f_income_students(i)
i_inc_earning(i) = i_inc_earning(i) * m_wage_change99
i_income(i) = i_inc_earning(i) ' For calculation of sickness benefits
'-- Study grants and loans calculated i a05_Rules
'*** Disabled
Case 4
Call Calculate_Disability_Pension(i)
i_trf_pension(i) = i_ftp(i)
' Parental leave (only women) lneindexerat tak och grundniv
Case 5
Select Case (base_year + model_time)
Case Is < 2002
grund_niv = 60 * 365
max_niv = 7.5 * m_basbelopp
Case 2002
grund_niv = 120# * 365#
max_niv = 7.5 * m_basbelopp
Case 2003
grund_niv = 150# * 365#
max_niv = 7.5 * m_basbelopp
Case 2004
grund_niv = 180# * 365#
max_niv = 7.5 * m_basbelopp
Case 2005
grund_niv = 180# * 365#
max_niv = 7.5 * m_basbelopp
Case 2006
grund_niv = 180# * 365#
max_niv = m_basbelopp * (7.5 + 10) / 2
Case 2007
grund_niv = 180# * 365#
max_niv = m_basbelopp * 10
Case 2008
grund_niv = 180# * 365#
max_niv = m_basbelopp * 10
Case Else
grund_niv = 180# * 365# * m_wage_change09
max_niv = 10 * m_basbelopp * m_realwage_change09
End Select
i_trf_parentleave(i) = maxi(0.8 * mini(i_income(i), max_niv), grund_niv)
'*** Unemployed (100 dagar med frhjd ersttning fr.o.m. 2001 => 164 med lgre)
'*** 070301 Antar att perioderna infaller s att 80 dagar fr hgre ersttning (fr 2003)
'*** 070301 Antar att perioderna 2007 => infaller s att 164 dagar fr hgre ersttning (fr 2003)
'*** 070319 Implemmenterar 5 karensdagar (rtt alshet men fr hga utbetalningar tidigare)
Case 6
Select Case (base_year + model_time)
Case Is < 2001
ak_min = 240
ak_max = 580
ak_lev = 80
Case 2001
ak_min = (240 + 270) / 2
ak_max = (100# * (580 + 50) + 164# * 580) / 264
ak_lev = 80
Case 2002
ak_min = (270 + 320) / 2
ak_max = (100# * ((580 + 680) / 2 + 75) + 164# * (580 + 680) / 2) / 264 'Ger 658 i snitt
ak_lev = 80
Case 2003
ak_min = 320
'ak_max = (100# * (680 + 50) + 164# * 680#) / 264
ak_max = (80# * (680 + 50) + 184# * 680#) / 264
ak_lev = 80
Case 2004
ak_min = 320
'ak_max = (100# * (680 + 50) + 164# * 680#) / 264
ak_max = (80# * (680 + 50) + 184# * 680#) / 264
ak_lev = 80
Case 2005
ak_min = 320
'ak_max = (100# * (680 + 50) + 164# * 680) / 264
ak_max = (80# * (680 + 50) + 184# * 680) / 264
ak_lev = 80
Case 2006
ak_min = 320
'ak_max = (100# * (680 + 50) + 164# * 680) / 264
ak_max = (80# * (680 + 50) + 184# * 680) / 264
ak_lev = 80
Case 2007
ak_min = 320
ak_max = 680
'ak_lev = (200# * 80 + 64# * 70) / 264
ak_lev = (164# * 80 + 100# * 70) / 264
Case 2008
ak_min = 320
ak_max = 680
'ak_lev = (200# * 80 + 64# * 70) / 264
ak_lev = (164# * 80 + 100# * 70) / 264
Case Else
ak_min = m_wage_change09 * 320
ak_max = m_wage_change09 * 680
'ak_lev = (200# * 80 + 64# * 70) / 264
ak_lev = (164# * 80 + 100# * 70) / 264
End Select
'*** Individuals that were not working the previo mg=qǨCrt )r}ǂ ^;Vsr)S+H|M|M?ϥ MIz͵zϱ{> ~ʼi)N:^ַNVW'c->J´ W:*Pkk<ޝ_t'>jWJm}O8gG#o}> ^ ƭ?כ}=7z5squIS :S 6m
i>~t{{}~>*]
wij ->~l ޏ?N_ O}/ mt(8_:nj_}: 1qu谽 ?ڽcN_Wq=GCVG ˥Ryn]6hot-NxT.sSM Mѫ߮igISiO/Z]z - I^5zfYUjhմ9ڤRS[VOR||Wu~?O6[٤ZJgSϭ kLtcoqk }߳ƟK䟪i FAN5)Z .ٴ~ Nm[qU
)
<
Ty WMm:mwVuc־|>s>-5iqOp^6ODVJ➾NãT:ƴˏӭ?}?I.# 'Jk~|lzSM1JZ wm?['M/j8}.?ߴ e|{8y΄ gѧO- cӆ+FSk/tSC뮯*}i7 5-NRx NM:´4<_qoi[*>ϪxZ pì}֙-kz?귫OMf5~~!VԮO?Ϡ7~ T |Rv o?U2tO]VZR) /^ϓu *kʹ ~)]G>.oR<_Kzͫ[Muj}GqS^Z:yR$_keժW/ tJįzg%V Uo}?T5|ZipSto /k c tҵ /O=k +HOo ~oaӥ'NJ fޛj}=W OIjt֍NSNէS}mz}ָ P.{ ^>.u^[i~ t^-ckMU~ VWu:ZZ+O.ʷ Swj|oK" §k 鸽߫ohgѧ?H%V>|~\|D^ZG[WN %4)OδsF<~t]Sh
&oV{~ _"Uty,^ o>-M^t|>: ss = i_inc_taxable4(i) * m_KPI3 * m_KPI2 * m_KPI1 * m_KPI
ElseIf i_inc_taxable5(i) > 0 Then
inc_sickness = i_inc_taxable5(i) * m_KPI4 * m_KPI3 * m_KPI2 * m_KPI1 * m_KPI
End If
End If
CSGIMA = mini(ZTAK, inc_sickness)
CSGIMA = Int(CSGIMA / 100) * 100
DPLA = round(CSGIMA / 365, 0)
'Maximal sjukpenning fr arbetslsa (521 frn FASIT)
If (base_year + model_time) > 2006 And i_status(i) = 6 Then
If (base_year + model_time) > 2008 Then
ak_sjuk = 521 * m_wage_change09
Else
ak_sjuk = 521
End If
DPLA = mini(DPLA, ak_sjuk)
End If
i_trf_sickleave(i) = 0.8 * DPLA * i_sickleave(i)
'Reduce other oncome sources
If i_status(i) = 6 Then
i_trf_unemployed(i) = i_trf_unemployed(i) * CDbl((365 - i_sickleave(i)) / 365)
Else
i_inc_vڭ3SM5 chSTH 5{Ea?G
DYYCcs0#K6$w7;jI)ZCWRqA:{dbda۫4G)c*V-!3LS%;` ) qvjyZiRT$AWFH xu;/6Xż[hf6Դ` T
u7TnwF7qn
FQ CQL2utTC,ā4# ?9s\eݦ ѓ$Q UQ3jbus>{%YnP\nr,6)Wa
3i->& \:*͑8xi%Mݗx*uutΓ*$xJ";[&v>_S]p BgQn=8 xҝBh + E#1a ? ml5 ;WCb iX:l| T[_Q7>&
\1+\dPq Zt/QU|l?aڸ|T.O)50Wdx @VHٝ 5m.J4jH Fb,id?#(ʿU48d a; _ghɻNZI%.Z=i)YIHZ>9&Hա JSU)SRi|Hvyz[Iw(, 'R+Y|t,F7RJ# R /U6 JdYeB$s\wHn`E22yPB)OQM`v>ᮥhk)j)e@&A X{C[ùY[7CQRH I6KU Bʇ}Xo]mV|te*`1
ՂU*hheE-uF6}P#5@\^lʹm- ʼn"T y
M jX犩E\$d .|-ή=)Qڧ
(R< z`?>{{$v
2UC$a2igOA%'bT7{Z frd+k+wc!S
3TTGHӳy z$}`au;5|)Um <1Xܳk[DJh0AHɦOWts. nzYd5$Xc_*+%݊#IU#Q9'b|-.4 ThGˮb>QE&ޭ6 %1eV
N>)~O ^+zV75EM XNS5BHL y5iS4 O>fۋ$gTF$`5hz? ;C|vޓ.%%/-vLI)-+èipyuktȺ0 Zj^hn㸘*}sx }zI]* ,M_x
W1*+Trm ׂHΊx9*+T^_feUil%e5d9 Q?[e14yҞ]ɚn9)2 ? `K9R={얪!ZRdž S w (K{;l=Q`c-J%eϮHf{ȫ[ $Q^ !ud\M4|
.wȜ/ju.>bf6tCM.Cr
i秢рZ Ȑ&"nsjvM:]sB8 yޮ, Bu5\#csa7}ѱ (qlwN8KZjmLUxI OqʐoU ksATH$Fn E'm%`LEH88'Ҽ
zzT}7RaT{uCZV.:O R)m F yEwP§H
} hU #Ν hfck&VJZ
z#ˮDgi1{6&7
ƬAI,eTTqϏ(~㪢r
7kX%kK(gW0K[SZϭ[$w3ZeҒM2+G$Қ}X/=KozkwFS./k RP<e,
à V s/
FȪBPQSAC-JM#n*
KAU0dˊb-|FӢJBYכA板n fF EET^9~] ns%
*4'3' s=UKUKMvE1IYG&x!A9iVtr\ wҚ♒ȨaQG]gEGjnVX֩MXULjö;ʾ mYZ<>%z MVY^YP6ied0V=٨-\%Οlyy%1}E,ZP+PΨ
TRJq#WWM$j
&`U 2*1O
Gpl@od#ZK
<
)!rKQN8=
霮fn)OcJz2\<ƕ2 Bw7RA }5<춇ThOiJ|yg{pk#C"9¿ U=ߺ=%-~w/TZ[d!8JG
X{
yu,WWY$qА<˩h۹{e#oBƫC,XI9''ϣ'ٙ
lӝ4)$8*4$UslQsjX"y֬I'}s[mO)u=T^=±p"}DfQP!}B҇~8ѹ
m@So
%LB҂q u- ៑IM"Hg[I )g}ok =iBlWwBǨQqLG*_'9RL x #ժ3:̿#V@!: 7 洂%}(xI p rD)8ɡ5kN.uFi(yT9y5zB%;ԢKm#+|ϟ]wxnCB@&1ybmduSA
HC1gP4)?CMs2\ -u W) ., G8;s ,Y5X$R֥=$m厒jyv "Lb5767m+ŃʛW!R*uH Nxc U%IaP>N x "zub5K^K).ueQ$
7B` -O<7579899119E-02 'i_utl
A(7) = -4.36206000847679E-02 'married
sigma2(2) = 0.02682
sigma2(1) = 0.1547
ElseIf i_sector(indnr) = 3 Then
A(0) = 11.6771408999701 'Intercept
A(1) = 0.332656432437577 'logexper
A(2) = -2.47945625697077E-04 'exper*exper
A(3) = -0.426130436409938 'edlevel
A(4) = -0.280437680243093 'edlevel
A(5) = 0 'edlevel
A(6) = 0.153197953573923 'i_utl
A(7) = -9.36089748676582E-02 'married
sigma2(2) = 0.01772
sigma2(1) = 0.1044
ElseIf i_sector(indnr) = 4 Then
A(0) = 11.6227251808724 'Intercept
A(1) = 0.331986024969171 'logexper
A(2) = -1.94574817613799E-04 'exper*exper
A(3) = -0.368664050302877 'edlevel
A(4) = -0.246837125705199 'edlevel
A(5) = 0 'edlevel
A(6) = 4.10362888796986E-02 'i_utl
A(7) = -0.078028035104495 'married
sigma2(2) = 0.01509
sigma2(1) = 0.1056
ElseIf i_sector(indnr) = 5 Then
A(0) = 11.4643628750955 'Intercept
A(1) = 0.163045778680347 'logexper
A(2) = -7.83805910743665E-05 'exper*exper
A(3) = -0.159510392272126 'edlevel
A(4) = -0.177135128276011 'edlevel
A(5) = 0 'edlevel
A(6) = 0.115360735707827 'i_utl
A(7) = -2.89881314265481E-02 'married
sigma2(2) = 0.0734
sigma2(1) = 0.1722
End If
Else 'women
If i_sector(indnr) = 1 Then
A(0) = 11.7135563027145 'Intercept
A(1) = 0.179023912624595 'logexper
A(2) = -1.58088118540697E-04 'exper*exper
A(3) = -0.190732192352126 'edlevel
A(4) = -0.122769293982469 'edlevel
A(5) = 0 'edlevel
A(6) = 1.87928340799057E-02 'i_utl
A(7) = 7.14703927659912E-02 'married
sigma2(2) = 0.02141
sigma2(1) = 0.0947
ElseIf i_sector(indnr) = 2 Then
A(0) = 11.7506046838869 'Intercept
A(1) = 0.281746802974376 'logexper
A(2) = -2.31073863075992E-04 'exper*exper
A(3) = -0.230623042441484 'edlevel
A(4) = -0.186124677739101 'edlevel
A(5) = 0 'edlevel
A(6) = 3.08946972955787E-02 'i_utl
A(7) = 6.05374340922297E-02 'married
sigma2(2) = 0.01998
sigma2(1) = 0.1329
ElseIf i_sector(indnr) = 3 Then
A(0) = 11.6029610618491 'Intercept
A(1) = 0.29371315724384 'logexper
A(2) = -2.02871576362586E-04 'exper*exper
A(3) = -0.383098686186418 'edlevel
A(4) = -0.311289876499623 'edlevel
A(5) = 0 'edlevel
A(6) = 5.52759792603538E-02 'i_utl
A(7) = 3.35825104265398E-02 'married
sigma2(2) = 0.0142
sigma2(1) = 0.08753
ElseIf i_sector(indnr) = 4 Then
A(0) = 11.7521584694592 'Intercept
A(1) = 0.179954849192849 'logexper
A(2) = -9.20244147971622E-05 'exper*exper
A(3) = -0.413361465204372 'edlevel
A(4) = -0.309686640425149 'edlevel
A(5) = 0 'edlevel
A(6) = 5.82392836389083E-03 'i_utl
A(7) = 5.44157994862174E-02 'married
sigma2(2) = 0.01435
sigma2(1) = 0.0684
ElseIf i_sector(indnr) = 5 Then
A(0) = 11.3811656817494 'Intercept
A(1) = 0.28874864039624 'logexper
A(2) = -2.32129627897187E-04 'exper*exper
A(3) = -0.433722822184882 'edlevel
A(4) = -0.440843552447399 'edlevel
A(5) = 0 'edlevel
A(6) = -6.90441580515608E-02 'i_utl
A(7) = 0.188106463550689 'married
sigma2(2) = 0.05602
sigma2(1) = 0.1332
End If
End If
Dim v1 As Single
Dim v2 As Single
Dim v3 As Byte
Dim v4 As Byte
Dim v5 As Byte
Dim v6 As Byte
Dim v7 As Byte
Dim addExp As Integer
If i_born_year(indnr) < 1945 Then
addExp = maxi(0, 1960 - (i_born_year(indnr) + 15 + i_edyears(indnr)))
End If
v1 = pp_hist(indnr).n_years + addExp 'A measure of experience!
'*** TP 030218
'v1 = i_workexperience(indnr)
v2 = v1 ^ 2
v1 = Log(v1 + 1)
Dim edlevel As Byte
edlevel = i_edlevel(indnr)
If edlevel = 0 Then v3 = 1 Else v3 = 0
If edlevel = 1 Then v4 = 1 Else v4 = 0
If edlevel = 2 Then v5 = 1 Else v5 = 0
If i_born_abroad(indnr) = 1 Then v6 = 1 Else v6 = 0
If i_civ_stat(indnr) = 1 Then v7 = 1 Else v7 = 0
'If i_inc_ivariance(indnr) = 0 Then i_inc_ivariance(indnr) = gauss_2(0, Sqr(sigma2(1)), i_indnr(indnr))
If i_inc_ivariance(indnr) = 0 Then i_inc_ivariance(indnr) = gauss(0, Sqr(sigma2(1)))
'i_inc_ivariance(indnr) = gauss_2(0, Sqr(sigma_my), i_indnr(indnr))
i_inc_itvariance(indnr) = gauss(0, Sqr(sigma2(2)))
income_2 = Exp(A(0) + A(1) * v1 + A(2) * v2 + A(3) * v3 + A(4) * v4 + A(5) * v5 + A(6) * v6 + _
A(7) * v7 + i_inc_ivariance(indnr) + i_inc_itvariance(indnr))
' The code below was inactivated 050830 by TP
''---Denna korrigering genomfrs fr att f en inkomstprofil som mer
'' liknar data. Blockas ut om man vill lta ekvationen styra. FJ 040519
'If i_age(indnr) = 61 Then income_2 = income_2 * 0.95
'If i_age(indnr) = 62 Then income_2 = income_2 * 0.9
'If i_age(indnr) = 63 Then income_2 = income_2 * 0.85
'If i_age(indnr) = 64 Then income_2 = income_2 * 0.8
If income_2 < 0 Then
income_2 = 0
End If
End Function
Public Function sigma_my(indnr) As Double
Dim A(0 To 12) As Single
Dim sigma2(1 To 2) As Single 'sigma2(1)=individual variance, sigma2(2)=random variance
If i_sex(indnr) = 1 Then 'men
If i_sector(indnr) = 1 Then
A(0) = 11.73533504926 'Intercept
A(1) = 0.263057233554697 'logexper
A(2) = -2.23639669565676E-04 'exper*exper
A(3) = -0.20279259378039 'edlevel
A(4) = -0.158106672048782 'edlevel
A(5) = 0 'edlevel
A(6) = 7.90710119149498E-02 'i_utl
A(7) = -2.06839404016984E-03 'married
sigma2(2) = 0.02023
sigma2(1) = 0.07329
ElseIf i_sector(indnr) = 2 Then
A(0) = 11.7790542145704 'Intercept
A(1) = 0.38450342975739 'logexper
A(2) = -2.20101579096737E-04 'exper*exper
A(3) = -0.358845308029442 'edlevel
A(4) = -0.238421397551696 'edlevel
A(5) = 0 'edlevel
A(6) = 2.05017579899119E-02 'i_utl
A(7) = -4.36206000847679E-02 'married
sigma2(2) = 0.02682
sigma2(1) = 0.1547
ElseIf i_sector(indnr) = 3 Then
A(0) = 11.6771408999701 'Intercept
A(1) = 0.332656432437577 'logexper
A(2) = -2.47945625697077E-04 'exper*exper
A(3) = -0.426130436409938 'edlevel
A(4) = -0.280437680243093 'edlevel
A(5) = 0 'edlevel
A(6) = 0.153197953573923 'i_utl
A(7) = -9.36089748676582E-02 'married
sigma2(2) = 0.01772
sigma2(1) = 0.1044
ElseIf i_sector(indnr) = 4 Then
A(0) = 11.6227251808724 'Intercept
A(1) = 0.331986024969171 'logexper
A(2) = -1.94574817613799E-04 'exper*exper
A(3) = -0.368664050302877 'edlevel
A(4) = -0.246837125705199 'edlevel
A(5) = 0 'edlevel
A(6) = 4.10362888796986E-02 'i_utl
A(7) = -0.078028035104495 'married
sigma2(2) = 0.01509
sigma2(1) = 0.1056
ElseIf i_sector(indnr) = 5 Then
A(0) = 11.4643628750955 'Intercept
A(1) = 0.163045778680347 'logexper
A(2) = -7.83805910743665E-05 'exper*exper
A(3) = -0.159510392272126 'edlevel
A(4) = -0.177135128276011 'edlevel
A(5) = 0 'edlevel
A(6) = 0.115360735707827 'i_utl
A(7) = -2.89881314265481E-02 'married
sigma2(2) = 0.0734
sigma2(1) = 0.1722
End If
Else 'women
If i_sector(indnr) = 1 Then
A(0) = 11.7135563027145 'Intercept
A(1) = 0.179023912624595 'logexper
A(2) = -1.58088118540697E-04 'exper*exper
A(3) = -0.190732192352126 'edlevel
A(4) = -0.122769293982469 'edlevel
A(5) = 0 'edlevel
A(6) = 1.87928340799057E-02 'i_utl
A(7) = 7.14703927659912E-02 'married
sigma2(2) = 0.02141
sigma2(1) = 0.0947
ElseIf i_sector(indnr) = 2 Then
A(0) = 11.7506046838869 'Intercept
A(1) = 0.281746802974376 'logexper
A(2) = -2.31073863075992E-04 'exper*exper
A(3) = -0.230623042441484 'edlevel
A(4) = -0.186124677739101 'edlevel
A(5) = 0 'edlevel
A(6) = 3.08946972955787E-02 'i_utl
A(7) = 6.05374340922297E-02 'married
sigma2(2) = 0.01998
sigma2(1) = 0.1329
ElseIf i_sector(indnr) = 3 Then
A(0) = 11.6029610618491 'Intercept
A(1) = 0.29371315724384 'logexper
A(2) = -2.02871576362586E-04 'exper*exper
A(3) = -0.383098686186418 'edlevel
A(4) = -0.311289876499623 'edlevel
A(5) = 0 'edlevel
A(6) = 5.52759792603538E-02 'i_utl
A(7) = 3.35825104265398E-02 'married
sigma2(2) = 0.0142
sigma2(1) = 0.08753
ElseIf i_sector(indnr) = 4 Then
A(0) = 11.7521584694592 'Intercept
A(1) = 0.179954849192849 'logexper
A(2) = -9.20244147971622E-05 'exper*exper
A(3) = -0.413361465204372 'edlevel
A(4) = -0.309686640425149 'edlevel
A(5) = 0 'edlevel
A(6) = 5.82392836389083E-03 'i_utl
A(7) = 5.44157994862174E-02 'married
sigma2(2) = 0.01435
sigma2(1) = 0.0684
ElseIf i_sector(indnr) = 5 Then
A(0) = 11.3811656817494 'Intercept
A(1) = 0.28874864039624 'logexper
A(2) = -2.32129627897187E-04 'exper*exper
A(3) = -0.433722822184882 'edlevel
A(4) = -0.440843552447399 'edlevel
A(5) = 0 'edlevel
A(6) = -6.90441580515608E-02 'i_utl
A(7) = 0.188106463550689 'married
sigma2(2) = 0.05602
sigma2(1) = 0.1332
End If
End If
Dim v1 As Single
Dim v2 As Single
Dim v3 As Byte
Dim v4 As Byte
Dim v5 As Byte
Dim v6 As Byte
Dim v7 As Byte
Dim lincome As Double
'If i_inc_taxable(indnr) <= 0 Or (i_status(indnr) = 1 Or i_status(indnr) = 2 _
or i_status(indnr)=3 Or i_status(indnr) = 4 Or i_status(indnr) = 9) Then
'Denna definition innebr att alla som varit frldralediga arbetslsa eller ej i _
vrigt ges en helt ny ln. Om man r ambitis kan man g tillbaka och leta fram deras _
senaste ln frn arbete, men s har inte gjorts nu.
If i_status(indnr) <> 8 Or i_inc_taxable(indnr) <= 0 Or i_sector(indnr) = 0 Or (i_status(indnr) = 8 And i_inc_taxable(indnr) < 100000) Then
If i_sex(indnr) = 1 Then
If i_status(indnr) = 1 Then
sigma2(1) = 0.07329
ElseIf i_status(indnr) = 2 Then
sigma2(1) = 0.1547
ElseIf i_status(indnr) = 3 Then
sigma2(1) = 0.1044
ElseIf i_status(indnr) = 4 Then
sigma2(1) = 0.1056
ElseIf i_status(indnr) = 5 Then
sigma2(1) = 0.1722
End If
Else
If i_status(indnr) = 1 Then
sigma2(1) = 0.0947
ElseIf i_status(indnr) = 2 Then
sigma2(1) = 0.1329
ElseIf i_status(indnr) = 3 Then
sigma2(1) = 0.08753
ElseIf i_status(indnr) = 4 Then
sigma2(1) = 0.0684
ElseIf i_status(indnr) = 5 Then
sigma2(1) = 0.1332
End If
End If
' sigma2(1) = 0.077
sigma_my = gauss(0, Sqr(sigma2(1)))
Else
'*** TP 030218
'v1 = i_workexperience(indnr)
Dim addExp As Integer
If (base_year + model_time) - i_age(indnr) < 1945 Then
addExp = maxi(0, 1960 - ((base_year + model_time) - i_age(indnr) + 15 + i_edyears(indnr)))
End If
v1 = pp_hist(indnr).n_years + addExp 'A measure of experience!
v2 = v1 ^ 2
v1 = Log(v1 + 1)
Dim edlevel As Byte
edlevel = i_edlevel(indnr)
If edlevel = 0 Then v3 = 1 Else v3 = 0
If edlevel = 1 Then v4 = 1 Else v4 = 0
If edlevel = 2 Then v5 = 1 Else v5 = 0
If i_born_abroad(indnr) = 1 Then v6 = 1 Else v6 = 0
If i_civ_stat(indnr) = 1 Then v7 = 1 Else v7 = 0
lincome = Log(i_inc_taxable(indnr))
Dim sigma_tot As Single
sigma_tot = lincome - (A(0) + A(1) * v1 + A(2) * v2 + A(3) * v3 + A(4) * v4 + A(5) * v5 _
+ A(6) * v6 + A(7) * v7 + gauss(0, Sqr(sigma2(2))))
sigma_tot = round(sigma_tot, 3)
Dim binser As Long
binser = BinarySearch(helpArrayRandomValues, sigma_tot)
If binser <> 0 Then
sigma_my = randomValues(binser, 1)
Else
sigma_my = sigma_tot - gauss(0, Sqr(sigma2(2))) 'introduces a minor error
End If
End If
End Function
'************************************************************************************
'*** Function f_income_students() randomizes incomes for students.
'*** A two part model is used. First a logit model is used to predict the probability
'*** of positive income. At the second stage a regression model is used to predict
'*** the income for individuals that passes the first stage.
'*** For estimation code see folder S:\SESIM\Dokument\Dokumentation\_
'*** SESIM\Estimation\Income model\Income_ed_misc_
'*** estimate_incomes_misc_student_twopart.r
'************************************************************************************
Public Function f_income_students(idx) As Long
Dim prob As Double, rand() As Double
Dim xbeta1 As Double, xbeta2 As Double
Dim fi_sex2 As Byte, fi_bvux1 As Byte, fi_born_abroad1 As Byte, fi_civ_stat1 As Byte
Dim fi_edlevel1 As Byte, fi_edlevel2 As Byte
f_income_students = 0
If i_sex(idx) = 2 Then fi_sex2 = 1 Else fi_sex2 = 0
If i_bvux(idx) = 1 Then fi_bvux1 = 1 Else fi_bvux1 = 0
If i_born_abroad(idx) = 1 Then fi_born_abroad1 = 1 Else fi_born_abroad1 = 0
If i_civ_stat(idx) = 1 Then fi_civ_stat1 = 1 Else fi_civ_stat1 = 0
If i_edlevel(idx) = 1 Then fi_edlevel1 = 1 Else fi_edlevel1 = 0
If i_edlevel(idx) = 2 Then fi_edlevel2 = 1 Else fi_edlevel2 = 0
'*** Selection model (logit)
' Call:
' glm(formula = i_inc_earning > 0 ~ i_age + fi_sex + fi_bvux +
' fi_born_abroad + fi_civ_stat + fi_edlevel + i_age:fi_bvux +
' i_age:fi_born_abroad + i_age:fi_edlevel + fi_bvux:fi_edlevel +
' fi_born_abroad:fi_civ_stat, family = binomial, data = stud)
'
' deviance Residuals:
' Min 1Q Median 3Q Max
' -2.8176 -1.2389 0.5826 0.8873 1.4420
'
' Coefficients:
' Estimate Std. Error z value Pr(>|z|)
' (Intercept) -3.063949 0.286068 -10.711 < 2e-16 ***
' i_age 0.214717 0.016664 12.885 < 2e-16 ***
' fi_sex2 0.142866 0.034758 4.110 3.95e-05 ***
' fi_bvux1 2.328963 0.323103 7.208 5.67e-13 ***
' fi_born_abroad1 -0.203241 0.165336 -1.229 0.218974
' fi_civ_stat1 0.716537 0.120899 5.927 3.09e-09 ***
' fi_edlevel1 -0.011850 0.218032 -0.054 0.956655
' fi_edlevel2 0.608046 0.346569 1.754 0.079350 .
' i_age:fi_bvux1 -0.140106 0.016899 -8.291 < 2e-16 ***
' i_age:fi_born_abroad1 -0.033180 0.007505 -4.421 9.83e-06 ***
' i_age:fi_edlevel1 -0.039062 0.010225 -3.820 0.000133 ***
' i_age:fi_edlevel2 -0.083639 0.013740 -6.087 1.15e-09 ***
' fi_bvux1:fi_edlevel1 1.509365 0.142927 10.560 < 2e-16 ***
' fi_bvux1:fi_edlevel2 2.127570 0.209214 10.169 < 2e-16 ***
' fi_born_abroad1:fi_civ_stat1 -0.798345 0.167566 -4.764 1.89e-06 ***
' ---
' Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
'
' (Dispersion parameter for binomial family taken to be 1)
'
' Null deviance: 21666 on 18190 degrees of freedom
' Residual deviance: 20046 on 18176 degrees of freedom
' AIC: 20076
'
' Number of Fisher Scoring iterations: 5
xbeta1 = -3.063949 + _
i_age(idx) * 0.214717 + _
fi_sex2 * 0.142866 + _
fi_bvux1 * 2.328963 + _
fi_born_abroad1 * -0.203241 + _
fi_civ_stat1 * 0.716537 + _
fi_edlevel1 * -0.01185 + _
fi_edlevel2 * 0.608046 + _
i_age(idx) * fi_bvux1 * -0.140106 + _
i_age(idx) * fi_born_abroad1 * -0.03318 + _
i_age(idx) * fi_edlevel1 * -0.039062 + _
i_age(idx) * fi_edlevel2 * -0.083639 + _
fi_bvux1 * fi_edlevel1 * 1.509365 + _
fi_bvux1 * fi_edlevel2 * 2.12757 + _
fi_born_abroad1 * fi_civ_stat1 * -0.798345
prob = 1 / (1 + Exp(-xbeta1))
'*** Regression model
' Call:
' lm(formula = sqrt(i_inc_earning) ~ i_age + fi_sex + fi_bvux +
' fi_born_abroad + fi_civ_stat + fi_edlevel + i_age:fi_bvux +
' i_age:fi_civ_stat + i_age:fi_edlevel + fi_sex:fi_bvux + fi_bvux:fi_born_abroad,
' data = stud[idxpos, ])
'
' Residuals:
' Min 1Q Median 3Q Max
' -242.514 -35.064 -1.899 34.340 247.631
'
' Coefficients:
' Estimate Std. Error t value Pr(>|t|)
' (Intercept) -21.6326 5.4347 -3.980 6.92e-05 ***
' i_age 6.8164 0.3022 22.556 < 2e-16 ***
' fi_sex2 -3.3987 1.2875 -2.640 0.008308 **
' fi_bvux1 87.4479 7.9957 10.937 < 2e-16 ***
' fi_born_abroad1 -17.7148 2.4486 -7.235 4.92e-13 ***
' fi_civ_stat1 74.6046 7.1228 10.474 < 2e-16 ***
' fi_edlevel1 -19.3884 5.2399 -3.700 0.000216 ***
' fi_edlevel2 28.6964 8.1546 3.519 0.000435 ***
' i_age:fi_bvux1 -3.0551 0.3559 -8.585 < 2e-16 ***
' i_age:fi_civ_stat1 -1.9917 0.2211 -9.008 < 2e-16 ***
' i_age:fi_edlevel1 0.4829 0.2033 2.375 0.017556 *
' i_age:fi_edlevel2 -1.6430 0.3057 -5.375 7.78e-08 ***
' fi_sex2:fi_bvux1 8.7323 1.9470 4.485 7.35e-06 ***
' fi_bvux1:fi_born_abroad1 -14.5442 3.1437 -4.626 3.76e-06 ***
' ---
' Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
'
' Residual standard error: 53.64 on 13034 degrees of freedom
' Multiple R-Squared: 0.3842, Adjusted R-squared: 0.3836
' F-statistic: 625.5 on 13 and 13034 DF, p-value: < 2.2e-16
If Rnd < prob Then
xbeta2 = -21.6326 + _
i_age(idx) * 6.8164 + _
fi_sex2 * -3.3987 + _
fi_bvux1 * 87.4479 + _
fi_born_abroad1 * -17.7148 + _
fi_civ_stat1 * 74.6046 + _
fi_edlevel1 * -19.3884 + _
fi_edlevel2 * 28.6964 + _
i_age(idx) * fi_bvux1 * -3.0551 + _
i_age(idx) * fi_civ_stat1 * -1.9917 + _
i_age(idx) * fi_edlevel1 * 0.4829 + _
i_age(idx) * fi_edlevel2 * -1.643 + _
fi_sex2 * fi_bvux1 * 8.7323 + _
fi_bvux1 * fi_born_abroad1 * -14.5442
ReDim rand(2)
Call RANNOR(2, rand(1), idx + random * Rnd)
f_income_students = (xbeta2 + rand(2) * 53.64) ^ 2
End If
End Function
'*******************************************************************************
'*** Function f_income_misc() randomizes incomes for individuals with
'*** miscellaneous status.
'*** A two part model is used. First a logit model is used to predict the probability
'*** of positive income. At the second stage a regression model is used to predict
'*** the income for individuals that passes the first stage.
'*** For estimation code see folder S:\SESIM\Dokument\Dokumentation\_
'*** SESIM\Estimation\Income model\Income_ed_misc\_
'*** estimate_incomes_misc_student_twopart.r
'*******************************************************************************
Public Function f_income_misc(idx) As Long
Dim prob As Double, rand() As Double
Dim xbeta1 As Double, xbeta2 As Double
Dim fi_sex2 As Byte, fi_bvux1 As Byte, fi_born_abroad1 As Byte, fi_civ_stat1 As Byte
Dim fh_n_childTRUE As Byte
f_income_misc = 0
If i_sex(idx) = 2 Then fi_sex2 = 1 Else fi_sex2 = 0
If i_bvux(idx) = 1 Then fi_bvux1 = 1 Else fi_bvux1 = 0
If i_born_abroad(idx) = 1 Then fi_born_abroad1 = 1 Else fi_born_abroad1 = 0
If i_civ_stat(idx) = 1 Then fi_civ_stat1 = 1 Else fi_civ_stat1 = 0
If h_n_child(hhnr2index(i_hhnr(idx))) > 0 Then fh_n_childTRUE = 1 Else fh_n_childTRUE = 0
'*** Selection model (logit)
' Call:
' glm(formula = i_inc_earning > 0 ~ log(i_age) + fi_sex + fi_bvux +
' fi_born_abroad + fi_civ_stat + fh_n_child + log(i_age):fi_sex +
' log(i_age):fh_n_child, family = binomial, data = misc)
'
' deviance Residuals:
' Min 1Q Median 3Q Max
' -1.0789 -0.5855 -0.4784 -0.3520 2.6462
'
' Coefficients:
' Estimate Std. Error z value Pr(>|z|)
' (Intercept) -2.91641 0.57290 -5.091 3.57e-07 ***
' log(i_age) 0.18515 0.14734 1.257 0.20887
' fi_sex2 4.39614 0.58502 7.515 5.71e-14 ***
' fi_bvux1 0.50797 0.16288 3.119 0.00182 **
' fi_born_abroad1 -0.99991 0.07797 -12.824 < 2e-16 ***
' fi_civ_stat1 0.35795 0.08404 4.259 2.05e-05 ***
' fh_n_childTRUE 3.49809 0.83241 4.202 2.64e-05 ***
' log(i_age):fi_sex2 -1.21797 0.15994 -7.615 2.64e-14 ***
' log(i_age):fh_n_childTRUE -0.91047 0.22122 -4.116 3.86e-05 ***
' ---
' Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
'
' (Dispersion parameter for binomial family taken to be 1)
'
' Null deviance: 6811.0 on 8676 degrees of freedom
' Residual deviance: 6510.7 on 8668 degrees of freedom
' AIC: 6528.7
'
' Number of Fisher Scoring iterations: 5
xbeta1 = -2.91641 + _
Log(i_age(idx)) * 0.18515 + _
fi_sex2 * 4.39614 + _
fi_bvux1 * 0.50797 + _
fi_born_abroad1 * -0.99991 + _
fi_civ_stat1 * 0.35795 + _
fh_n_childTRUE * 3.49809 + _
Log(i_age(idx)) * fi_sex2 * -1.21797 + _
Log(i_age(idx)) * fh_n_childTRUE * -0.91047
prob = 1 / (1 + Exp(-xbeta1))
'*** Regression model
' Call:
' lm(formula = sqrt(i_inc_earning) ~ i_age, data = misc[idxpos,
' ])
'
' Residuals:
' Min 1Q Median 3Q Max
' -46.125 -14.795 1.009 15.983 44.008
'
' Coefficients:
' Estimate Std. Error t value Pr(>|t|)
' (Intercept) 54.57192 1.53360 35.584 < 2e-16 ***
' i_age -0.19597 0.03506 -5.589 2.84e-08 ***
' ---
' Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
'
' Residual standard error: 18.99 on 1154 degrees of freedom
' Multiple R-Squared: 0.02636, Adjusted R-squared: 0.02551
' F-statistic: 31.24 on 1 and 1154 DF, p-value: 2.845e-08
If Rnd < prob Then
xbeta2 = 54.57192 + _
i_age(idx) * -0.19597
ReDim rand(2)
Call RANNOR(2, rand(1), idx + random * Rnd)
f_income_misc = (xbeta2 + rand(2) * 18.99) ^ 2
End If
End Function
Public Sub randomnumbers()
'Subroutine for generation of randomnumbers used in sigma_my determination for _
individuals with incomes in startdata.
Dim i As Long
Dim n As Long
n = 100000
Dim s1 As Double
Dim s2 As Double
ReDim helpArrayRandomValues(1 To n)
'Dessa varianser r tagna som ett genomsnitt. Egentligen borde de slumpas fr _
varje i_sector och kn. Jag har avsttt ifrn detta slnge.
s1 = Sqr(0.08)
s2 = Sqr(0.02)
For i = 1 To n
randomValues(i, 1) = gauss(0, s1)
randomValues(i, 2) = gauss(0, s2)
randomValues(i, 3) = round(randomValues(i, 1) + randomValues(i, 2), 3)
Next
Call quicksort(randomValues, 3)
For i = 1 To n
helpArrayRandomValues(i) = randomValues(i, 3)
Next
End Sub