Skip to content

Commit

Permalink
version 0.6-20
Browse files Browse the repository at this point in the history
  • Loading branch information
@arne-henningsen @cran-robot
arne-henningsen authored and cran-robot committed May 20, 2022
1 parent 38fb46a commit e52cbd8
Show file tree
Hide file tree
Showing 18 changed files with 167 additions and 83 deletions.
8 changes: 4 additions & 4 deletions DESCRIPTION
View file
@@ -1,6 +1,6 @@
Package: micEconAids
Version: 0.6-18
Date: 2017-03-16
Version: 0.6-20
Date: 2022-05-20
Title: Demand Analysis with the Almost Ideal Demand System (AIDS)
Author: Arne Henningsen
Maintainer: Arne Henningsen <arne.henningsen@gmail.com>
Expand All @@ -13,6 +13,6 @@ Description: Functions and tools
License: GPL (>= 2)
URL: http://www.micEcon.org
NeedsCompilation: no
Packaged: 2017-03-16 12:31:43 UTC; arne
Packaged: 2022-05-20 11:14:57 UTC; gsl324
Repository: CRAN
Date/Publication: 2017-03-16 13:49:05 UTC
Date/Publication: 2022-05-20 12:10:02 UTC
34 changes: 17 additions & 17 deletions MD5
View file
@@ -1,32 +1,32 @@
05e939a4de4c33ed9a07ac1b3ae028e2 *DESCRIPTION
748cf1d56b0dc08f59886013691f3d40 *DESCRIPTION
b73cf4701a1ead3e3aaf039ccc05effa *NAMESPACE
6634cf001b9efab6242a8c232fced1d7 *NEWS
75b416f1ba2e6f42151fce735aa3fecd *NEWS
062af0c5ee0c62e7b69692e0846e3f8a *R/aidsBestA0.R
f460e045c9fd979a02296a0acbf9b017 *R/aidsCalc.R
42ca5dcb6fc157958d1c205e9e14d9cc *R/aidsCalc.R
1cd2745d7e50d405d1342717d8447e4e *R/aidsCheckCoef.R
e662b7cad06508c5d5087ddbea0fdcff *R/aidsCoef.R
a882469a88d51d3a8dd14809f908b073 *R/aidsCoefNames.R
a62bd027f655e5ec643ad0f0d5ead3d9 *R/aidsConcav.R
f04773e8bbdf09a70dd08c7a44156f3b *R/aidsConsist.R
028ec18d1d9bf36e99c2eba89d90ffaa *R/aidsElas.R
bbbce70f76729061d59aac627781f4e8 *R/aidsElasJacobian.R
6bb299aed25c7dd3d6410d293809825a *R/aidsEst.R
f5ec7cced1d5ddd4fa1261ec7beaa63e *R/aidsElas.R
8383520fbd97f7cd38246998501d6237 *R/aidsElasJacobian.R
c612445e701fc4546241021dbf880b66 *R/aidsEst.R
710a73965559a2f23d0ba2efb0d60310 *R/aidsEstMethod.R
11a4e90718ec8dad23e60bfa74b8396f *R/aidsJacobian.R
a821ad54d89b22f5573a4abfe195c796 *R/aidsMono.R
04a20cd944717130ac180e8aa5144aa0 *R/aidsPx.R
26d445e6ebf77e27d8287150f618a66d *R/aidsPx.R
44921153edadb5ffec96ae750b321297 *R/aidsRestr.R
a40c542ae27313773444cd0ce0f205dd *R/aidsSystem.R
ce5687da75e65c096bc6b82083a67066 *R/aidsUtility.R
722773c53695a8fb9ebe0f3cefdca61e *R/aidsUtilityDeriv.R
a5469649db463ac892ec3c57576d68c2 *R/aidsUtility.R
544274a6668dff88164a68fb12affc5a *R/aidsUtilityDeriv.R
5f9531d18a1c270f3a011fed390554ef *R/aidsUtils.R
a5a92c02b02ec053cb195117ae713f18 *R/checkConsist.R
fbfffd2e9deea9f1f8b2d632ca99c525 *R/coef.aidsEst.R
bc6959161938fe7b2b6fa2faf4ff1803 *R/df.residual.aidsEst.R
800cf7bcb67b01e7e601a1698d34ad81 *R/elas.aidsEst.R
120ae171328f9557a9c8fb3415cfbf93 *R/elas.aidsEst.R
4a038fb940229adee371e43d01b164be *R/fitted.aidsEst.R
2a4454fac8d7dc0121f50ac739208096 *R/logLik.aidsEst.R
e6a88a59e004539d114e1c67f5653439 *R/lrtest.aidsEst.R
7f7811efb3e1c91796a3fcff80c08f83 *R/lrtest.aidsEst.R
3f0face7f835ab1a1eb3d07880b1d9e6 *R/nobs.aidsEst.R
9d61df5d6b2131e2f96f5996ebe5121f *R/predict.aidsEst.R
3b707ff504f7e69e1fe2adc6215f5af3 *R/print.aidsConcav.R
Expand All @@ -40,20 +40,20 @@ ea4911f74742541ad12db565e1206405 *R/print.coef.aidsEst.R
7d427a7466fca930d96a8529eceee2b3 *R/summary.aidsElas.R
2355c8840b9a698e316aa957a7f906b6 *R/summary.aidsEst.R
f7e2bba896b479c03bdb2c966f091928 *R/vcov.aidsEst.R
4eefdfc72d965234c3b92932bfdac81a *build/vignette.rds
e56cd5cd2f8b28119cfd38e85fb1f1d1 *build/vignette.rds
1c4cc6b669bd2984a8cca4b0bdd1417e *data/Blanciforti86.txt.gz
2f4ac606b78c969229bae7df2f1a8ff6 *data/USMeatConsump.tab.gz
b38781ec025e56c725347156d6612f65 *inst/doc/micEconAids_vignette.R
dbf4c018e174c060f111d145f022d40a *inst/doc/micEconAids_vignette.R
fe9c5dbbaa9e145cffdf82e76b364855 *inst/doc/micEconAids_vignette.Rnw
41d5d53b8a330f8c1bf9b873f4dcf23c *inst/doc/micEconAids_vignette.pdf
bbbea4184240bce4e5fa0d457c45d71b *inst/doc/micEconAids_vignette.pdf
debc36fede27d94b569eedd2910be37e *man/Blanciforti86.Rd
0cf5f6250228cf19cea5b8cdae7ac7ca *man/USMeatConsump.Rd
dc66fa6bdcfac0d58f8244e5b8dc8b52 *man/aidsBestA0.Rd
58d84dadaf12b034ee1c312d38859fd7 *man/aidsCalc.Rd
4697c05ef696ac068972959e13b5fbd4 *man/aidsCalc.Rd
b687e759b37ab74130feef9230b87d12 *man/aidsConcav.Rd
b573ed664ed59dbccaf73421209d8d4e *man/aidsConsist.Rd
df871ba90f6dc44cea8676d313df175c *man/aidsElas.Rd
06db391cf857941438700de5595fdb5f *man/aidsEst.Rd
b8b58349187d323c0298252b87a816b6 *man/aidsElas.Rd
a33a7d5a36fd88ada68ee3a7b8fb5256 *man/aidsEst.Rd
df59b3fa54e9af0f6186d6495eb9d5c0 *man/aidsMono.Rd
fbc0c6b0d0e556228700286efacbcda2 *man/aidsPx.Rd
dc0d2d8afc6be308d770435254855556 *man/aidsUtility.Rd
Expand Down
10 changes: 8 additions & 2 deletions NEWS
View file
Expand Up @@ -5,6 +5,12 @@ A full ChangeLog is available in the log messages of the SVN repository
on R-Forge.


CHANGES IN VERSION 0.6-20 (2022-05-20)

* demand elasticities can now also be calculated if the model was estimated
with shifter variables


CHANGES IN VERSION 0.6-18 (2017-03-16)

* added a 'vignette'
Expand All @@ -23,8 +29,8 @@ imports these packages

CHANGES IN VERSION 0.6-12 (2012-12-26)

* corrected dependencies: replaced "R (>= 2.4.0)" and "stats (>= 2.15.0)"
(where the latter implies "R (>= 2.15.0)") by "R (>= 2.14.0)" and "stats"
* corrected dependencies: replaced "R (>= 2.4.0)" and "stats (>= 2.15.0)"
(where the latter implies "R (>= 2.15.0)") by "R (>= 2.14.0)" and "stats"
(without version number), because R/stats 2.14.0 is sufficient


Expand Down
57 changes: 45 additions & 12 deletions R/aidsCalc.R
View file
@@ -1,5 +1,6 @@
aidsCalc <- function( priceNames, totExpName, coef, data,
priceIndex = "TL", basePrices = NULL, baseShares = NULL ) {
priceIndex = "TL", basePrices = NULL, baseShares = NULL,
shifterNames = NULL ) {

# check argument 'coef' (coefficients)
coefCheckResult <- .aidsCheckCoef( coef, variables = list(
Expand All @@ -9,7 +10,7 @@ aidsCalc <- function( priceNames, totExpName, coef, data,
}

# checking argument 'data'
if( class( data ) != "data.frame" ) {
if( !is.data.frame( data ) ) {
stop( "argument 'data' must be a data frame" )
}

Expand Down Expand Up @@ -76,7 +77,8 @@ aidsCalc <- function( priceNames, totExpName, coef, data,
if( is.character( priceIndex ) ) {
if( priceIndex == "TL" ) {
# calculation of translog price index
priceIndex <- aidsPx( priceIndex, priceNames, data = data, coef = coef )
priceIndex <- aidsPx( priceIndex, priceNames, data = data, coef = coef,
shifterNames = shifterNames )
} else if( priceIndex == "L" ) {
# calculation of Laspeyres price index
priceIndex <- aidsPx( priceIndex, priceNames, data = data,
Expand All @@ -90,6 +92,7 @@ aidsCalc <- function( priceNames, totExpName, coef, data,

# number of goods
nGoods <- length( priceNames )
nShifter <- length( shifterNames )

shareData <- as.data.frame( matrix( NA, nrow = nrow( data ), ncol = nGoods ) )
names( shareData ) <- paste( "w", as.character( 1:nGoods ), sep = "" )
Expand All @@ -105,55 +108,85 @@ aidsCalc <- function( priceNames, totExpName, coef, data,
shareData[ , i ] <- shareData[ , i ] + coef$gamma[ i, j ] *
log( data[[ priceNames[ j ] ]] )
}
if( nShifter > 0 ) {
for( j in 1:nShifter ) {
shareData[ , i ] <- shareData[ , i ] + coef$delta[ i, j ] *
data[[ shifterNames[j] ]]
}
}
}
} else if( priceIndex == "S" ) {
for( i in 1:nrow( data ) ) {
logPrices <- log( as.numeric( data[ i, priceNames ] ) )
logTotExp <- log( data[ i, totExpName ] )
shifterValues <- as.numeric( data[ i, shifterNames ] )
if( all( !is.na( c( logPrices, logTotExp ) ) ) ) {
numerator <- coef$alpha + coef$gamma %*% logPrices +
coef$beta * logTotExp
if( nShifter > 0 ) {
numerator <- numerator + coef$delta %*% shifterValues
}
shareData[ i, ] <-
solve( diag( nGoods ) + coef$beta %*% t( logPrices ),
coef$alpha + coef$gamma %*% logPrices + coef$beta * logTotExp )
solve( diag( nGoods ) + coef$beta %*% t( logPrices ), numerator )
}
}
} else if( priceIndex == "SL" ) {
logPrices <- log( as.numeric( data[ 1, priceNames ] ) )
logTotExp <- log( data[ 1, totExpName ] )
shifterValues <- as.numeric( data[ 1, shifterNames ] )
if( all( !is.na( c( logPrices, logTotExp ) ) ) ) {
numerator <- coef$alpha + coef$gamma %*% logPrices +
coef$beta * logTotExp
if( nShifter > 0 ) {
numerator <- numerator + coef$delta %*% shifterValues
}
shareData[ 1, ] <-
solve( diag( nGoods ) + coef$beta %*% t( logPrices ),
coef$alpha + coef$gamma %*% logPrices + coef$beta * logTotExp )
solve( diag( nGoods ) + coef$beta %*% t( logPrices ), numerator )
}
for( i in 2:nrow( data ) ) {
logPrices <- log( as.numeric( data[ i, priceNames ] ) )
logTotExp <- log( data[ i, totExpName ] )
shifterValues <- as.numeric( data[ i, shifterNames ] )
if( all( !is.na( c( logPrices, logTotExp ) ) ) ) {
shareData[ i, ] <-
coef$alpha + coef$gamma %*% logPrices + coef$beta * logTotExp -
coef$beta * drop( crossprod( logPrices, as.numeric( shareData[ i-1, ] ) ) )
if( nShifter > 0 ) {
shareData[ i, ] <- shareData[ i, ] + coef$delta %*% shifterValues
}
}
}
} else if( priceIndex == "P" ) {
for( i in 1:nrow( data ) ) {
prices <- as.numeric( data[ i, priceNames ] )
logTotExp <- log( data[ i, totExpName ] )
shifterValues <- as.numeric( data[ i, shifterNames ] )
if( all( !is.na( c( prices, logTotExp ) ) ) ) {
numerator <- coef$alpha + coef$gamma %*% log( prices ) +
coef$beta * logTotExp
if( nShifter > 0 ) {
numerator <- numerator + coef$delta %*% shifterValues
}
shareData[ i, ] <-
solve( diag( nGoods ) + coef$beta %*% t( log( prices / basePrices ) ),
coef$alpha + coef$gamma %*% log( prices ) + coef$beta * logTotExp )
numerator )
}
}
} else if( priceIndex == "T" ) {
for( i in 1:nrow( data ) ) {
prices <- as.numeric( data[ i, priceNames ] )
logTotExp <- log( data[ i, totExpName ] )
shifterValues <- as.numeric( data[ i, shifterNames ] )
if( all( !is.na( c( prices, logTotExp ) ) ) ) {
numerator <- coef$alpha + coef$gamma %*% log( prices ) +
coef$beta * logTotExp - 0.5 * coef$beta *
drop( crossprod( log( prices / basePrices ), baseShares ) )
if( nShifter > 0 ) {
numerator <- numerator + coef$delta %*% shifterValues
}
shareData[ i, ] <-
solve( diag( nGoods ) + 0.5 * coef$beta %*%
t( log( prices / basePrices ) ),
coef$alpha + coef$gamma %*% log( prices ) +
coef$beta * logTotExp - 0.5 * coef$beta *
drop( crossprod( log( prices / basePrices ), baseShares ) ) )
t( log( prices / basePrices ) ), numerator )
}
}
} else {
Expand Down
44 changes: 36 additions & 8 deletions R/aidsElas.R
View file
@@ -1,20 +1,39 @@
aidsElas <- function( coef, prices = NULL, shares = NULL, totExp = NULL,
method = "AIDS", priceIndex = "TL", basePrices = NULL, baseShares = NULL,
quantNames = NULL, priceNames = NULL, coefCov = NULL, df = NULL ) {
quantNames = NULL, priceNames = NULL, shifterValues = NULL,
coefCov = NULL, df = NULL ) {

if( !is.null( coef$delta ) ) {
stop( "calculating demand elasticities for models with demand shifters",
" has not been implemented yet" )
if( is.null( shifterValues ) ) {
stop( "as the model was estimated with demand shifters",
" argument 'shifterValues' must be specified" )
}
if( length( shifterValues ) != ncol( coef$delta ) ) {
stop( "the number of demand shifters specified by argument",
" 'shifterValues' must be equal to the number of demand shifters",
" used in the estimation (", ncol( coef$delta ), ")" )
}
if( length( coef$alpha ) != nrow( coef$delta ) ) {
stop( "length of 'coef$alpha' must be the same as number of rows",
" of 'coef$delta'" )
}
for( i in 1:length( coef$alpha ) ) {
coef$alpha[i] <- coef$alpha[i] +
crossprod( coef$delta[i,], shifterValues )
}
nShifter <- ncol( coef$delta )
} else {
nShifter <- 0
}

nGoods <- length( coef$alpha )

coefCheckResult <- .aidsCheckCoef( coef, variables = list(
list( ifelse( is.null( prices ), NA, length( prices ) ), "prices", "goods" ),
list( ifelse( is.null( shares ), NA, length( shares ) ), "shares", "goods" ),
list( ifelse( is.null( quantNames ), NA, length( quantNames ) ),
list( ifelse( is.null( quantNames ), NA, length( quantNames ) ),
"quantNames", "goods" ),
list( ifelse( is.null( priceNames ), NA, length( priceNames ) ),
list( ifelse( is.null( priceNames ), NA, length( priceNames ) ),
"priceNames", "goods" ) ) )
if( !is.null( coefCheckResult ) ){
stop( coefCheckResult )
Expand Down Expand Up @@ -45,11 +64,19 @@ aidsElas <- function( coef, prices = NULL, shares = NULL, totExp = NULL,
} else {
tempPriceIndex <- priceIndex
}
if( nShifter > 0 ) {
tempShifterNames <- paste ( "s", c( 1:nShifter ), sep = "" )
for( i in 1:nShifter ) {
tempData[[ tempShifterNames[ i ] ]] <- shifterValues[ i ]
}
} else {
tempShifterNames <- NULL
}
shares <- as.numeric( aidsCalc( priceNames = tempPriceNames,
totExpName = "totExp", coef = coef, data = tempData,
priceIndex = tempPriceIndex, basePrices = basePrices,
baseShares = baseShares )$shares )
rm( tempData, tempPriceNames, tempPriceIndex )
baseShares = baseShares, shifterNames = tempShifterNames )$shares )
rm( tempData, tempPriceNames, tempPriceIndex, tempShifterNames )
}

if( is.null( quantNames ) ) {
Expand Down Expand Up @@ -291,7 +318,8 @@ aidsElas <- function( coef, prices = NULL, shares = NULL, totExp = NULL,
colnames( ela$marshall ) <- priceNames
if( !is.null( coefCov ) && method %in% c( "AIDS" ) ) {
jacobian <- .aidsElasJacobian( coef = coef, shares = shares, prices = prices,
method = method, quantNames = quantNames, priceNames = priceNames )
method = method, quantNames = quantNames, priceNames = priceNames,
shifterValues = shifterValues )
ela$allVcov <- jacobian$all %*% coefCov %*% t( jacobian$all )
ela$expVcov <- jacobian$exp %*% coefCov %*% t( jacobian$exp )
ela$hicksVcov <- jacobian$hicks %*% coefCov %*% t( jacobian$hicks )
Expand Down
32 changes: 29 additions & 3 deletions R/aidsElasJacobian.R
View file
@@ -1,8 +1,9 @@
.aidsElasJacobian <- function( coef, shares, prices = NULL, method = "AIDS",
quantNames = NULL, priceNames = NULL ) {
quantNames = NULL, priceNames = NULL, shifterValues = NULL ) {

nGoods <- length( coef$alpha )
nCoef <- ( nGoods + 2 ) * nGoods
nShifter <- length( shifterValues )
nCoef <- ( nGoods + 2 ) * nGoods + nGoods * nShifter

if( length( coef$alpha ) != length( coef$beta ) ) {
stop( "arguments 'alpha' and 'beta' must have the same length" )
Expand All @@ -16,6 +17,15 @@
} else if( length( coef$alpha ) != length( prices ) && !is.null( prices ) ) {
stop( "arguments 'alpha' and 'prices' must have the same length" )
}
if( nShifter > 0 ) {
if( !is.matrix( coef$delta ) ) {
stop( "component 'delta' of argument 'coef' must be a matrix" )
}
if( ncol( coef$delta ) != length( shifterValues ) ) {
stop( "the number of columns of component 'delta' of argument 'coef'",
" must be equal to the length of argument 'shifterValues'" )
}
}
if( is.null( quantNames ) ) {
quantNames <- .aidsQuantNames( shares, coef, nGoods )
} else {
Expand Down Expand Up @@ -45,7 +55,7 @@
rownames( result ) <- paste( symbol, rep( quantNames, each = nGoods ),
rep( priceNames, nGoods ) )
}
colnames( result ) <- .aidsCoefNamesAll( nGoods, 0 )
colnames( result ) <- .aidsCoefNamesAll( nGoods, nShifter )
return( result )
}

Expand All @@ -61,6 +71,10 @@
bName <- paste( "beta", c( 1:nGoods ) )
gName <- array( paste( "gamma", rep( 1:nGoods, nGoods ),
rep( 1:nGoods, each = nGoods ) ), dim = c( nGoods, nGoods ) )
if( nShifter > 0 ) {
dName <- array( paste( "delta", rep( 1:nGoods, nShifter ),
rep( 1:nShifter, each = nGoods ) ), dim = c( nGoods, nShifter ) )
}
ehName <- array( paste( "Eh", rep( quantNames, nGoods ),
rep( priceNames, each = nGoods ) ), dim = c( nGoods, nGoods ) )
emName <- array( paste( "Em", rep( quantNames, nGoods ),
Expand All @@ -76,6 +90,12 @@
# Hicksian price elasticities
jacobian$hicks[ ehName[ i, j ], aName[ j ] ] <-
-coef$beta[ i ] / shares[ i ]
if( nShifter > 0 ) {
for( k in 1:nShifter ) {
jacobian$hicks[ ehName[ i, j ], dName[ j, k ] ] <-
- ( coef$beta[ i ] / shares[ i ] ) * shifterValues[ k ]
}
}
jacobian$hicks[ ehName[ i, j ], bName[ i ] ] <-
- ( coef$alpha[ j ] - shares[ j ] +
coef$gamma[ j , ] %*% log( prices ) ) / shares[ i ]
Expand All @@ -87,6 +107,12 @@
# Marshallian price elasticities
jacobian$marshall[ emName[ i, j ], aName[ j ] ] <-
-coef$beta[ i ] / shares[ i ]
if( nShifter > 0 ) {
for( k in 1:nShifter ) {
jacobian$marshall[ emName[ i, j ], dName[ j, k ] ] <-
- ( coef$beta[ i ] / shares[ i ] ) * shifterValues[ k ]
}
}
jacobian$marshall[ emName[ i, j ], bName[ i ] ] <-
- ( coef$alpha[ j ] +
coef$gamma[ j , ] %*% log( prices ) ) / shares[ i ]
Expand Down

0 comments on commit e52cbd8

Please sign in to comment.