Nothing
R/cesDerivCoefN4.R
In micEconCES: Analysis with the Constant Elasticity of Substitution (CES) Function
Defines functions
cesDerivCoefN4Nu
cesDerivCoefN4Rho
cesDerivCoefN4Rho2
cesDerivCoefN4Rho1
cesDerivCoefN4Delta
cesDerivCoefN4Delta2
cesDerivCoefN4Delta1
cesDerivCoefN4Lambda
cesDerivCoefN4Gamma
cesDerivCoefN4B
cesDerivCoefN4L2
cesDerivCoefN4B2
cesDerivCoefN4L1
cesDerivCoefN4B1
# calculate part "B1"
cesDerivCoefN4B1 <- function( coef, data, xNames ) {
B1 <- coef[ "delta_1" ] * data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ]) +
( 1 - coef[ "delta_1" ] ) * data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ])
return( B1 )
}
# calculate part "L1"
cesDerivCoefN4L1 <- function( coef, data, xNames ) {
L1 <- coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] ) +
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] )
return( L1 )
}
# calculate part "B2"
cesDerivCoefN4B2 <- function( coef, data, xNames ) {
B2 <- coef[ "delta_2" ] * data[[ xNames[ 3 ] ]]^(-coef[ "rho_2" ]) +
( 1 - coef[ "delta_2" ] ) * data[[ xNames[ 4 ] ]]^(-coef[ "rho_2" ])
return( B2 )
}
# calculate part "L2"
cesDerivCoefN4L2 <- function( coef, data, xNames ) {
L2 <- coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] ) +
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] )
return( L2 )
}
# calculate part "B"
cesDerivCoefN4B <- function( coef, data, xNames ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
B <- coef[ "delta" ] * B1^( coef[ "rho" ] / coef[ "rho_1" ] ) +
( 1 - coef[ "delta" ] ) * B2^( coef[ "rho" ] / coef[ "rho_2" ] )
return( B )
}
# derivatives with respect to gamma
cesDerivCoefN4Gamma <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- exp( - coef[ "nu" ] * ( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- exp( - coef[ "nu" ] * ( - coef[ "delta" ] * L1 +
( 1- coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- exp( - coef[ "nu" ] * ( coef[ "delta" ] *
log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <-
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- exp( - ( coef[ "nu" ] / coef[ "rho" ] ) *
log( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
) )
} else {
result <-
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <-
( coef[ "delta" ] * B1^( coef[ "rho" ] / coef[ "rho_1" ] ) +
( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 )
)^( - ( coef[ "nu" ] / coef[ "rho" ] ) )
} else {
result <- B^(-coef[ "nu" ]/coef[ "rho" ])
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to lambda
cesDerivCoefN4Lambda <- function( coef, data, xNames, tName ) {
if( is.null( tName ) || ! "lambda" %in% names( coef ) ) {
stop( "internal error: cannot calculate derivative w.r.t. lambda",
" if 'tName' or 'lambda' is not given" )
}
result <- cesDerivCoefN4Gamma( coef = coef, data = data,
xNames = xNames, tName = tName ) * coef[ "gamma" ] * data[[ tName ]]
return( result )
}
# derivatives with respect to delta_1
cesDerivCoefN4Delta1 <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] * coef[ "delta" ] *
( - log( data[[ xNames[ 1 ] ]] ) +
log( data[[ xNames[ 2 ] ]] ) ) *
exp( -coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( - coef[ "nu" ]*
( coef[ "delta" ] *
( - log( data[[ xNames[ 1 ] ]] ) +
log( data[[ xNames[ 2 ] ]] ) ) ) ) *
exp( -coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] * coef[ "delta" ] *
( data[[ xNames[ 1 ] ]]^( - coef[ "rho_1" ] ) -
data[[ xNames[ 2 ] ]]^( - coef[ "rho_1" ] ) ) ) /
( coef[ "rho_1" ] * B1 ) *
exp( -coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( - coef[ "nu" ] / coef[ "rho_1" ] ) *
( coef[ "delta" ] *
( data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ]) -
data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ]) ) / B1 ) *
exp( -coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) *
coef[ "rho" ] * ( - log( data[[ xNames[ 1 ] ]] ) +
log( data[[ xNames[ 2 ] ]] ) ) )
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) *
coef[ "rho" ] *
( - log( data[[ xNames[ 1 ] ]] ) + log( data[[ xNames[ 2 ] ]] ) ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( coef[ "delta" ] * coef[ "rho" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] - 1 ) *
( data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ]) -
data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ]) ) /
coef[ "rho_1" ] )
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
B^((-coef[ "nu" ]-coef[ "rho" ])/coef[ "rho" ]) *
(coef[ "rho" ]/coef[ "rho_1" ]) * coef[ "delta" ] *
B1^((coef[ "rho" ]-coef[ "rho_1" ])/coef[ "rho_1" ]) *
( data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ]) -
data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ]) )
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to delta_2
cesDerivCoefN4Delta2 <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] *
( 1 - coef[ "delta" ] ) *
( - log( data[[ xNames[ 3 ] ]] ) +
log( data[[ xNames[ 4 ] ]] ) ) *
exp( -coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] * ( 1 - coef[ "delta" ] ) *
( data[[ xNames[ 3 ] ]]^( - coef[ "rho_2" ] ) -
data[[ xNames[ 4 ] ]]^( - coef[ "rho_2" ] ) ) ) /
( coef[ "rho_2" ] * B2 ) *
exp( -coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( - coef[ "nu" ]*
( ( 1 - coef[ "delta" ] ) *
( - log( data[[ xNames[ 3 ] ]] ) +
log( data[[ xNames[ 4 ] ]] ) ) ) ) *
exp( -coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( - coef[ "nu" ] / coef[ "rho_2" ] ) *
( ( 1 - coef[ "delta" ] ) *
( data[[ xNames[ 3 ] ]]^(-coef[ "rho_2" ]) -
data[[ xNames[ 4 ] ]]^(-coef[ "rho_2" ]) ) / B2 ) *
exp( -coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * ( coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( ( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 ) *
coef[ "rho" ] * ( - log( data[[ xNames[ 3 ] ]] ) +
log( data[[ xNames[ 4 ] ]] ) ) )
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( ( 1 - coef[ "delta" ] ) * coef[ "rho" ] *
B2^( coef[ "rho" ] / coef[ "rho_2" ] - 1 ) *
( data[[ xNames[ 3 ] ]]^(-coef[ "rho_2" ]) -
data[[ xNames[ 4 ] ]]^(-coef[ "rho_2" ]) ) /
coef[ "rho_2" ] )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) *
coef[ "rho" ] *
( - log( data[[ xNames[ 3 ] ]] ) + log( data[[ xNames[ 4 ] ]] ) ) )
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
B^((-coef[ "nu" ]-coef[ "rho" ])/coef[ "rho" ]) *
(coef[ "rho" ]/coef[ "rho_2" ]) * ( 1 - coef[ "delta" ] ) *
B2^((coef[ "rho" ]-coef[ "rho_2" ])/coef[ "rho_2" ]) *
( data[[ xNames[ 3 ] ]]^(-coef[ "rho_2" ]) -
data[[ xNames[ 4 ] ]]^(-coef[ "rho_2" ]) )
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to delta
cesDerivCoefN4Delta <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] *
( - L1 + L2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- - coef[ "gamma" ] * coef[ "nu" ] *
( - L1 - log( B2 ) / coef[ "rho_2" ] ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] *
( log( B1 ) / coef[ "rho_1" ] + L2 ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( - coef[ "nu" ] *
( log( B1 ) / coef[ "rho_1" ] - log( B2 ) / coef[ "rho_2" ] ) ) *
exp( -coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( exp( - coef[ "rho" ] * L1 ) -
exp( - coef[ "rho" ] * L2 )
)
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( exp( - coef[ "rho" ] * L1 ) -
B2^( coef[ "rho" ] / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( ( 1 -coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( - exp( - coef[ "rho" ] * L2 ) +
B1^( coef[ "rho" ] / coef[ "rho_1" ] ) )
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
B^((-coef[ "nu" ]-coef[ "rho" ])/coef[ "rho" ]) *
( B1^(coef[ "rho" ]/coef[ "rho_1" ]) -
B2^(coef[ "rho" ]/coef[ "rho_2" ]) )
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to rho_1
cesDerivCoefN4Rho1 <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] * coef[ "delta" ] *
( 0.5 *
( coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] )^2 +
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] )^2 ) -
0.5 * L1^2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- - coef[ "gamma" ] * coef[ "nu" ] * coef[ "delta" ] *
( 0.5 *
( coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] )^2 +
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] )^2 ) -
0.5 * L1^2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] * coef[ "delta" ] *
( - log( B1 ) / coef[ "rho_1" ]^2 +
( - coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] ) *
data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ] ) -
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] ) *
data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ] ) ) /
( coef[ "rho_1" ] * B1 ) ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( - coef[ "nu" ] *
( coef[ "delta" ] * coef[ "rho_1" ] *
( -coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] ) *
data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ] ) -
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] ) *
data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ] ) ) /
( B1 * coef[ "rho_1" ]^2 ) -
coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ]^2 ) ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "delta" ] * coef[ "nu" ] *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( -coef[ "nu" ] / coef[ "rho" ] - 1 ) *
exp( - coef[ "rho" ] * L1 ) *
( - 0.5 * L1^2 +
0.5 * ( coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] )^2 +
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] )^2 )
)
} else {
result <- - coef[ "gamma" ] * coef[ "nu" ] * coef[ "delta" ] *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( -coef[ "nu" ] / coef[ "rho" ] - 1 ) *
exp( - coef[ "rho" ] * L1 ) *
( - 0.5 * L1^2 +
0.5 * ( coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] )^2 +
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] )^2 )
)
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( -coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( coef[ "delta" ] * log( B1 ) *
B1^( coef[ "rho" ] / coef[ "rho_1" ] ) *
( - coef[ "rho" ] / coef[ "rho_1" ]^2 ) +
coef[ "delta" ] * ( coef[ "rho" ] / coef[ "rho_1" ] ) *
B1^( coef[ "rho" ] / coef[ "rho_1" ] - 1 ) *
( - coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] ) *
data[[ xNames[ 1 ] ]]^( - coef[ "rho_1" ] ) -
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] ) *
data[[ xNames[ 2 ] ]]^( - coef[ "rho_1" ] )
)
)
} else {
result <- coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
B^((-coef[ "nu" ]-coef[ "rho" ])/coef[ "rho" ]) *
( coef[ "delta" ] * log( B1 ) * B1^(coef[ "rho" ]/coef[ "rho_1" ]) *
( -coef[ "rho" ]/coef[ "rho_1" ]^2 ) +
coef[ "delta" ] *
B1^((coef[ "rho" ]-coef[ "rho_1" ])/coef[ "rho_1" ]) *
(coef[ "rho" ]/coef[ "rho_1" ]) *
( -coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] ) *
data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ]) -
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] ) *
data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ]) ) )
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to rho_2
cesDerivCoefN4Rho2 <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] * ( 1 - coef[ "delta" ] ) *
( 0.5 *
( coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] )^2 +
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] )^2 ) -
0.5 * L2^2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- - coef[ "gamma" ] * coef[ "nu" ] *
( 1 - coef[ "delta" ] ) *
( - log( B2 ) / coef[ "rho_2" ]^2 +
( -coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] ) *
data[[ xNames[ 3 ] ]]^( - coef[ "rho_2" ]) -
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] ) *
data[[ xNames[ 4 ] ]]^( - coef[ "rho_2" ] ) ) /
( coef[ "rho_2" ] * B2 ) ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] * ( 1 - coef[ "delta" ] ) *
( 0.5 *
( coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] )^2 +
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] )^2 ) -
0.5 * L2^2 ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( - coef[ "nu" ] *
( ( 1 - coef[ "delta" ] ) * coef[ "rho_2" ] *
( -coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] ) *
data[[ xNames[ 3 ] ]]^(-coef[ "rho_2" ] ) -
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] ) *
data[[ xNames[ 4 ] ]]^(-coef[ "rho_2" ] ) ) /
( B2 * coef[ "rho_2" ]^2 ) -
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ]^2 ) ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * ( 1 - coef[ "delta" ] ) * coef[ "nu" ] *
( ( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] * exp( - coef[ "rho" ] * L1 )
)^( -coef[ "nu" ] / coef[ "rho" ] - 1 ) *
exp( - coef[ "rho" ] * L2 ) *
( - 0.5 * L2^2 +
0.5 * ( coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] )^2 +
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] )^2 )
)
} else {
result <- coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( ( 1 - coef[ "delta" ] ) * log( B2 ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] ) *
( - coef[ "rho" ] / coef[ "rho_2" ]^2 ) +
( 1 - coef[ "delta" ] ) * ( coef[ "rho" ] / coef[ "rho_2" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] - 1 ) *
( -coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] ) *
data[[ xNames[ 3 ] ]]^( - coef[ "rho_2" ]) -
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] ) *
data[[ xNames[ 4 ] ]]^( - coef[ "rho_2" ] ) ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] * ( 1 - coef[ "delta" ] ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( -coef[ "nu" ] / coef[ "rho" ] - 1 ) *
exp( - coef[ "rho" ] * L2 ) *
( - 0.5 * L2^2 +
0.5 * ( coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] )^2 +
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] )^2 )
)
} else {
result <- coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
B^((-coef[ "nu" ]-coef[ "rho" ])/coef[ "rho" ]) *
( ( 1 - coef[ "delta" ] ) * log( B2 ) *
B2^(coef[ "rho" ]/coef[ "rho_2" ]) *
( -coef[ "rho" ]/coef[ "rho_2" ]^2 ) +
( 1 - coef[ "delta" ] ) *
B2^((coef[ "rho" ]-coef[ "rho_2" ])/coef[ "rho_2" ]) *
(coef[ "rho" ]/coef[ "rho_2" ]) *
( -coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] ) *
data[[ xNames[ 3 ] ]]^(-coef[ "rho_2" ]) -
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] ) *
data[[ xNames[ 4 ] ]]^(-coef[ "rho_2" ]) ) )
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to rho
cesDerivCoefN4Rho <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] * coef[ "nu" ] *
( -0.5 * ( coef[ "delta" ] * L1^2 +
( 1 - coef[ "delta" ] ) * L2^2 ) +
0.5 * ( coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * L2 )^2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] * coef[ "nu" ] *
( -0.5 * ( coef[ "delta" ] * L1^2 +
( 1 - coef[ "delta" ] ) * ( log( B2 ) / coef[ "rho_2" ] )^2 ) +
0.5 * ( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] )^2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] * coef[ "nu" ] *
( -0.5 * ( coef[ "delta" ] * ( log( B1 ) / coef[ "rho_1" ] )^2 +
( 1 - coef[ "delta" ] ) * L2^2 ) +
0.5 * ( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 )^2 ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] * coef[ "nu" ] *
( -0.5 * ( coef[ "delta" ] * log( B1 )^2 / coef[ "rho_1" ]^2 +
( 1 - coef[ "delta" ] ) * log( B2 )^2 / coef[ "rho_2" ]^2 ) +
0.5 * ( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] )^2 ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
log( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( - coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "nu" ] / coef[ "rho" ]^2 ) -
coef[ "gamma" ] * ( coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( - coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) * L1 -
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 ) *
L2 )
} else {
result <- coef[ "gamma" ] *
log( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] ) ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "nu" ] / coef[ "rho" ]^2 ) +
coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( - coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] ) / coef[ "rho_2" ] )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
log( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] ) ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "nu" ] / coef[ "rho" ]^2 ) +
coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( - ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) * L2 +
( coef[ "delta" ] * log( B1 ) *
B1^( coef[ "rho" ] / coef[ "rho_1" ] ) / coef[ "rho_1" ] )
)
} else {
result <- coef[ "gamma" ] * log( B ) *
B^(-coef[ "nu" ]/coef[ "rho" ]) * ( coef[ "nu" ] / coef[ "rho" ]^2 ) +
coef[ "gamma" ] * ( -coef[ "nu" ]/coef[ "rho" ] ) *
B^((-coef[ "nu" ]-coef[ "rho" ])/coef[ "rho" ]) *
( coef[ "delta" ] * log( B1 ) *
B1^(coef[ "rho" ]/coef[ "rho_1" ]) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) *
B2^(coef[ "rho" ]/coef[ "rho_2" ]) / coef[ "rho_2" ] )
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to nu
cesDerivCoefN4Nu <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * L2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( - coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * L2 ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- - coef[ "gamma" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - ( coef[ "gamma" ] / coef[ "rho" ] ) *
log( ( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] * exp( - coef[ "rho" ] * L1 )
) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( - coef[ "nu" ] / coef[ "rho" ] )
} else {
result <- - ( coef[ "gamma" ] / coef[ "rho" ] ) *
log( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] ) ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- - ( coef[ "gamma" ] / coef[ "rho" ] ) *
log( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] ) ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] )
} else {
result <- - coef[ "gamma" ] * log( B ) *
B^( -coef[ "nu" ] / coef[ "rho" ] ) / coef[ "rho" ]
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
Try the micEconCES package in your browser
Any scripts or data that you put into this service are public.
micEconCES documentation built on Jan. 7, 2021, 3:01 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions cesDerivCoefN4Nu cesDerivCoefN4Rho cesDerivCoefN4Rho2 cesDerivCoefN4Rho1 cesDerivCoefN4Delta cesDerivCoefN4Delta2 cesDerivCoefN4Delta1 cesDerivCoefN4Lambda cesDerivCoefN4Gamma cesDerivCoefN4B cesDerivCoefN4L2 cesDerivCoefN4B2 cesDerivCoefN4L1 cesDerivCoefN4B1
# calculate part "B1"
cesDerivCoefN4B1 <- function( coef, data, xNames ) {
B1 <- coef[ "delta_1" ] * data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ]) +
( 1 - coef[ "delta_1" ] ) * data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ])
return( B1 )
}
# calculate part "L1"
cesDerivCoefN4L1 <- function( coef, data, xNames ) {
L1 <- coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] ) +
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] )
return( L1 )
}
# calculate part "B2"
cesDerivCoefN4B2 <- function( coef, data, xNames ) {
B2 <- coef[ "delta_2" ] * data[[ xNames[ 3 ] ]]^(-coef[ "rho_2" ]) +
( 1 - coef[ "delta_2" ] ) * data[[ xNames[ 4 ] ]]^(-coef[ "rho_2" ])
return( B2 )
}
# calculate part "L2"
cesDerivCoefN4L2 <- function( coef, data, xNames ) {
L2 <- coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] ) +
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] )
return( L2 )
}
# calculate part "B"
cesDerivCoefN4B <- function( coef, data, xNames ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
B <- coef[ "delta" ] * B1^( coef[ "rho" ] / coef[ "rho_1" ] ) +
( 1 - coef[ "delta" ] ) * B2^( coef[ "rho" ] / coef[ "rho_2" ] )
return( B )
}
# derivatives with respect to gamma
cesDerivCoefN4Gamma <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- exp( - coef[ "nu" ] * ( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- exp( - coef[ "nu" ] * ( - coef[ "delta" ] * L1 +
( 1- coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- exp( - coef[ "nu" ] * ( coef[ "delta" ] *
log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <-
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- exp( - ( coef[ "nu" ] / coef[ "rho" ] ) *
log( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
) )
} else {
result <-
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <-
( coef[ "delta" ] * B1^( coef[ "rho" ] / coef[ "rho_1" ] ) +
( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 )
)^( - ( coef[ "nu" ] / coef[ "rho" ] ) )
} else {
result <- B^(-coef[ "nu" ]/coef[ "rho" ])
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to lambda
cesDerivCoefN4Lambda <- function( coef, data, xNames, tName ) {
if( is.null( tName ) || ! "lambda" %in% names( coef ) ) {
stop( "internal error: cannot calculate derivative w.r.t. lambda",
" if 'tName' or 'lambda' is not given" )
}
result <- cesDerivCoefN4Gamma( coef = coef, data = data,
xNames = xNames, tName = tName ) * coef[ "gamma" ] * data[[ tName ]]
return( result )
}
# derivatives with respect to delta_1
cesDerivCoefN4Delta1 <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] * coef[ "delta" ] *
( - log( data[[ xNames[ 1 ] ]] ) +
log( data[[ xNames[ 2 ] ]] ) ) *
exp( -coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( - coef[ "nu" ]*
( coef[ "delta" ] *
( - log( data[[ xNames[ 1 ] ]] ) +
log( data[[ xNames[ 2 ] ]] ) ) ) ) *
exp( -coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] * coef[ "delta" ] *
( data[[ xNames[ 1 ] ]]^( - coef[ "rho_1" ] ) -
data[[ xNames[ 2 ] ]]^( - coef[ "rho_1" ] ) ) ) /
( coef[ "rho_1" ] * B1 ) *
exp( -coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( - coef[ "nu" ] / coef[ "rho_1" ] ) *
( coef[ "delta" ] *
( data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ]) -
data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ]) ) / B1 ) *
exp( -coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) *
coef[ "rho" ] * ( - log( data[[ xNames[ 1 ] ]] ) +
log( data[[ xNames[ 2 ] ]] ) ) )
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) *
coef[ "rho" ] *
( - log( data[[ xNames[ 1 ] ]] ) + log( data[[ xNames[ 2 ] ]] ) ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( coef[ "delta" ] * coef[ "rho" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] - 1 ) *
( data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ]) -
data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ]) ) /
coef[ "rho_1" ] )
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
B^((-coef[ "nu" ]-coef[ "rho" ])/coef[ "rho" ]) *
(coef[ "rho" ]/coef[ "rho_1" ]) * coef[ "delta" ] *
B1^((coef[ "rho" ]-coef[ "rho_1" ])/coef[ "rho_1" ]) *
( data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ]) -
data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ]) )
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to delta_2
cesDerivCoefN4Delta2 <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] *
( 1 - coef[ "delta" ] ) *
( - log( data[[ xNames[ 3 ] ]] ) +
log( data[[ xNames[ 4 ] ]] ) ) *
exp( -coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] * ( 1 - coef[ "delta" ] ) *
( data[[ xNames[ 3 ] ]]^( - coef[ "rho_2" ] ) -
data[[ xNames[ 4 ] ]]^( - coef[ "rho_2" ] ) ) ) /
( coef[ "rho_2" ] * B2 ) *
exp( -coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( - coef[ "nu" ]*
( ( 1 - coef[ "delta" ] ) *
( - log( data[[ xNames[ 3 ] ]] ) +
log( data[[ xNames[ 4 ] ]] ) ) ) ) *
exp( -coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( - coef[ "nu" ] / coef[ "rho_2" ] ) *
( ( 1 - coef[ "delta" ] ) *
( data[[ xNames[ 3 ] ]]^(-coef[ "rho_2" ]) -
data[[ xNames[ 4 ] ]]^(-coef[ "rho_2" ]) ) / B2 ) *
exp( -coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * ( coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( ( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 ) *
coef[ "rho" ] * ( - log( data[[ xNames[ 3 ] ]] ) +
log( data[[ xNames[ 4 ] ]] ) ) )
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( ( 1 - coef[ "delta" ] ) * coef[ "rho" ] *
B2^( coef[ "rho" ] / coef[ "rho_2" ] - 1 ) *
( data[[ xNames[ 3 ] ]]^(-coef[ "rho_2" ]) -
data[[ xNames[ 4 ] ]]^(-coef[ "rho_2" ]) ) /
coef[ "rho_2" ] )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) *
coef[ "rho" ] *
( - log( data[[ xNames[ 3 ] ]] ) + log( data[[ xNames[ 4 ] ]] ) ) )
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
B^((-coef[ "nu" ]-coef[ "rho" ])/coef[ "rho" ]) *
(coef[ "rho" ]/coef[ "rho_2" ]) * ( 1 - coef[ "delta" ] ) *
B2^((coef[ "rho" ]-coef[ "rho_2" ])/coef[ "rho_2" ]) *
( data[[ xNames[ 3 ] ]]^(-coef[ "rho_2" ]) -
data[[ xNames[ 4 ] ]]^(-coef[ "rho_2" ]) )
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to delta
cesDerivCoefN4Delta <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] *
( - L1 + L2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- - coef[ "gamma" ] * coef[ "nu" ] *
( - L1 - log( B2 ) / coef[ "rho_2" ] ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] *
( log( B1 ) / coef[ "rho_1" ] + L2 ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( - coef[ "nu" ] *
( log( B1 ) / coef[ "rho_1" ] - log( B2 ) / coef[ "rho_2" ] ) ) *
exp( -coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( exp( - coef[ "rho" ] * L1 ) -
exp( - coef[ "rho" ] * L2 )
)
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( exp( - coef[ "rho" ] * L1 ) -
B2^( coef[ "rho" ] / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
( ( 1 -coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( - exp( - coef[ "rho" ] * L2 ) +
B1^( coef[ "rho" ] / coef[ "rho_1" ] ) )
} else {
result <- coef[ "gamma" ] *
( -coef[ "nu" ] / coef[ "rho" ] ) *
B^((-coef[ "nu" ]-coef[ "rho" ])/coef[ "rho" ]) *
( B1^(coef[ "rho" ]/coef[ "rho_1" ]) -
B2^(coef[ "rho" ]/coef[ "rho_2" ]) )
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to rho_1
cesDerivCoefN4Rho1 <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] * coef[ "delta" ] *
( 0.5 *
( coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] )^2 +
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] )^2 ) -
0.5 * L1^2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- - coef[ "gamma" ] * coef[ "nu" ] * coef[ "delta" ] *
( 0.5 *
( coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] )^2 +
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] )^2 ) -
0.5 * L1^2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] * coef[ "delta" ] *
( - log( B1 ) / coef[ "rho_1" ]^2 +
( - coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] ) *
data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ] ) -
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] ) *
data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ] ) ) /
( coef[ "rho_1" ] * B1 ) ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( - coef[ "nu" ] *
( coef[ "delta" ] * coef[ "rho_1" ] *
( -coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] ) *
data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ] ) -
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] ) *
data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ] ) ) /
( B1 * coef[ "rho_1" ]^2 ) -
coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ]^2 ) ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "delta" ] * coef[ "nu" ] *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( -coef[ "nu" ] / coef[ "rho" ] - 1 ) *
exp( - coef[ "rho" ] * L1 ) *
( - 0.5 * L1^2 +
0.5 * ( coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] )^2 +
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] )^2 )
)
} else {
result <- - coef[ "gamma" ] * coef[ "nu" ] * coef[ "delta" ] *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( -coef[ "nu" ] / coef[ "rho" ] - 1 ) *
exp( - coef[ "rho" ] * L1 ) *
( - 0.5 * L1^2 +
0.5 * ( coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] )^2 +
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] )^2 )
)
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( -coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( coef[ "delta" ] * log( B1 ) *
B1^( coef[ "rho" ] / coef[ "rho_1" ] ) *
( - coef[ "rho" ] / coef[ "rho_1" ]^2 ) +
coef[ "delta" ] * ( coef[ "rho" ] / coef[ "rho_1" ] ) *
B1^( coef[ "rho" ] / coef[ "rho_1" ] - 1 ) *
( - coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] ) *
data[[ xNames[ 1 ] ]]^( - coef[ "rho_1" ] ) -
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] ) *
data[[ xNames[ 2 ] ]]^( - coef[ "rho_1" ] )
)
)
} else {
result <- coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
B^((-coef[ "nu" ]-coef[ "rho" ])/coef[ "rho" ]) *
( coef[ "delta" ] * log( B1 ) * B1^(coef[ "rho" ]/coef[ "rho_1" ]) *
( -coef[ "rho" ]/coef[ "rho_1" ]^2 ) +
coef[ "delta" ] *
B1^((coef[ "rho" ]-coef[ "rho_1" ])/coef[ "rho_1" ]) *
(coef[ "rho" ]/coef[ "rho_1" ]) *
( -coef[ "delta_1" ] * log( data[[ xNames[ 1 ] ]] ) *
data[[ xNames[ 1 ] ]]^(-coef[ "rho_1" ]) -
( 1 - coef[ "delta_1" ] ) * log( data[[ xNames[ 2 ] ]] ) *
data[[ xNames[ 2 ] ]]^(-coef[ "rho_1" ]) ) )
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to rho_2
cesDerivCoefN4Rho2 <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] * ( 1 - coef[ "delta" ] ) *
( 0.5 *
( coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] )^2 +
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] )^2 ) -
0.5 * L2^2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- - coef[ "gamma" ] * coef[ "nu" ] *
( 1 - coef[ "delta" ] ) *
( - log( B2 ) / coef[ "rho_2" ]^2 +
( -coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] ) *
data[[ xNames[ 3 ] ]]^( - coef[ "rho_2" ]) -
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] ) *
data[[ xNames[ 4 ] ]]^( - coef[ "rho_2" ] ) ) /
( coef[ "rho_2" ] * B2 ) ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] * ( 1 - coef[ "delta" ] ) *
( 0.5 *
( coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] )^2 +
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] )^2 ) -
0.5 * L2^2 ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( - coef[ "nu" ] *
( ( 1 - coef[ "delta" ] ) * coef[ "rho_2" ] *
( -coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] ) *
data[[ xNames[ 3 ] ]]^(-coef[ "rho_2" ] ) -
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] ) *
data[[ xNames[ 4 ] ]]^(-coef[ "rho_2" ] ) ) /
( B2 * coef[ "rho_2" ]^2 ) -
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ]^2 ) ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * ( 1 - coef[ "delta" ] ) * coef[ "nu" ] *
( ( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] * exp( - coef[ "rho" ] * L1 )
)^( -coef[ "nu" ] / coef[ "rho" ] - 1 ) *
exp( - coef[ "rho" ] * L2 ) *
( - 0.5 * L2^2 +
0.5 * ( coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] )^2 +
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] )^2 )
)
} else {
result <- coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( ( 1 - coef[ "delta" ] ) * log( B2 ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] ) *
( - coef[ "rho" ] / coef[ "rho_2" ]^2 ) +
( 1 - coef[ "delta" ] ) * ( coef[ "rho" ] / coef[ "rho_2" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] - 1 ) *
( -coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] ) *
data[[ xNames[ 3 ] ]]^( - coef[ "rho_2" ]) -
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] ) *
data[[ xNames[ 4 ] ]]^( - coef[ "rho_2" ] ) ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- - coef[ "gamma" ] * coef[ "nu" ] * ( 1 - coef[ "delta" ] ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( -coef[ "nu" ] / coef[ "rho" ] - 1 ) *
exp( - coef[ "rho" ] * L2 ) *
( - 0.5 * L2^2 +
0.5 * ( coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] )^2 +
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] )^2 )
)
} else {
result <- coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
B^((-coef[ "nu" ]-coef[ "rho" ])/coef[ "rho" ]) *
( ( 1 - coef[ "delta" ] ) * log( B2 ) *
B2^(coef[ "rho" ]/coef[ "rho_2" ]) *
( -coef[ "rho" ]/coef[ "rho_2" ]^2 ) +
( 1 - coef[ "delta" ] ) *
B2^((coef[ "rho" ]-coef[ "rho_2" ])/coef[ "rho_2" ]) *
(coef[ "rho" ]/coef[ "rho_2" ]) *
( -coef[ "delta_2" ] * log( data[[ xNames[ 3 ] ]] ) *
data[[ xNames[ 3 ] ]]^(-coef[ "rho_2" ]) -
( 1 - coef[ "delta_2" ] ) * log( data[[ xNames[ 4 ] ]] ) *
data[[ xNames[ 4 ] ]]^(-coef[ "rho_2" ]) ) )
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to rho
cesDerivCoefN4Rho <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] * coef[ "nu" ] *
( -0.5 * ( coef[ "delta" ] * L1^2 +
( 1 - coef[ "delta" ] ) * L2^2 ) +
0.5 * ( coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * L2 )^2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] * coef[ "nu" ] *
( -0.5 * ( coef[ "delta" ] * L1^2 +
( 1 - coef[ "delta" ] ) * ( log( B2 ) / coef[ "rho_2" ] )^2 ) +
0.5 * ( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] )^2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] * coef[ "nu" ] *
( -0.5 * ( coef[ "delta" ] * ( log( B1 ) / coef[ "rho_1" ] )^2 +
( 1 - coef[ "delta" ] ) * L2^2 ) +
0.5 * ( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 )^2 ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] * coef[ "nu" ] *
( -0.5 * ( coef[ "delta" ] * log( B1 )^2 / coef[ "rho_1" ]^2 +
( 1 - coef[ "delta" ] ) * log( B2 )^2 / coef[ "rho_2" ]^2 ) +
0.5 * ( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] )^2 ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
log( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( - coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "nu" ] / coef[ "rho" ]^2 ) -
coef[ "gamma" ] * ( coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( - coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) * L1 -
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 ) *
L2 )
} else {
result <- coef[ "gamma" ] *
log( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] ) ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "nu" ] / coef[ "rho" ]^2 ) +
coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( - coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] ) / coef[ "rho_2" ] )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
log( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] ) ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] ) *
( coef[ "nu" ] / coef[ "rho" ]^2 ) +
coef[ "gamma" ] * ( -coef[ "nu" ] / coef[ "rho" ] ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] - 1 ) *
( - ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) * L2 +
( coef[ "delta" ] * log( B1 ) *
B1^( coef[ "rho" ] / coef[ "rho_1" ] ) / coef[ "rho_1" ] )
)
} else {
result <- coef[ "gamma" ] * log( B ) *
B^(-coef[ "nu" ]/coef[ "rho" ]) * ( coef[ "nu" ] / coef[ "rho" ]^2 ) +
coef[ "gamma" ] * ( -coef[ "nu" ]/coef[ "rho" ] ) *
B^((-coef[ "nu" ]-coef[ "rho" ])/coef[ "rho" ]) *
( coef[ "delta" ] * log( B1 ) *
B1^(coef[ "rho" ]/coef[ "rho_1" ]) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) *
B2^(coef[ "rho" ]/coef[ "rho_2" ]) / coef[ "rho_2" ] )
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
# derivatives with respect to nu
cesDerivCoefN4Nu <- function( coef, data, xNames, tName ) {
B1 <- cesDerivCoefN4B1( coef = coef, data = data, xNames = xNames )
L1 <- cesDerivCoefN4L1( coef = coef, data = data, xNames = xNames )
B2 <- cesDerivCoefN4B2( coef = coef, data = data, xNames = xNames )
L2 <- cesDerivCoefN4L2( coef = coef, data = data, xNames = xNames )
B <- cesDerivCoefN4B( coef = coef, data = data, xNames = xNames )
if( coef[ "rho" ] == 0 ) {
if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * L2 ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- coef[ "gamma" ] *
( coef[ "delta" ] * L1 -
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) *
exp( - coef[ "nu" ] *
( - coef[ "delta" ] * L1 +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- coef[ "gamma" ] *
( - coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * L2 ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] -
( 1 - coef[ "delta" ] ) * L2 ) )
} else {
result <- - coef[ "gamma" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) *
exp( - coef[ "nu" ] *
( coef[ "delta" ] * log( B1 ) / coef[ "rho_1" ] +
( 1 - coef[ "delta" ] ) * log( B2 ) / coef[ "rho_2" ] ) )
}
} else if( coef[ "rho_1" ] == 0 ) {
if( coef[ "rho_2" ] == 0 ) {
result <- - ( coef[ "gamma" ] / coef[ "rho" ] ) *
log( ( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] * exp( - coef[ "rho" ] * L1 )
) *
( coef[ "delta" ] * exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) * exp( - coef[ "rho" ] * L2 )
)^( - coef[ "nu" ] / coef[ "rho" ] )
} else {
result <- - ( coef[ "gamma" ] / coef[ "rho" ] ) *
log( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] ) ) *
( coef[ "delta" ] *
exp( - coef[ "rho" ] * L1 ) +
( 1 - coef[ "delta" ] ) *
B2^( coef[ "rho" ] / coef[ "rho_2" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] )
}
} else if( coef[ "rho_2" ] == 0 ) {
result <- - ( coef[ "gamma" ] / coef[ "rho" ] ) *
log( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] ) ) *
( ( 1 - coef[ "delta" ] ) *
exp( - coef[ "rho" ] * L2 ) +
coef[ "delta" ] *
B1^( coef[ "rho" ] / coef[ "rho_1" ] )
)^( - coef[ "nu" ] / coef[ "rho" ] )
} else {
result <- - coef[ "gamma" ] * log( B ) *
B^( -coef[ "nu" ] / coef[ "rho" ] ) / coef[ "rho" ]
}
if( !is.null( tName ) ){
result <- result * exp( coef[ "lambda" ] * data[[ tName ]] )
}
return( result )
}
Try the micEconCES package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.