# R/cesInterN3.R In micEconCES: Analysis with the Constant Elasticity of Substitution (CES) Function

```cesInterN3 <- function( funcName, par, xNames, tName, data, rhoApprox ) {

# interpolation if rho and/or rho_1 are close to zero
coefArray <- array( par, c( length( par ), 2, 2 ) )
dimnames( coefArray ) <- list( names( par ),
c( "rho_1 = 0", "rho_1 = E" ),  c( "rho = 0", "rho = E" ) )
weights <- c( 0, 0 )
names( weights ) <- c( "rho_1 = 0", "rho = 0" )
rhoNames <- c( "rho_1", "rho" )
for( i in 1:2 ) {
if( abs( par[ rhoNames[ i ] ] ) <= rhoApprox &
!is.na( par[ rhoNames[ i ] ] ) ) {
# permute the array so that the second dimension is for this 'i'
atemp <- aperm( coefArray, c( 1, i + 1, 4 - i ) )
atemp[ rhoNames[ i ], 1, ] <- 0
atemp[ rhoNames[ i ], 2, ] <-
rhoApprox * (-1)^( par[ rhoNames[ i ] ] < 0 )
# permute the array back to its initial state
coefArray <- aperm( atemp, c( 1, i + 1, 4 - i ) )
weights[ i ] <- 1 - abs( par[ rhoNames[ i ] ] ) / rhoApprox
}
}
result <- 0
weightMatrix <- cbind( weights, 1 - weights )
for( i in 1:2 ) {
for( j in 1:2 ) {
if( weightMatrix[ 1, i ] != 0 && weightMatrix[ 2, j ] != 0 ) {
result <- result + weightMatrix[ 1, i ] * weightMatrix[ 2, j ] *
do.call( funcName, args = list( coef = coefArray[ , i, j ],
data = data, xNames = xNames, tName = 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 May 2, 2019, 4:41 p.m.