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 previomg=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䟪iFAN5)Z.ٴ~Nm[qU
)
<
TyWMm:mwVuc־|>s>-5iqOp^6ODVJ➾NãT:ƴˏӭ?}?I.#'Jk~|lzSM1JZwm?['M/j8}.?ߴe|{8y΄gѧO-cӆ+FSk/tSC뮯*}i75-NRxNM:´4<_qoi[*>ϪxZpì}֙-kz?귫OMf5~~!VԮO?Ϡ7~T|Rvo?U2tO]VZR)/^ϓu*kʹ~)]G>.oR<_Kzͫ[Muj}GqS^Z:yR$_keժW/tJįzg%VUo}?T5|ZipSto/kctҵ/O=k+HOo׵~oaӥ'NJfޛj}=WOIjt֍NSNէS}mz}ָP.{^>.u^[i~t^-ckMU~V׽Wu:ZZ+O.ʷSwj|oK"§k鸽߫ohgѧ?H%V>|~\|D^ZG[WN%4׍)OδsF<~t]Sh
&oV{~_"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ڭ3SM5chSTH5{Ea׶?G 
DYYCcs0#K6$w7;jI)ZCWRqA:{dbda۫4G)c*V-!3LS%;`)qvjyZiRT$AWFHxu;/6Xż[hf6Դ`	T
u7TnwF7qn
FQCQL2utTC,ā4#	?9s\eݦѓ$QUQ3jbus>{%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+\dPqZt/QU|l?aڸ|T.O)50Wdx @VHٝ5m.J4jH Fb,id?#(ʿU48da;_ghɻNZI%.Z=i)YIHZ>9&Hա	JSU)SRi|Hvyz[Iw(, 'R+Y|t,F7RJ#	R/U6JdYeB$s\wHn`E22yPB)OQM`v>ᮥhk)j)e@&AX{C[ùY[7CQRHI6KU Bʇ}Xo]mV|te*`1
ՂU*hheE-uF6}P#5@\^lʹm-ʼn"Ty
MjX犩E\$d.|-ή=)Qڧ
(R<	z`?>{{$v
2UC$a2igOA%'bT7{Zfrd+k+wc!S
3TTGHӳy z$}`au;5|)Um	<1Xܳk[DJh0AHɦOWts.nzYd5$Xc_*+%݊#IU#Q9'b|-.4ThGˮb>QE&ޭ6%1eV
N>)~O^+zV75EM	XNS5BHLy5iS4O>fۋ$gTF$`5hz?;C|vޓ.%%/-vLI)-+èipyuktȺ0Zj^hn㸘*}sx}zI]*,M_x
W1*+Trm	ׂHΊx9*+T^_feUil%e5d9Q?[e14yҞ]ɚn9)2?	`K9R={얪!ZRdžSw(K{;l=Q`c-J%eϮHf{ȫ[ $Q^!ud\M4|
.wȜ/ju.>bf6tCM.Cr
i秢рZȐ&"nsjvM:]sB8 yޮ,Bu5\#csa7}ѱ(qlwN8KZjmLUxIOqʐoUksATH$FnE'm%`LEH88'Ҽ

zzT}7RaT{uCZV.:OR)m FyEwP§H
} hU#Νhfck&VJZ
z#ˮDgi1{6&7
ƬAI,eTTqϏ(~㪢r
7kX%kK(gW0K[SZϭ[$w3ZeҒM2+G$Қ}X/=KozkwFS./kRP<e,
àVs/
FȪBPQSAC-JM#n*
KAU0dˊb-|FӢJBYכ𷲾A板n fFEET^9~]ns%
*4'3's=UKUKMvE1IYG&x!A9iVtr\wҚ♒ȨaQG]gEGjnVX֩MXULjö;ʾ mYZ<>%zMVY^YP6ied0V=٨-\%Οlyy%1}E,ZP+PΨ
TRJq#WWM$j
&`U2*1O
Gpl@od#ZK
<
)!rKQN8=
霮fn)OcJz2\<ƕ2Bw7RA }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҂qu-៑IM"Hg[I)g}ok=iBlWwBǨQqLG*_'9RLx  #ժ3:̿#V@!:7洂%}(xI prD)8ɡ5kN.uFi(yT9y5zB%;ԢKm#+|ϟ]wxnCB@&1ybmduSA
HC1gP4)?CMs2\-uW).׏,G8;s,Y5X$R֥=$m厒jyv"Lb5767m+ŃʛW!R*uHNxc	U%IaP>Nx"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