查看原文
其他

R语言在收入不平等指标测度上的应用~

2017-09-20 杜雨 R语言中文社区

杜雨,EasyCharts团队成员,R语言中文社区专栏作者,兴趣方向为:Excel商务图表,R语言数据可视化,地理信息数据可视化。个人公众号:数据小魔方(微信ID:datamofang) ,“数据小魔方”创始人。


最近在研究个人所得税的收入再分配效应,不是心甘情愿的,毕业论文需要

因为使用了CHIPS的数据库,微观住户调查数据是我见过最变态的数据源,没有之一~

其中所使用到的理论模型中需要计算很多个人所得税、再分配效应和累进性指标,经过参考各方文献资料,依靠着自己对于R语言的一丁点儿基础,终于把所有的指标计算代码整理完了,因为代码太多,除了预处理和数据清洗的之外,这里分享一下我觉得可能会对学术研究人员有用的几段核心代码!

以下代码一共分为两类,一类是计算个人所得税的代码,一类是衡量收入分配不均等的测度指标。

个人所得税:

大家都知道,我国现行的个人所得税是分类征收的,11个类别,但是通常计算比较复杂的是带有费用扣除和累进税率的收入类型,这里我仅以典型的工资薪金收入所得和经营性所得的应纳税额计算为例,按照最新税法标准计算,其他的类别大多都执行比例税率,计算较为简单。

工资薪金所得税:

其中的Salary表示工资薪金收入;Three_one表示三险一金;tax_Salary表示应纳税所得额。因为我拿到的工资薪金收入是全年的,所以算了月均应纳税所得额,实际中个人所得税都是按月缴纳的,所以计算应纳税所得额的时候,需要自己修改一下以下语法:

计算工资薪金所得收入应纳税所得额:

house_2013_data$tax_Salary<-ifelse(house_2013_data$Salary-house_2013_data$Three_one-3500*12<0,0,house_2013_data$Salary-house_2013_data$Three_one-3500*12)/12

工资薪金所得收入应纳税所得额:

house_2013_data<-within(house_2013_data,{  Salary_tax=NA  Salary_tax[tax_Salary<=0]=0  Salary_tax[tax_Salary>0      & tax_Salary<=1500]  =tax_Salary[tax_Salary>0    & tax_Salary<=1500  ] *.03  Salary_tax[tax_Salary>1500   & tax_Salary<=4500]  =tax_Salary[tax_Salary>1500 & tax_Salary<=4500  ] *.10-105  Salary_tax[tax_Salary>4500   & tax_Salary<=9000]  =tax_Salary[tax_Salary>4500  & tax_Salary<=9000 ] *.20-555  Salary_tax[tax_Salary>9000   & tax_Salary<=35000] =tax_Salary[tax_Salary>9000  & tax_Salary<=35000] *.25-1005  Salary_tax[tax_Salary>35000  & tax_Salary<=55000] =tax_Salary[tax_Salary>35000 & tax_Salary<=55000] *.30-2755  Salary_tax[tax_Salary>55000  & tax_Salary<=80000] =tax_Salary[tax_Salary>55000 & tax_Salary<=80000] *.35-5505  Salary_tax[tax_Salary>80000]                      =tax_Salary[tax_Salary>80000]*.45-13505 }) house_2013_data$Salary_tax<-12*house_2013_data$Salary_tax

经营性净收入应纳税额计算:

Business_F(个体工商户的生产经营活动、企事业单位的承包经营、承租经营活动)

tax_Bussiness指经营性收入的应纳税所得额,经营性收入按年度缴纳。

house_2013_data$tax_Bussiness<-ifelse(house_2013_data$Business<42000,0,house_2013_data$Business-42000) house_2013_data<-within(house_2013_data,{  Business_tax=NA  Business_tax[Business==0]=0  Business_tax[Business>0     & Business<=15000 ] =Business[Business>0   & Business<=15000 ]*.05  Business_tax[Business>15000 & Business<=30000 ] =Business[Business>15000 & Business<=30000 ]*.10-750  Business_tax[Business>30000 & Business<=60000 ] =Business[Business>30000 & Business<=60000 ]*.20-3750  Business_tax[Business>60000 & Business<=100000] =Business[Business>60000 & Business<=100000]*.30-9750    Business_tax[Business>100000]=Business[Business>100000 ]*.35-14750})


因为个人所得税的计算肯定是要给纳税人打标签的, 即算出来的应纳税额必然要与纳税人的ID一一对应,所以我直接用了含有税前收入的数据框作为函数的参数,具体运用的时候,记得你的数据框中必须要有同名的变量,或者可以修改上述代码中税前收入的变量名,改成与你的含税前收入的数据框税前收入名称一致即可。

收入不平等指标:

基尼系数:

Gini<-function(income){
 library("caTools")  cum_income <- cumsum(sort(c(income,0)))  sum_income <- cum_income[length(cum_income)]  xarray     <- seq(0,length(cum_income)-1) / (length(cum_income)-1)  yarray     <- cum_income/sum_income  B          <- trapz(x=xarray,y=yarray)  A          <- 0.5 - B
 return     (A/(A+B)) }

其几何解释如下图所示:

以上基尼系数的代码是本人根据基尼系数几何法原理,同时参考了 知乎大神@何世提的Python版本思路,使用前提出几点建议,基尼系数对0值和负值极度敏感,倘若你的收入收入中含有零值和负值,最好提前做清洗处理,虽然理论上来说,零值和负值的确也能解释的通。

import numpy as np
def gini_coef(wealths):    cum_wealths = np.cumsum(sorted(np.append(wealths, 0)))    sum_wealths = cum_wealths[-1]    xarray = np.array(range(0, len(cum_wealths))) / np.float(len(cum_wealths)-1)    yarray = cum_wealths / float(sum_wealths)    B = np.trapz(yarray, x=xarray)    A = 0.5 - B    return A / (A+B)

以上Python版本来自于知乎知名话题答主何史提大神:

作者:何史提

链接:https://www.zhihu.com/question/20219466/answer/25936162

再分配效应指数:

再分配效应,也即MT指数,用于衡量一项税收政策对收入不平等的影响程度,其经过多年发展,出现了很多分解公式,已经衍生了很多附属指标,这里我将与其有关联的累进性指标P指数也同时纳入MT指数的算法中:

所用到的内置函数:

#基尼系数:Gini<-function(income){
 library("caTools")  cum_income <- cumsum(sort(c(income,0)))  sum_income <- cum_income[length(cum_income)]  xarray     <- seq(0,length(cum_income)-1) / (length(cum_income)-1)  yarray     <- cum_income/sum_income  B          <- trapz(x=xarray,y=yarray)  A          <- 0.5 - B
 return     (A/(A+B)) }
####税前收入排序的税后基尼系数,与尼基系数公式唯一不同点是顺序是按照税前收入排序的
Gini_N<-function(income){
 library("caTools")  cum_income <- cumsum(c(income,0))  sum_income <- cum_income[length(cum_income)]  xarray     <- seq(0,length(cum_income)-1) / (length(cum_income)-1)  yarray     <- cum_income/sum_income  B          <- trapz(x=xarray,y=yarray)  A          <- 0.5 - B
 return     (A/(A+B)) }

MT指数

MT<-function(Salary_gini_data){
 library(dplyr)  GX<-Gini(Salary_gini_data$Salary)                                          GY<-Gini(Salary_gini_data$aftertax_salary)                                CT<-Gini(Salary_gini_data$Salary_tax)                                    CY<-Salary_gini_data%>%arrange(Salary)%>%.[,"aftertax_salary"]%>%Gini_N    t <-sum(Salary_gini_data$Salary_tax)/sum(Salary_gini_data$Salary)    CXT<-Gini(Salary_gini_data$tax_Salary)  P <-CT-GX                                                              H <-CY-GY                                                                    V <-t*P/(1-t)                                                                Ded<-CT-CXT                                                                Ratio<-CXT-GX    MT<-(CY-GY)+t/(1-t)
   return(data.frame(Name=c("税前尼基系数","税后基尼系数","税收集中度","税后收入集中度(按照税前收入排序)","平均税率","应纳税所得额集中率","MT指数","累进性指数","横向公平效应","纵向公平相应","免征额累进性","税率结构累进性"),                    Index=c("GX","GY","CT","CY","t","CXT","MT","P","H","V","Ded","Ratio"),                    Scale=c(GX,GY,CT,CY,t,CXT,MT,P,H,V,Ded,Ratio)                    )) }

MT公式的参数仍然是一个数据框,数据框中的四个必备变量是:

Salary:税前收入;

Salary_tax:tax_Salary;

Salary_tax:应纳税所得额;

aftertax_salary:税后收入。


如果不想更改以上代码,你需保证你指定的数据框中含有以上四个同名变量,当然你可以将代码中的变量修改为你数据框中的四个相同指标的变量名。


> MT(Salary_gini_data)

                               Name Index         Scale

1                      税前尼基系数    GX  0.3683065715

2                      税后基尼系数    GY  0.3665269164

3                        税收集中度    CT  0.9758636882

4  税后收入集中度(按照税前收入排序)    CY  0.3661935005

5                          平均税率     t  0.0029255582

6                应纳税所得额集中率   CXT  0.9713859292

7                            MT指数    MT  0.0026007263

8                        累进性指数     P  0.6075571167

9                      横向公平效应     H -0.0003334159

10                     纵向公平相应     V  0.0017826590

11                     免征额累进性   Ded  0.0044777590

12                   税率结构累进性 Ratio  0.6030793577


R语言(ggplot2入门)可视化在商务场景中的应用,已经有200+小伙伴加入了!

感兴趣的可点击阅读原文报名参加哦,满满的干货!


您可能也对以下帖子感兴趣

文章有问题?点此查看未经处理的缓存