Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Introduction
In the first part of this article I explained and compared four different functional forms to model apples’ production.
This is what I need to retake the previously explained examples:
# Libraries #install.packages(c("micEcon","lmtest","bbmle","miscTools")) library(micEcon) library(lmtest) library(stats4) #this is a base package so I don't install this library(bbmle) library(miscTools) # Load data data("appleProdFr86", package = "micEcon") data = appleProdFr86 rm(appleProdFr86) data$qCap = data$vCap/data$pCap data$qLab = data$vLab/data$pLab data$qMat = data$vMat/data$pMat # Fit models ## Linear specification prodLin = lm(qOut ~ qCap + qLab + qMat, data = data) data$qOutLin = fitted(prodLin) ## Quadratic specification prodQuad = lm(qOut ~ qCap + qLab + qMat + I(0.5*qCap^2) + I(0.5*qLab^2) + I(0.5*qMat^2) + I(qCap*qLab) + I(qCap*qMat) + I(qLab*qMat), data = data) data$qOutQuad = fitted(prodQuad) ## Cobb-Douglas specification prodCD = lm(log(qOut) ~ log(qCap) + log(qLab) + log(qMat), data = data) data$qOutCD = fitted(prodCD) ## Translog specification prodTL = lm(log(qOut) ~ log(qCap) + log(qLab) + log(qMat) + I(0.5*log(qCap)^2) + I(0.5*log(qLab)^2) + I(0.5*log(qMat)^2) + I(log(qCap)*log(qLab)) + I(log(qCap)*log(qMat)) + I(log(qLab)*log(qMat)), data = data) data$qOutTL = fitted(prodTL)
These four specifications presented different problems that suggested model misspecification. Ideally, I should find a model with positive predicted output and positive factor elasticity to make sense of the context of production I’m working with.
Model misspectification
RESET test (the name stands for Regression Equation Specification Error Test) is a test for functional form misspecification.
As a general test, RESET helps detecting ommited variables. Package lmtest
provides resettest
, a function that provides one of the many versions of the test, and it fits this model by default:
The key idea behind fitting another model that includes the output is to detect if the model ignores an important nonlinearity.
The hypothesis testing is:
If there is evidence to reject the null hypthosis, the test does not provide an alternative model and it just states that the model is misspecified.
The statistic will be a t statistic if we just include \(\gamma_1 \hat{y}_i^2\), and it will change to a F statistic if we include \(\gamma_2 \hat{y}_i^3\) or a higher power.
In the context of the worked specifications:
resettest(prodLin) RESET test data: prodLin RESET = 17.639, df1 = 2, df2 = 134, p-value = 1.584e-07 resettest(prodQuad) RESET test data: prodQuad RESET = 7.3663, df1 = 2, df2 = 128, p-value = 0.0009374 resettest(prodCD) RESET test data: prodCD RESET = 2.9224, df1 = 2, df2 = 134, p-value = 0.05724 resettest(prodTL) RESET test data: prodTL RESET = 1.2811, df1 = 2, df2 = 128, p-value = 0.2813
\(\Longrightarrow\) The null hypothesis is rejected both for Linear and Quadratic specifications while Cobb-Douglas specification is rejected at 10% of significance. The null hypothesis can’t be rejected for the Translog Specification.
I can also modify the powers in the model:
resettest(prodTL, power = 2) RESET test data: prodTL RESET = 2.358, df1 = 1, df2 = 129, p-value = 0.1271 resettest(prodTL, power = 2:4) RESET test data: prodTL RESET = 1.3475, df1 = 3, df2 = 127, p-value = 0.262
\(\Longrightarrow\) The null hypothesis can’t be rejected for Translog Specification, not even by adding a higher power.
Quasiconcavity
A function
is quasiconcave if for \(0 \leq t \leq 1\)
In particular, any concave and twice continuously differentiable function is quasiconcave.
In really raw terms, quasiconcavity guarantees there is a production plan where the company is minimizing cost. Adding differentiability, you can find an optimal production plan by using derivatives.
To cehck the details please check Advanced Microeconomic Theory by Geoffrey A. Jehle.
I’ll check the quasiconcavity in an indirect way, by checking the concavity at each observation using the hessian method:
# Quadratic Specification ## Regression coefficients b1 = coef(prodQuad)["qCap"] b2 = coef(prodQuad)["qLab"] b3 = coef(prodQuad)["qMat"] b11 = coef(prodQuad)["I(0.5 * qCap^2)"] b22 = coef(prodQuad)["I(0.5 * qLab^2)"] b33 = coef(prodQuad)["I(0.5 * qMat^2)"] b12 = b21 = coef(prodQuad)["I(qCap * qLab)"] b13 = b31 = coef(prodQuad)["I(qCap * qMat)"] b23 = b32 = coef(prodQuad)["I(qLab * qMat)"] ## Marginal productivity data$mpCapQuad = with(data, b1 + b11*qCap + b12*qLab + b13*qMat) data$mpLabQuad = with(data, b2 + b21*qCap + b22*qLab + b23*qMat) data$mpMatQuad = with(data, b3 + b31*qCap + b32*qLab + b33*qMat) ## Quasiconcavity data$quasiConcQuad = NA for(obs in 1:nrow(data)) { hmLoop = matrix(0, nrow = 3, ncol = 3) hmLoop[1,1] = b11 hmLoop[1,2] = hmLoop[2,1] = b12 hmLoop[1,3] = hmLoop[3,1] = b13 hmLoop[2,2] = b22 hmLoop[2,3] = hmLoop[3,2] = b23 hmLoop[3,3] = b33 data$quasiConcQuad[obs] = hmLoop[1,1] < 0 & det(hmLoop[1:2,1:2] > 0) & det(hmLoop < 0) } sum(!data$quasiConcQuad) [1] 140 # Translog Specification ## Regression coefficients b1 = coef(prodTL)["log(qCap)"] b2 = coef(prodTL)["log(qLab)"] b3 = coef(prodTL)["log(qMat)"] b11 = coef(prodTL)["I(0.5 * log(qCap)^2)"] b22 = coef(prodTL)["I(0.5 * log(qLab)^2)"] b33 = coef(prodTL)["I(0.5 * log(qMat)^2)"] b12 = b21 = coef(prodTL)["I(log(qCap) * log(qLab))"] b13 = b31 = coef(prodTL)["I(log(qCap) * log(qMat))"] b23 = b32 = coef(prodTL)["I(log(qLab) * log(qMat))"] ## Scale elasticity data$eCapTL = with(data, b1 + b11*log(qCap) + b12*log(qLab) + b13*log(qMat)) data$eLabTL = with(data, b2 + b21*log(qCap) + b22*log(qLab) + b23*log(qMat)) data$eMatTL = with(data, b3 + b31*log(qCap) + b32*log(qLab) + b33*log(qMat)) ## Marginal productivity data$mpCapTL = with(data, eCapTL * qOutTL / qCap) data$mpLabTL = with(data, eLabTL * qOutTL / qLab) data$mpMatTL = with(data, eMatTL * qOutTL / qMat) ## Derivatives of marginal productivity data$dmpCapCapTL = with(data, (qOutTL / qCap^2) * (b11 + eCapTL^2 - eCapTL)) data$dmpLabLabTL = with(data, (qOutTL / qLab^2) * (b22 + eLabTL^2 - eLabTL)) data$dmpMatMatTL = with(data, (qOutTL / qLab^2) * (b33 + eMatTL^2 - eMatTL)) data$dmpCapLabTL = with(data, (qOutTL / (qCap * qLab)) * (b12 + eCapTL * eLabTL)) data$dmpCapMatTL = with(data, (qOutTL / (qCap * qMat)) * (b13 + eCapTL * eMatTL)) data$dmpLabMatTL = with(data, (qOutTL / qLab * qMat) * (b23 + eLabTL * qMat)) ## Quasiconcavity data$quasiConcTL = NA for(obs in 1:nrow(data)) { hmLoop = matrix(0, nrow = 3, ncol = 3) hmLoop[1,1] = data$dmpCapCapTL[obs] hmLoop[1,2] = hmLoop[2,1] = data$dmpCapLabTL[obs] hmLoop[1,3] = hmLoop[3,1] = data$dmpCapMatTL[obs] hmLoop[2,2] = data$dmpLabLabTL[obs] hmLoop[2,3] = hmLoop[3,2] = data$dmpLabMatTL[obs] hmLoop[3,3] = data$dmpMatMatTL[obs] data$quasiConcTL[obs] = hmLoop[1,1] < 0 & det(hmLoop[1:2,1:2] > 0) & det(hmLoop < 0) } sum(!data$quasiConcTL) [1] 126
With this information I can extend the information from the last table in the first part of the post:
Quadratic | Translog | |
---|---|---|
\(R^2\) on \(y\) | 0.85 | 0.77 |
\(R^2\) on \(ln(y)\) | 0.55 | 0.63 |
Obs. with negative predicted output | 0 | 0 |
Obs. that violate the monotonicity condition | 39 | 48 |
Obs. with negative scale elasticity | 22 | 0 |
Obs. that violate the quasiconcavity condition | 140 | 126 |
\(\Longrightarrow\) Now I have more evidence in favour of a different approach as it was mentioned at the end of the first part of the post.
Non-parametric regression
A non-parametric model is of the form:
The advantages are: The functional form is not defined beforehand Obtains a best fit function \(m\) from the data * Obtains marginal effects
The disadvantages are: Higher computational cost There are no regression coefficients (the focus is the regression function) * Hard to interpret
Single variable non-parametric regression
I can predict the output by using capital as the only input:
library(KernSmooth) qCap = as.vector(data$qCap) qOut = as.vector(data$qOut) bw = dpill(qCap,qOut) fit1 = locpoly(qCap, qOut, bandwidth = bw, degree = 1) # 1st degree polynomial plot(fit1$x, fit1$y, type = "l")
Here are different specifications:
# 2nd degree polynomial fit2.1 <- locpoly(qCap, qOut, bandwidth = bw, degree = 2) fit2.2 <- locpoly(qCap, qOut, bandwidth = bw*2, degree = 2) # less variance / more bias fit2.3 <- locpoly(qCap, qOut, bandwidth = bw/2, degree = 2) # more variance / less bias # linear regression fit.lm <- lm(qOut ~ qCap) # plots plot(fit1$x, fit1$y, type = "l");par(mfrow=c(2,2)) plot(fit1$x, fit1$y, type = "l");lines(fit2.1, col = "blue") plot(fit1$x, fit1$y, type = "l");lines(fit2.2, col = "red") plot(fit1$x, fit1$y, type = "l");lines(fit2.3, col = "green") plot(fit1$x, fit1$y, type = "l");abline(fit.lm, col = "purple")
Checking the models:
# model 1 sum(is.na(fit1$y)) [1] 50 # models 2, 3 y 4 sum(is.na(fit2.1$y)) [1] 50 sum(is.na(fit2.2$y)) [1] 9 sum(is.na(fit2.3$y)) [1] 84
\(\Longrightarrow\) I should use model 2.2 and adjust it.
I’ll try with a neoclassical function with diminishing marginal returns:
# se ajusta la banda y el grado fit.sqrt = locpoly(qCap, qOut, bandwidth = bw*3, degree = 0.5) sum(is.na(fit.sqrt$y)) [1] 0 sum(fit.sqrt$y < 0) [1] 0
\(\Longrightarrow\) In this model there is no indetermined or negative predicted output.
plot(fit.sqrt$x, fit.sqrt$y, type = "l")
I can obtain the median productivity:
median(fit.sqrt$y)/median(fit.sqrt$x) [1] 18.05637
\(\Longrightarrow\) In median term each capital unit increases the output in 18 units.
If I adjust the bandwidth the function will look more and more like a neoclassical function from textbooks, with an initial part of increasing marginal returns and from the point where marginal and median productivities are equal (the same point where marginal productivity is at maximum) the return becomes increasing at decreasing scale.
This is an example of the last paragraph:
fit.sqrt.2 = locpoly(qCap, qOut, bandwidth = bw*5, degree = 0.5) plot(fit.sqrt.2$x, fit.sqrt.2$y, type = "l")
Multivariable non-parametric regression
Among many alternatives, Epanechnikov’s method is a non-parametric method that weights the contribution of each observation and iterating obtains the best fit function.
I’ll fit a regression applying logs to the variables:
library(np) options(np.messages=FALSE) prodNP = npreg(log(qOut) ~ log(qCap) + log(qLab) + log(qMat), regtype = "ll", bwmethod = "cv.aic", ckertype = "epanechnikov", data = data, gradients = TRUE) summary(prodNP) Regression Data: 140 training points, in 3 variable(s) log(qCap) log(qLab) log(qMat) Bandwidth(s): 1.039647 332644 0.8418465 Kernel Regression Estimator: Local-Linear Bandwidth Type: Fixed Residual standard error: 0.6227669 R-squared: 0.6237078 Continuous Kernel Type: Second-Order Epanechnikov No. Continuous Explanatory Vars.: 3
These are the regression plots:
I can test the significance for this model:
options(np.messages=FALSE) npsigtest(prodNP) Kernel Regression Significance Test Type I Test with IID Bootstrap (399 replications, Pivot = TRUE, joint = FALSE) Explanatory variables tested for significance: log(qCap) (1), log(qLab) (2), log(qMat) (3) log(qCap) log(qLab) log(qMat) Bandwidth(s): 1.039647 332644 0.8418465 Individual Significance Tests P Value: log(qCap) 0.11779 log(qLab) < 2e-16 *** log(qMat) < 2e-16 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
\(\Longrightarrow\) at 10% of significance the only variable with non-statistical significant effects is capital.
Finally I can obtain information about Product-Factor Elasticity and Scale Elasticity:
summary(gradients(prodNP)[,1]) # capital elasticity Min. 1st Qu. Median Mean 3rd Qu. Max. -0.10300 0.08598 0.14360 0.14500 0.18810 0.30060 summary(gradients(prodNP)[,2]) # labour elasticity Min. 1st Qu. Median Mean 3rd Qu. Max. 0.02208 0.63050 0.69880 0.70970 0.80670 0.97890 summary(gradients(prodNP)[,3]) # materials elasticity Min. 1st Qu. Median Mean 3rd Qu. Max. 0.3873 0.4546 0.5669 0.5850 0.6502 1.3480 summary(rowSums(gradients(prodNP))) # scale elasticity Min. 1st Qu. Median Mean 3rd Qu. Max. 1.267 1.363 1.416 1.440 1.479 1.880 par(mfrow=c(2,2)) hist(gradients(prodNP)[,1], main = "Capital") hist(gradients(prodNP)[,2], main = "Labour") hist(gradients(prodNP)[,3], main = "Materials") hist(rowSums(gradients(prodNP)), main = "Scale")
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.