# El Servicio Interno de Contribuciones (IRS) de EE.UU. está tratando de estimar la cantidad mensual de impuestos no pagados descubiertos por su departamento de auditorías. En el pasado, el IRS estimaba esta cantidad con base en el número esperado de horas de trabajo de auditorías de campo. En los últimos años, sin embargo, las horas de trabajo de auditorías de campo se han convertido en un pronosticador errático de los impuestos no pagados reales. Como resultado, la dependencia está buscando otro factor para mejorar la ecuación de estimación.

# El departamento de auditorías tiene un registro del número de horas que usa sus computadoras para detectar impuestos no pagados. ¿Podríamos combinar esta información con los datos referentes a las horas de trabajo de auditorías de campo y obtener una ecuación de estimación más precisa para los impuestos no pagados descubiertos por cada mes?
library(readxl)
MODELO_DE_INGRESO <- read_excel("C:/Users/74/Desktop/MODELO DE PRUEBA/MODELO DE INGRESO.xlsx", 
    col_types = c("blank", "numeric", "numeric", 
        "numeric", "numeric", "numeric"))
`col_type = "blank"` deprecated. Use "skip" instead.
MODELO_DE_INGRESO

CAMBIO DE VARIABLE

library(readxl)
MODELO_DE_INGRESO1 <- read_excel("C:/Users/74/Desktop/MODELO DE PRUEBA/MODELO DE INGRESO1.xlsx", 
    col_types = c("blank", "numeric", "numeric", 
        "numeric", "numeric", "numeric"))
`col_type = "blank"` deprecated. Use "skip" instead.
MODELO_DE_INGRESO1

REGRESADA

MODELO_DE_INGRESO1 %>% select("Y") %>% as.matrix()->Yregresada
Yregresada
           Y
 [1,] 450000
 [2,] 590000
 [3,] 600000
 [4,] 630000
 [5,] 670000
 [6,] 630000
 [7,] 610000
 [8,] 640000
 [9,] 670000
[10,] 890000

REGRESORES

MODELO_DE_INGRESO1%>%  mutate(Cte=1) %>% select("Cte","X1","X2","X3", "X4") %>% as.matrix()->Xregresor
Xregresor
      Cte    X1     X2    X3     X4
 [1,]   1 20000 160000 20000 250000
 [2,]   1 20000 210000 50000 300000
 [3,]   1 20000 240000 20000 330000
 [4,]   1 30000 240000 30000 330000
 [5,]   1 20000 250000 30000 360000
 [6,]   1 40000 180000 30000 380000
 [7,]   1 20000 190000 20000 380000
 [8,]   1 30000 220000 20000 370000
 [9,]   1 50000 230000 10000 380000
[10,]   1 70000 390000 30000 410000

SIGMAMATRIZ

Xtranspuesta<-t(Xregresor)
sigmamatriz<-(Xtranspuesta%*%Xregresor)
sigmamatriz
        Cte        X1        X2       X3         X4
Cte      10 3.200e+05 2.310e+06 2.60e+05 3.4900e+06
X1   320000 1.280e+10 8.080e+10 8.10e+09 1.1630e+11
X2  2310000 8.080e+10 5.693e+11 6.08e+10 8.2070e+11
X3   260000 8.100e+09 6.080e+10 7.80e+09 8.9800e+10
X4  3490000 1.163e+11 8.207e+11 8.98e+10 1.2381e+12

MATRIZ CRUZADA

cruzada<-(Xtranspuesta%*%Yregresada)
cruzada
             Y
Cte 6.3800e+06
X1  2.1750e+11
X2  1.5299e+12
X3  1.6680e+11
X4  2.2641e+12

INVERSA DE LA SIGMAMATRIZ

inversigma<-solve(sigmamatriz)
inversigma
              Cte            X1            X2            X3            X4
Cte  9.578240e+00  3.734283e-05 -2.205803e-06 -3.921269e-05 -2.620098e-05
X1   3.734283e-05  1.047690e-09 -1.603319e-10  2.324384e-10 -1.142569e-10
X2  -2.205803e-06 -1.603319e-10  6.766047e-11 -9.700525e-11 -1.653585e-11
X3  -3.921269e-05  2.324384e-10 -9.700525e-11  1.143085e-09  7.009360e-11
X4  -2.620098e-05 -1.142569e-10 -1.653585e-11  7.009360e-11  9.127376e-11

BETAS ESTIMADOS

Betas_Estimados<-(inversigma%*%cruzada)
Betas_Estimados
                Y
Cte -5724.5761971
X1      0.9098562
X2      0.9492702
X3      1.3355403
X4      1.0332484

MATRIZ P

Matriz_P<-(Xregresor%*%inversigma%*%Xtranspuesta)
Matriz_P
              [,1]        [,2]        [,3]       [,4]        [,5]        [,6]        [,7]
 [1,]  0.784622100  0.11501380  0.17883272 0.16911689 -0.13211832 -0.04952925 -0.13370254
 [2,]  0.115013798  0.70810335 -0.05191336 0.20027762  0.13825710  0.22728938 -0.05476714
 [3,]  0.178832723 -0.05191336  0.37856361 0.12764747  0.26635394 -0.25711624  0.16048147
 [4,]  0.169116889  0.20027762  0.12764747 0.14229651  0.11400744  0.01786630  0.01615227
 [5,] -0.132118322  0.13825710  0.26635394 0.11400744  0.37009879 -0.08676176  0.25143747
 [6,] -0.049529254  0.22728938 -0.25711624 0.01786630 -0.08676176  0.64732367  0.17653904
 [7,] -0.133702543 -0.05476714  0.16048147 0.01615227  0.25143747  0.17653904  0.42241413
 [8,]  0.002868704 -0.05477356  0.14029051 0.05118934  0.14775651  0.11659093  0.24506141
 [9,]  0.198703306 -0.26867652  0.01900248 0.01822463 -0.12845770  0.23404714  0.09810562
[10,] -0.133807401  0.04118935  0.03785741 0.14322153  0.05942653 -0.02624920 -0.18172173
              [,8]        [,9]       [,10]
 [1,]  0.002868704  0.19870331 -0.13380740
 [2,] -0.054773557 -0.26867652  0.04118935
 [3,]  0.140290509  0.01900248  0.03785741
 [4,]  0.051189341  0.01822463  0.14322153
 [5,]  0.147756510 -0.12845770  0.05942653
 [6,]  0.116590929  0.23404714 -0.02624920
 [7,]  0.245061408  0.09810562 -0.18172173
 [8,]  0.179073236  0.16157951  0.01036340
 [9,]  0.161579515  0.49262802  0.17484350
[10,]  0.010363404  0.17484350  0.87487659

PROYECCION DE Y SOBRE X

Y_Proyectada<-(Matriz_P%*%Yregresada)
Y_Proyectada
             Y
 [1,] 449378.7
 [2,] 588570.8
 [3,] 607980.2
 [4,] 630434.2
 [5,] 661825.8
 [6,] 634238.9
 [7,] 612179.1
 [8,] 639423.3
 [9,] 664090.2
[10,] 891878.8

RESIDUALS

Errores<-(Yregresada-Y_Proyectada)
Errores
               Y
 [1,]   621.2985
 [2,]  1429.1554
 [3,] -7980.1956
 [4,]  -434.1606
 [5,]  8174.2458
 [6,] -4238.9305
 [7,] -2179.1058
 [8,]   576.7096
 [9,]  5909.8020
[10,] -1878.8188
plot(Errores)

hist(Errores)

MODELO LM

library(readr)
library(stargazer)

Please cite as: 

 Hlavac, Marek (2018). stargazer: Well-Formatted Regression and Summary Statistics Tables.
 R package version 5.2.2. https://CRAN.R-project.org/package=stargazer 
modelo_lineal<-lm(Y~X1+X2+X3+X4,data = MODELO_DE_INGRESO1)
stargazer(modelo_lineal,title = "modelo estimado",type = "text")
length of NULL cannot be changedlength of NULL cannot be changedlength of NULL cannot be changedlength of NULL cannot be changedlength of NULL cannot be changed

modelo estimado
===============================================
                        Dependent variable:    
                    ---------------------------
                                 Y             
-----------------------------------------------
X1                           0.910***          
                              (0.202)          
                                               
X2                           0.949***          
                              (0.051)          
                                               
X3                           1.336***          
                              (0.211)          
                                               
X4                           1.033***          
                              (0.060)          
                                               
Constant                    -5,724.576         
                           (19,308.840)        
                                               
-----------------------------------------------
Observations                    10             
R2                             0.998           
Adjusted R2                    0.997           
Residual Std. Error     6,238.977 (df = 5)     
F Statistic           676.723*** (df = 4; 5)   
===============================================
Note:               *p<0.1; **p<0.05; ***p<0.01
summary(modelo_lineal)

Call:
lm(formula = Y ~ X1 + X2 + X3 + X4, data = MODELO_DE_INGRESO1)

Residuals:
      1       2       3       4       5       6       7       8       9      10 
  621.3  1429.2 -7980.2  -434.2  8174.2 -4238.9 -2179.1   576.7  5909.8 -1878.8 

Coefficients:
               Estimate  Std. Error t value  Pr(>|t|)    
(Intercept) -5724.57620 19308.84225  -0.296   0.77879    
X1              0.90986     0.20194   4.505   0.00637 ** 
X2              0.94927     0.05132  18.497 0.0000085 ***
X3              1.33554     0.21094   6.331   0.00145 ** 
X4              1.03325     0.05961  17.335 0.0000117 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 6239 on 5 degrees of freedom
Multiple R-squared:  0.9982,    Adjusted R-squared:  0.9967 
F-statistic: 676.7 on 4 and 5 DF,  p-value: 0.0000005102
summary(MODELO_DE_INGRESO1)
       Y                X1              X2               X3              X4        
 Min.   :450000   Min.   :20000   Min.   :160000   Min.   :10000   Min.   :250000  
 1st Qu.:602500   1st Qu.:20000   1st Qu.:195000   1st Qu.:20000   1st Qu.:330000  
 Median :630000   Median :25000   Median :225000   Median :25000   Median :365000  
 Mean   :638000   Mean   :32000   Mean   :231000   Mean   :26000   Mean   :349000  
 3rd Qu.:662500   3rd Qu.:37500   3rd Qu.:240000   3rd Qu.:30000   3rd Qu.:380000  
 Max.   :890000   Max.   :70000   Max.   :390000   Max.   :50000   Max.   :410000  

OBJETOS DENTRO DEL MODELO

VECTOR DE COEFICIENTES ESTIMADOS

options(scipen=999)
modelo_lineal$coefficients
  (Intercept)            X1            X2            X3            X4 
-5724.5761971     0.9098562     0.9492702     1.3355403     1.0332484 

MATRIZ VARIANZA COVARIANZA DE LOS PARAMETROS

Var_Covar<-vcov(modelo_lineal)
print(Var_Covar)
                (Intercept)             X1            X2              X3              X4
(Intercept) 372831388.95091 1453.563237546 -85.860507778 -1526.347446273 -1019.868534494
X1               1453.56324    0.040781157  -0.006240891     0.009047626    -0.004447429
X2                -85.86051   -0.006240891   0.002633673    -0.003775913    -0.000643655
X3              -1526.34745    0.009047626  -0.003775913     0.044494388     0.002728382
X4              -1019.86853   -0.004447429  -0.000643655     0.002728382     0.003552816

AJUSTES DE LOS RESIDUOS A LA DISTRIBUCION NORMAL

#Ajuste de los residuos a la distribucion normal
library(fitdistrplus)
library(stargazer)
fit_normal<-fitdist(data = modelo_lineal$residuals,distr = "norm")
NaNs producedNaNs produced
fit_normal
Fitting of the distribution ' norm ' by maximum likelihood 
Parameters:
plot(fit_normal)

PRUEBA DE JARQUE BERA

library(normtest)  
jb.norm.test(modelo_lineal$residuals)

    Jarque-Bera test for normality

data:  modelo_lineal$residuals
JB = 0.10016, p-value = 0.9585
hist(modelo_lineal$residuals,main = "Histograma de los residuos",xlab = "Residuos",ylab = "Frecuencia")

LS0tDQp0aXRsZTogIkVDVUFDSU9OIERFIEVTVElNQUNJT04iDQphdXRob3I6ICJEZW5pcyBGZXJuYW5kbyBGbGFtZW5jbyBOb2xhc2NvIg0Kb3V0cHV0OiANCiAgaHRtbF9ub3RlYm9vazogDQogICAgdG9jOiB5ZXMNCiAgaHRtbF9kb2N1bWVudDogDQogICAgZGZfcHJpbnQ6IGthYmxlDQogICAgdG9jOiB5ZXMNCi0tLQ0KDQpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0NCmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gVFJVRSkNCmBgYA0KDQpgYGB7cn0NCiMgRWwgU2VydmljaW8gSW50ZXJubyBkZSBDb250cmlidWNpb25lcyAoSVJTKSBkZSBFRS5VVS4gZXN04SB0cmF0YW5kbyBkZSBlc3RpbWFyIGxhIGNhbnRpZGFkIG1lbnN1YWwgZGUgaW1wdWVzdG9zIG5vIHBhZ2Fkb3MgZGVzY3ViaWVydG9zIHBvciBzdSBkZXBhcnRhbWVudG8gZGUgYXVkaXRvcu1hcy4gRW4gZWwgcGFzYWRvLCBlbCBJUlMgZXN0aW1hYmEgZXN0YSBjYW50aWRhZCBjb24gYmFzZSBlbiBlbCBu+m1lcm8gZXNwZXJhZG8gZGUgaG9yYXMgZGUgdHJhYmFqbyBkZSBhdWRpdG9y7WFzIGRlIGNhbXBvLiBFbiBsb3Mg+mx0aW1vcyBh8W9zLCBzaW4gZW1iYXJnbywgbGFzIGhvcmFzIGRlIHRyYWJham8gZGUgYXVkaXRvcu1hcyBkZSBjYW1wbyBzZSBoYW4gY29udmVydGlkbyBlbiB1biBwcm9ub3N0aWNhZG9yIGVycuF0aWNvIGRlIGxvcyBpbXB1ZXN0b3Mgbm8gcGFnYWRvcyByZWFsZXMuIENvbW8gcmVzdWx0YWRvLCBsYSBkZXBlbmRlbmNpYSBlc3ThIGJ1c2NhbmRvIG90cm8gZmFjdG9yIHBhcmEgbWVqb3JhciBsYSBlY3VhY2nzbiBkZSBlc3RpbWFjafNuLg0KDQojIEVsIGRlcGFydGFtZW50byBkZSBhdWRpdG9y7WFzIHRpZW5lIHVuIHJlZ2lzdHJvIGRlbCBu+m1lcm8gZGUgaG9yYXMgcXVlIHVzYSBzdXMgY29tcHV0YWRvcmFzIHBhcmEgZGV0ZWN0YXIgaW1wdWVzdG9zIG5vIHBhZ2Fkb3MuIL9Qb2Ry7WFtb3MgY29tYmluYXIgZXN0YSBpbmZvcm1hY2nzbiBjb24gbG9zIGRhdG9zIHJlZmVyZW50ZXMgYSBsYXMgaG9yYXMgZGUgdHJhYmFqbyBkZSBhdWRpdG9y7WFzIGRlIGNhbXBvIHkgb2J0ZW5lciB1bmEgZWN1YWNp824gZGUgZXN0aW1hY2nzbiBt4XMgcHJlY2lzYSBwYXJhIGxvcyBpbXB1ZXN0b3Mgbm8gcGFnYWRvcyBkZXNjdWJpZXJ0b3MgcG9yIGNhZGEgbWVzPw0KDQpgYGANCg0KDQoNCmBgYHtyfQ0KbGlicmFyeShyZWFkeGwpDQpNT0RFTE9fREVfSU5HUkVTTyA8LSByZWFkX2V4Y2VsKCJDOi9Vc2Vycy83NC9EZXNrdG9wL01PREVMTyBERSBQUlVFQkEvTU9ERUxPIERFIElOR1JFU08ueGxzeCIsIA0KICAgIGNvbF90eXBlcyA9IGMoImJsYW5rIiwgIm51bWVyaWMiLCAibnVtZXJpYyIsIA0KICAgICAgICAibnVtZXJpYyIsICJudW1lcmljIiwgIm51bWVyaWMiKSkNCk1PREVMT19ERV9JTkdSRVNPDQpgYGANCg0KDQpDQU1CSU8gREUgVkFSSUFCTEUNCg0KYGBge3J9DQpsaWJyYXJ5KHJlYWR4bCkNCk1PREVMT19ERV9JTkdSRVNPMSA8LSByZWFkX2V4Y2VsKCJDOi9Vc2Vycy83NC9EZXNrdG9wL01PREVMTyBERSBQUlVFQkEvTU9ERUxPIERFIElOR1JFU08xLnhsc3giLCANCiAgICBjb2xfdHlwZXMgPSBjKCJibGFuayIsICJudW1lcmljIiwgIm51bWVyaWMiLCANCiAgICAgICAgIm51bWVyaWMiLCAibnVtZXJpYyIsICJudW1lcmljIikpDQpNT0RFTE9fREVfSU5HUkVTTzENCmBgYA0KDQoNClJFR1JFU0FEQQ0KDQpgYGB7cn0NCk1PREVMT19ERV9JTkdSRVNPMSAlPiUgc2VsZWN0KCJZIikgJT4lIGFzLm1hdHJpeCgpLT5ZcmVncmVzYWRhDQpZcmVncmVzYWRhDQpgYGANCg0KUkVHUkVTT1JFUw0KDQpgYGB7cn0NCk1PREVMT19ERV9JTkdSRVNPMSU+JSAgbXV0YXRlKEN0ZT0xKSAlPiUgc2VsZWN0KCJDdGUiLCJYMSIsIlgyIiwiWDMiLCAiWDQiKSAlPiUgYXMubWF0cml4KCktPlhyZWdyZXNvcg0KWHJlZ3Jlc29yDQoNCg0KYGBgDQoNCg0KU0lHTUFNQVRSSVoNCg0KYGBge3J9DQpYdHJhbnNwdWVzdGE8LXQoWHJlZ3Jlc29yKQ0Kc2lnbWFtYXRyaXo8LShYdHJhbnNwdWVzdGElKiVYcmVncmVzb3IpDQpzaWdtYW1hdHJpeg0KDQpgYGANCg0KTUFUUklaIENSVVpBREENCg0KYGBge3J9DQoNCmNydXphZGE8LShYdHJhbnNwdWVzdGElKiVZcmVncmVzYWRhKQ0KY3J1emFkYQ0KDQpgYGANCg0KSU5WRVJTQSBERSBMQSBTSUdNQU1BVFJJWg0KDQpgYGB7cn0NCmludmVyc2lnbWE8LXNvbHZlKHNpZ21hbWF0cml6KQ0KaW52ZXJzaWdtYQ0KYGBgDQoNCkJFVEFTIEVTVElNQURPUyANCg0KYGBge3J9DQpCZXRhc19Fc3RpbWFkb3M8LShpbnZlcnNpZ21hJSolY3J1emFkYSkNCkJldGFzX0VzdGltYWRvcw0KYGBgDQoNCk1BVFJJWiBQDQoNCmBgYHtyfQ0KTWF0cml6X1A8LShYcmVncmVzb3IlKiVpbnZlcnNpZ21hJSolWHRyYW5zcHVlc3RhKQ0KTWF0cml6X1ANCmBgYA0KDQpQUk9ZRUNDSU9OIERFIFkgU09CUkUgWA0KIA0KYGBge3J9DQpZX1Byb3llY3RhZGE8LShNYXRyaXpfUCUqJVlyZWdyZXNhZGEpDQpZX1Byb3llY3RhZGENCg0KYGBgDQoNClJFU0lEVUFMUyANCg0KYGBge3J9DQpFcnJvcmVzPC0oWXJlZ3Jlc2FkYS1ZX1Byb3llY3RhZGEpDQpFcnJvcmVzDQpwbG90KEVycm9yZXMpDQpoaXN0KEVycm9yZXMpDQpgYGANCg0KTU9ERUxPIExNDQoNCmBgYHtyfQ0KbGlicmFyeShyZWFkcikNCmxpYnJhcnkoc3RhcmdhemVyKQ0KbW9kZWxvX2xpbmVhbDwtbG0oWX5YMStYMitYMytYNCxkYXRhID0gTU9ERUxPX0RFX0lOR1JFU08xKQ0Kc3RhcmdhemVyKG1vZGVsb19saW5lYWwsdGl0bGUgPSAibW9kZWxvIGVzdGltYWRvIix0eXBlID0gInRleHQiKQ0KDQpgYGANCg0KDQpgYGB7cn0NCg0Kc3VtbWFyeShtb2RlbG9fbGluZWFsKQ0Kc3VtbWFyeShNT0RFTE9fREVfSU5HUkVTTzEpDQoNCmBgYA0KDQoNCg0KDQoNCk9CSkVUT1MgREVOVFJPIERFTCBNT0RFTE8gDQoNClZFQ1RPUiBERSBDT0VGSUNJRU5URVMgRVNUSU1BRE9TDQoNCmBgYHtyfQ0Kb3B0aW9ucyhzY2lwZW49OTk5KQ0KbW9kZWxvX2xpbmVhbCRjb2VmZmljaWVudHMNCg0KYGBgDQoNCg0KTUFUUklaIFZBUklBTlpBIENPVkFSSUFOWkEgREUgTE9TIFBBUkFNRVRST1MNCg0KYGBge3J9DQpWYXJfQ292YXI8LXZjb3YobW9kZWxvX2xpbmVhbCkNCnByaW50KFZhcl9Db3ZhcikNCmBgYA0KDQpBSlVTVEVTIERFIExPUyBSRVNJRFVPUyBBIExBIERJU1RSSUJVQ0lPTiBOT1JNQUwgDQoNCg0KYGBge3J9DQojQWp1c3RlIGRlIGxvcyByZXNpZHVvcyBhIGxhIGRpc3RyaWJ1Y2lvbiBub3JtYWwNCmxpYnJhcnkoZml0ZGlzdHJwbHVzKQ0KbGlicmFyeShzdGFyZ2F6ZXIpDQpmaXRfbm9ybWFsPC1maXRkaXN0KGRhdGEgPSBtb2RlbG9fbGluZWFsJHJlc2lkdWFscyxkaXN0ciA9ICJub3JtIikNCmZpdF9ub3JtYWwNCnBsb3QoZml0X25vcm1hbCkNCmBgYA0KDQoNClBSVUVCQSBERSBKQVJRVUUgQkVSQSANCg0KYGBge3J9DQoNCmxpYnJhcnkobm9ybXRlc3QpICANCmpiLm5vcm0udGVzdChtb2RlbG9fbGluZWFsJHJlc2lkdWFscykNCg0KYGBgDQoNCg0KYGBge3J9DQpoaXN0KG1vZGVsb19saW5lYWwkcmVzaWR1YWxzLG1haW4gPSAiSGlzdG9ncmFtYSBkZSBsb3MgcmVzaWR1b3MiLHhsYWIgPSAiUmVzaWR1b3MiLHlsYWIgPSAiRnJlY3VlbmNpYSIpDQpgYGANCg0K