Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Computational Econometrics: Aggregate Demand with Random Parameters:

From microeconomics we know that individuals and firms have demand curves for goods and services. But what happens when you try to get a picture of the demand for goods and services for the entire economy?

While this task may at first seem daunting, there is a relatively simple way to perform it by using the aggregate demand curve. The aggregate demand curve represents the total demand for goods and services in an economy.

By defining the aggregate demand curve in terms of the price level and output or income, it is possible to analyze the effects of other variables, like the interest rate, on aggregate demand through the aggregate demand equation.

The random parameters model is defined in terms of the density of the observed random variable and the structural parameters in the model.

Code:

#Demand Equation
q = function(b,p){sqrt( (b-p)*(b+p) )/p}

#Mean of the random parameter for each demand equation
betas = c(1.430,1.120,2.100,1.380)

#Covariance of random parameters for each demand equation
cov = c(3.450, 1.510, 5.901, 0.205,
1.510, 1.970, 4.543, 0.557,
5.901, 4.543, 115.000, 10.579,
0.205, 0.557, 10.579, 4.840 )

B = matrix(betas,ncol=4)
C = matrix(cov, ncol=4)

#correlation matrix
dv = t(1/sqrt(diag(C)))
cr = C * (t(dv) %*% dv)

library(mvtnorm)

#Draw 10,000 random parameters from the multivariate normal and select the
#first parameter for the first demand equation
R=10000
B1 = rmvnorm(R, mean = B, sigma = C)[,1]*100

#Verify the mean of the random parameter
round(mean(B1)/100,2)

#Create 10,000 demand equations and set the negative demands to zero
q1 = q(B1,10)
q1[ is.na(q1) ] = 0

#Calculate the demand at prices 1 to 450 for each demand equation to create
#a horizontally summed aggregate demand curve
P=450
qall = c(1:P)
options(warn = -1)
for(i in 1:P)
{
q1 = q(B1,i)
q1[ is.na(q1) ] = 0
qall = cbind(qall,q1)
}
options(warn = 0)

#Check the mean individual demand and the aggregate demand
colMeans(qall)[2:(P+1)]
colSums(qall)[2:(P+1)]

#Plot the mean individual demand
plot(colMeans(qall)[-1],c(1:P),xlim=c(0,6),type=’l’)

#Plot the aggregate demand
plot(colSums(qall)[-1],c(1:P),xlim=c(0,6*R),type=’l’)

#Plot the lower 95 quantile individual demand
#plot(sapply(qall[, -1], quantile, 0.05),c(1:P),xlim=c(0,6*R),type=’l’)

Output:

> #Demand Equation
> q = function(b,p){sqrt( (b-p)*(b+p) )/p}
>
> #Mean of the random parameter for each demand equation
> betas = c(1.430,1.120,2.100,1.380)
>
> #Covariance of random parameters for each demand equation
> cov = c(3.450, 1.510, 5.901, 0.205,
+ 1.510, 1.970, 4.543, 0.557,
+ 5.901, 4.543, 115.000, 10.579,
+ 0.205, 0.557, 10.579, 4.840 )
>
> B = matrix(betas,ncol=4)
> C = matrix(cov, ncol=4)
>
> #correlation matrix
> dv = t(1/sqrt(diag(C)))
> cr = C * (t(dv) %*% dv)
>
> library(mvtnorm)
>
> #Draw 10,000 random parameters from the multivariate normal and select the
> #first parameter for the first demand equation
> R=10000
> B1 = rmvnorm(R, mean = B, sigma = C)[,1]*100
>
> #Verify the mean of the random parameter
> round(mean(B1)/100,2)
[1] 1.43
>
> #Create 10,000 demand equations and set the negative demands to zero
> q1 = q(B1,10)
Warning message:
In sqrt((b – p) * (b + p)) : NaNs produced
> q1[ is.na(q1) ] = 0
>
> #Calculate the demand at prices 1 to 450 for each demand equation to create
> #a horizontally summed aggregate demand curve
> P=450
> qall = c(1:P)
> options(warn = -1)
> for(i in 1:P)
+ {
+ q1 = q(B1,i)
+ q1[ is.na(q1) ] = 0
+ qall = cbind(qall,q1)
+ }
> options(warn = 0)
>
> #Check the mean individual demand and the aggregate demand
> colMeans(qall)[2:(P+1)]
q1 q1 q1 q1 q1 q1
190.05460232 95.01350254 63.32852684 47.48233499 37.97193686 31.62986802
q1 q1 q1 q1 q1 q1
27.09823296 23.69845581 21.05305001 18.93575173 17.20228794 15.75701188
q1 q1 q1 q1 q1 q1
14.53348483 13.48402518 12.57388860 11.77679552 11.07321069 10.44728719
q1 q1 q1 q1 q1 q1
9.88695937 9.38213556 8.92520749 8.50929336 8.12931672 7.78086847
q1 q1 q1 q1 q1 q1
7.46002577 7.16360078 6.88876570 6.63347103 6.39550741 6.17323995
q1 q1 q1 q1 q1 q1
5.96505074 5.76968659 5.58586593 5.41281571 5.24939614 5.09502092
q1 q1 q1 q1 q1 q1
4.94871509 4.80999911 4.67830207 4.55312796 4.43395694 4.32036392
q1 q1 q1 q1 q1 q1
4.21187614 4.10815191 4.00877567 3.91368947 3.82252791 3.73526737
q1 q1 q1 q1 q1 q1
3.65150322 3.57089416 3.49356111 3.41894457 3.34702726 3.27767260
q1 q1 q1 q1 q1 q1
3.21067508 3.14613453 3.08379923 3.02347641 2.96509609 2.90879246
q1 q1 q1 q1 q1 q1
2.85425608 2.80148081 2.75020272 2.70057907 2.65247912 2.60567132
q1 q1 q1 q1 q1 q1
2.56027781 2.51601790 2.47294157 2.43118532 2.39050058 2.35074918
q1 q1 q1 q1 q1 q1
2.31205723 2.27441538 2.23768708 2.20187747 2.16719965 2.13336870
q1 q1 q1 q1 q1 q1
2.10037506 2.06822388 2.03682396 2.00608840 1.97607258 1.94661935
q1 q1 q1 q1 q1 q1
1.91794845 1.88994756 1.86256657 1.83561748 1.80928480 1.78344980
q1 q1 q1 q1 q1 q1
1.75828599 1.73371584 1.70961851 1.68609547 1.66299824 1.64034312
q1 q1 q1 q1 q1 q1
1.61808242 1.59627769 1.57490761 1.55394965 1.53341752 1.51323540
q1 q1 q1 q1 q1 q1
1.49341910 1.47394157 1.45486365 1.43612338 1.41773761 1.39961322
q1 q1 q1 q1 q1 q1
1.38191228 1.36458069 1.34754635 1.33074638 1.31424807 1.29802061
q1 q1 q1 q1 q1 q1
1.28205735 1.26635492 1.25091564 1.23582511 1.22094512 1.20629097
q1 q1 q1 q1 q1 q1
1.19175656 1.17752830 1.16348690 1.14958804 1.13599018 1.12254135
q1 q1 q1 q1 q1 q1
1.10931849 1.09636918 1.08359008 1.07095984 1.05858027 1.04632203
q1 q1 q1 q1 q1 q1
1.03420575 1.02229963 1.01062002 0.99910726 0.98769169 0.97641718
q1 q1 q1 q1 q1 q1
0.96541869 0.95456579 0.94382322 0.93326042 0.92285970 0.91260497
q1 q1 q1 q1 q1 q1
0.90248222 0.89247138 0.88254724 0.87273503 0.86305658 0.85351351
q1 q1 q1 q1 q1 q1
0.84406225 0.83467673 0.82538736 0.81629111 0.80736848 0.79855084
q1 q1 q1 q1 q1 q1
0.78987211 0.78132107 0.77283207 0.76441879 0.75611740 0.74792094
q1 q1 q1 q1 q1 q1
0.73984487 0.73188901 0.72396932 0.71613004 0.70844009 0.70082319
q1 q1 q1 q1 q1 q1
0.69326871 0.68588731 0.67862308 0.67140515 0.66422555 0.65716878
q1 q1 q1 q1 q1 q1
0.65020860 0.64329757 0.63651894 0.62979975 0.62317676 0.61658785
q1 q1 q1 q1 q1 q1
0.61007311 0.60363729 0.59721624 0.59091634 0.58459490 0.57835674
q1 q1 q1 q1 q1 q1
0.57221827 0.56615650 0.56012390 0.55409751 0.54818729 0.54235904
q1 q1 q1 q1 q1 q1
0.53664112 0.53098816 0.52537713 0.51985888 0.51442536 0.50899732
q1 q1 q1 q1 q1 q1
0.50368075 0.49847750 0.49334248 0.48823335 0.48315687 0.47808584
q1 q1 q1 q1 q1 q1
0.47307644 0.46812477 0.46320555 0.45831386 0.45340448 0.44863949
q1 q1 q1 q1 q1 q1
0.44394289 0.43926223 0.43467439 0.43011225 0.42562359 0.42118037
q1 q1 q1 q1 q1 q1
0.41678561 0.41247115 0.40812005 0.40391027 0.39967768 0.39546915
q1 q1 q1 q1 q1 q1
0.39129682 0.38720116 0.38308115 0.37901752 0.37499012 0.37098689
q1 q1 q1 q1 q1 q1
0.36706360 0.36317452 0.35937318 0.35560109 0.35186005 0.34813046
q1 q1 q1 q1 q1 q1
0.34446627 0.34080925 0.33717030 0.33360343 0.33008747 0.32662124
q1 q1 q1 q1 q1 q1
0.32315253 0.31976166 0.31635554 0.31304615 0.30975763 0.30643560
q1 q1 q1 q1 q1 q1
0.30316620 0.29995866 0.29677884 0.29361578 0.29044195 0.28732305
q1 q1 q1 q1 q1 q1
0.28422394 0.28114971 0.27810420 0.27513540 0.27214717 0.26916577
q1 q1 q1 q1 q1 q1
0.26624345 0.26333022 0.26040877 0.25756235 0.25471010 0.25189257
q1 q1 q1 q1 q1 q1
0.24911605 0.24639758 0.24372304 0.24106633 0.23845294 0.23584009
q1 q1 q1 q1 q1 q1
0.23327898 0.23071151 0.22815219 0.22563053 0.22317154 0.22075285
q1 q1 q1 q1 q1 q1
0.21839005 0.21598065 0.21360444 0.21126447 0.20895325 0.20663343
q1 q1 q1 q1 q1 q1
0.20431767 0.20209678 0.19988637 0.19770756 0.19552590 0.19336254
q1 q1 q1 q1 q1 q1
0.19123506 0.18911913 0.18695634 0.18480118 0.18269451 0.18065309
q1 q1 q1 q1 q1 q1
0.17860472 0.17656643 0.17457842 0.17267671 0.17075759 0.16882733
q1 q1 q1 q1 q1 q1
0.16694858 0.16506141 0.16318761 0.16132498 0.15946974 0.15763484
q1 q1 q1 q1 q1 q1
0.15575711 0.15394381 0.15221802 0.15052505 0.14882810 0.14714138
q1 q1 q1 q1 q1 q1
0.14543197 0.14373850 0.14206934 0.14038480 0.13869912 0.13704400
q1 q1 q1 q1 q1 q1
0.13543576 0.13381468 0.13224363 0.13069736 0.12915203 0.12758487
q1 q1 q1 q1 q1 q1
0.12605535 0.12451808 0.12299373 0.12149950 0.12002444 0.11854625
q1 q1 q1 q1 q1 q1
0.11705265 0.11558725 0.11412997 0.11274005 0.11139159 0.11005239
q1 q1 q1 q1 q1 q1
0.10869398 0.10732952 0.10599582 0.10472572 0.10341426 0.10213424
q1 q1 q1 q1 q1 q1
0.10088216 0.09963996 0.09843359 0.09726645 0.09606456 0.09486547
q1 q1 q1 q1 q1 q1
0.09373415 0.09258822 0.09148102 0.09039073 0.08931631 0.08822985
q1 q1 q1 q1 q1 q1
0.08717005 0.08610465 0.08506129 0.08404660 0.08302998 0.08204196
q1 q1 q1 q1 q1 q1
0.08108307 0.08008819 0.07912481 0.07819798 0.07729672 0.07637316
q1 q1 q1 q1 q1 q1
0.07543889 0.07450608 0.07360504 0.07269803 0.07179925 0.07091512
q1 q1 q1 q1 q1 q1
0.07005997 0.06922174 0.06836835 0.06753630 0.06671234 0.06590616
q1 q1 q1 q1 q1 q1
0.06508476 0.06426517 0.06346027 0.06267504 0.06191845 0.06115696
q1 q1 q1 q1 q1 q1
0.06042478 0.05971882 0.05899325 0.05827373 0.05757782 0.05687970
q1 q1 q1 q1 q1 q1
0.05619947 0.05551318 0.05484533 0.05418864 0.05352831 0.05286856
q1 q1 q1 q1 q1 q1
0.05221175 0.05156000 0.05093335 0.05028685 0.04965687 0.04903190
q1 q1 q1 q1 q1 q1
0.04841988 0.04778567 0.04714577 0.04652265 0.04592222 0.04531476
q1 q1 q1 q1 q1 q1
0.04470911 0.04411056 0.04354897 0.04301398 0.04249378 0.04196135
q1 q1 q1 q1 q1 q1
0.04144321 0.04093177 0.04042602 0.03991385 0.03939268 0.03890573
q1 q1 q1 q1 q1 q1
0.03843651 0.03796892 0.03748717 0.03700972 0.03653364 0.03607370
q1 q1 q1 q1 q1 q1
0.03559022 0.03511524 0.03464760 0.03417320 0.03370149 0.03322445
q1 q1 q1 q1 q1 q1
0.03277381 0.03231594 0.03185581 0.03140833 0.03095458 0.03052093
q1 q1 q1 q1 q1 q1
0.03009995 0.02966186 0.02923316 0.02881084 0.02842384 0.02803593
q1 q1 q1 q1 q1 q1
0.02763355 0.02725107 0.02688059 0.02650550 0.02612619 0.02573279
> colSums(qall)[2:(P+1)]
q1 q1 q1 q1 q1 q1
1900546.0232 950135.0254 633285.2684 474823.3499 379719.3686 316298.6802
q1 q1 q1 q1 q1 q1
270982.3296 236984.5581 210530.5001 189357.5173 172022.8794 157570.1188
q1 q1 q1 q1 q1 q1
145334.8483 134840.2518 125738.8860 117767.9552 110732.1069 104472.8719
q1 q1 q1 q1 q1 q1
98869.5937 93821.3556 89252.0749 85092.9336 81293.1672 77808.6847
q1 q1 q1 q1 q1 q1
74600.2577 71636.0078 68887.6570 66334.7103 63955.0741 61732.3995
q1 q1 q1 q1 q1 q1
59650.5074 57696.8659 55858.6593 54128.1571 52493.9614 50950.2092
q1 q1 q1 q1 q1 q1
49487.1509 48099.9911 46783.0207 45531.2796 44339.5694 43203.6392
q1 q1 q1 q1 q1 q1
42118.7614 41081.5191 40087.7567 39136.8947 38225.2791 37352.6737
q1 q1 q1 q1 q1 q1
36515.0322 35708.9416 34935.6111 34189.4457 33470.2726 32776.7260
q1 q1 q1 q1 q1 q1
32106.7508 31461.3453 30837.9923 30234.7641 29650.9609 29087.9246
q1 q1 q1 q1 q1 q1
28542.5608 28014.8081 27502.0272 27005.7907 26524.7912 26056.7132
q1 q1 q1 q1 q1 q1
25602.7781 25160.1790 24729.4157 24311.8532 23905.0058 23507.4918
q1 q1 q1 q1 q1 q1
23120.5723 22744.1538 22376.8708 22018.7747 21671.9965 21333.6870
q1 q1 q1 q1 q1 q1
21003.7506 20682.2388 20368.2396 20060.8840 19760.7258 19466.1935
q1 q1 q1 q1 q1 q1
19179.4845 18899.4756 18625.6657 18356.1748 18092.8480 17834.4980
q1 q1 q1 q1 q1 q1
17582.8599 17337.1584 17096.1851 16860.9547 16629.9824 16403.4312
q1 q1 q1 q1 q1 q1
16180.8242 15962.7769 15749.0761 15539.4965 15334.1752 15132.3540
q1 q1 q1 q1 q1 q1
14934.1910 14739.4157 14548.6365 14361.2338 14177.3761 13996.1322
q1 q1 q1 q1 q1 q1
13819.1228 13645.8069 13475.4635 13307.4638 13142.4807 12980.2061
q1 q1 q1 q1 q1 q1
12820.5735 12663.5492 12509.1564 12358.2511 12209.4512 12062.9097
q1 q1 q1 q1 q1 q1
11917.5656 11775.2830 11634.8690 11495.8804 11359.9018 11225.4135
q1 q1 q1 q1 q1 q1
11093.1849 10963.6918 10835.9008 10709.5984 10585.8027 10463.2203
q1 q1 q1 q1 q1 q1
10342.0575 10222.9963 10106.2002 9991.0726 9876.9169 9764.1718
q1 q1 q1 q1 q1 q1
9654.1869 9545.6579 9438.2322 9332.6042 9228.5970 9126.0497
q1 q1 q1 q1 q1 q1
9024.8222 8924.7138 8825.4724 8727.3503 8630.5658 8535.1351
q1 q1 q1 q1 q1 q1
8440.6225 8346.7673 8253.8736 8162.9111 8073.6848 7985.5084
q1 q1 q1 q1 q1 q1
7898.7211 7813.2107 7728.3207 7644.1879 7561.1740 7479.2094
q1 q1 q1 q1 q1 q1
7398.4487 7318.8901 7239.6932 7161.3004 7084.4009 7008.2319
q1 q1 q1 q1 q1 q1
6932.6871 6858.8731 6786.2308 6714.0515 6642.2555 6571.6878
q1 q1 q1 q1 q1 q1
6502.0860 6432.9757 6365.1894 6297.9975 6231.7676 6165.8785
q1 q1 q1 q1 q1 q1
6100.7311 6036.3729 5972.1624 5909.1634 5845.9490 5783.5674
q1 q1 q1 q1 q1 q1
5722.1827 5661.5650 5601.2390 5540.9751 5481.8729 5423.5904
q1 q1 q1 q1 q1 q1
5366.4112 5309.8816 5253.7713 5198.5888 5144.2536 5089.9732
q1 q1 q1 q1 q1 q1
5036.8075 4984.7750 4933.4248 4882.3335 4831.5687 4780.8584
q1 q1 q1 q1 q1 q1
4730.7644 4681.2477 4632.0555 4583.1386 4534.0448 4486.3949
q1 q1 q1 q1 q1 q1
4439.4289 4392.6223 4346.7439 4301.1225 4256.2359 4211.8037
q1 q1 q1 q1 q1 q1
4167.8561 4124.7115 4081.2005 4039.1027 3996.7768 3954.6915
q1 q1 q1 q1 q1 q1
3912.9682 3872.0116 3830.8115 3790.1752 3749.9012 3709.8689
q1 q1 q1 q1 q1 q1
3670.6360 3631.7452 3593.7318 3556.0109 3518.6005 3481.3046
q1 q1 q1 q1 q1 q1
3444.6627 3408.0925 3371.7030 3336.0343 3300.8747 3266.2124
q1 q1 q1 q1 q1 q1
3231.5253 3197.6166 3163.5554 3130.4615 3097.5763 3064.3560
q1 q1 q1 q1 q1 q1
3031.6620 2999.5866 2967.7884 2936.1578 2904.4195 2873.2305
q1 q1 q1 q1 q1 q1
2842.2394 2811.4971 2781.0420 2751.3540 2721.4717 2691.6577
q1 q1 q1 q1 q1 q1
2662.4345 2633.3022 2604.0877 2575.6235 2547.1010 2518.9257
q1 q1 q1 q1 q1 q1
2491.1605 2463.9758 2437.2304 2410.6633 2384.5294 2358.4009
q1 q1 q1 q1 q1 q1
2332.7898 2307.1151 2281.5219 2256.3053 2231.7154 2207.5285
q1 q1 q1 q1 q1 q1
2183.9005 2159.8065 2136.0444 2112.6447 2089.5325 2066.3343
q1 q1 q1 q1 q1 q1
2043.1767 2020.9678 1998.8637 1977.0756 1955.2590 1933.6254
q1 q1 q1 q1 q1 q1
1912.3506 1891.1913 1869.5634 1848.0118 1826.9451 1806.5309
q1 q1 q1 q1 q1 q1
1786.0472 1765.6643 1745.7842 1726.7671 1707.5759 1688.2733
q1 q1 q1 q1 q1 q1
1669.4858 1650.6141 1631.8761 1613.2498 1594.6974 1576.3484
q1 q1 q1 q1 q1 q1
1557.5711 1539.4381 1522.1802 1505.2505 1488.2810 1471.4138
q1 q1 q1 q1 q1 q1
1454.3197 1437.3850 1420.6934 1403.8480 1386.9912 1370.4400
q1 q1 q1 q1 q1 q1
1354.3576 1338.1468 1322.4363 1306.9736 1291.5203 1275.8487
q1 q1 q1 q1 q1 q1
1260.5535 1245.1808 1229.9373 1214.9950 1200.2444 1185.4625
q1 q1 q1 q1 q1 q1
1170.5265 1155.8725 1141.2997 1127.4005 1113.9159 1100.5239
q1 q1 q1 q1 q1 q1
1086.9398 1073.2952 1059.9582 1047.2572 1034.1426 1021.3424
q1 q1 q1 q1 q1 q1
1008.8216 996.3996 984.3359 972.6645 960.6456 948.6547
q1 q1 q1 q1 q1 q1
937.3415 925.8822 914.8102 903.9073 893.1631 882.2985
q1 q1 q1 q1 q1 q1
871.7005 861.0465 850.6129 840.4660 830.2998 820.4196
q1 q1 q1 q1 q1 q1
810.8307 800.8819 791.2481 781.9798 772.9672 763.7316
q1 q1 q1 q1 q1 q1
754.3889 745.0608 736.0504 726.9803 717.9925 709.1512
q1 q1 q1 q1 q1 q1
700.5997 692.2174 683.6835 675.3630 667.1234 659.0616
q1 q1 q1 q1 q1 q1
650.8476 642.6517 634.6027 626.7504 619.1845 611.5696
q1 q1 q1 q1 q1 q1
604.2478 597.1882 589.9325 582.7373 575.7782 568.7970
q1 q1 q1 q1 q1 q1
561.9947 555.1318 548.4533 541.8864 535.2831 528.6856
q1 q1 q1 q1 q1 q1
522.1175 515.6000 509.3335 502.8685 496.5687 490.3190
q1 q1 q1 q1 q1 q1
484.1988 477.8567 471.4577 465.2265 459.2222 453.1476
q1 q1 q1 q1 q1 q1
447.0911 441.1056 435.4897 430.1398 424.9378 419.6135
q1 q1 q1 q1 q1 q1
414.4321 409.3177 404.2602 399.1385 393.9268 389.0573
q1 q1 q1 q1 q1 q1
384.3651 379.6892 374.8717 370.0972 365.3364 360.7370
q1 q1 q1 q1 q1 q1
355.9022 351.1524 346.4760 341.7320 337.0149 332.2445
q1 q1 q1 q1 q1 q1
327.7381 323.1594 318.5581 314.0833 309.5458 305.2093
q1 q1 q1 q1 q1 q1
300.9995 296.6186 292.3316 288.1084 284.2384 280.3593
q1 q1 q1 q1 q1 q1
276.3355 272.5107 268.8059 265.0550 261.2619 257.3279
>
> #Plot the mean individual demand
> filename <- paste(tempfile(tmpdir=”C:/R/tmp”), “.png”, sep=”“)
> png(file=filename)
[1] “C:/R/tmp\file50bc3052.png”

>
> #Plot the aggregate demand
> filename <- paste(tempfile(tmpdir=”C:/R/tmp”), “.png”, sep=”“)
> png(file=filename)
[1] “C:/R/tmp\file6f484a11.png”

>
> #Plot the lower 95 quantile individual demand
> #plot(sapply(qall[, -1], quantile, 0.05),c(1:P),xlim=c(0,6*R),type=”l”)
>