# R/create_nl_data.R In lpirfs: Local Projections Impulse Response Functions

#### Documented in create_nl_data

```#' @name create_nl_data
#' @title Compute data for nonlinear model with instrument variable approach
#' @description Function to create data for nonlinear model with instrument variable approach.
#' @param endog_data A \link{data.frame} with dependent variables.
#' @return List with filled matrices of lagged left (y_nl) and right hand side (x_nl) variables.
#' @import dplyr
#' @keywords internal

create_nl_data <- function(specs, endog_data){

# Check whether lag lengths have to be determined
if (is.nan(specs\$lags_criterion)) {

# Get transition probabilities by logistic function?
if(isTRUE(specs\$use_logistic)){

fz      <- get_vals_switching(specs\$switching, specs)

} else {

fz      <- specs\$switching

# Use first lag of value from switching function?
if(isTRUE(specs\$lag_switching)){

fz      <-  dplyr::lag(fz, 1)

}

}

# Select data for endogenous variables
y_nl    <- endog_data

# Make exogenous lagged data
if(specs\$lags_endog_nl == 0){
x_nl <- data.frame(x = rep(Inf, nrow(endog_data)))
} else {
x_nl <- create_lags(endog_data, specs\$lags_endog_nl)
}

# Save names of exogenous variables
linear_names <- names(x_nl)

# Create tibbles with exogenous regime data and combine them to one data set
x_nl_s1      <- x_nl %>%
dplyr::mutate_all(list(s1 = ~.*(1 - fz)))  %>%
dplyr::select(-one_of(linear_names))

x_nl_s2      <- x_nl %>%
dplyr::mutate_all(list(s2 = ~.*fz))  %>%
dplyr::select(-one_of(linear_names))

x_nl         <- cbind(x_nl_s1, x_nl_s2)

# Check whether model type is 'iv'.
# 0 = Normal model, 1 = IV type model
# Prepare identified shock variable and add to exogenous data
if(specs\$model_type == 1){
# Prepare shock variable
shock           <- specs\$shock
colnames(shock) <- 'shock'
shock_name      <- colnames(shock)

# Make states of shock

shock_s1        <- shock %>%
dplyr::mutate_all(list(shock_s1 = ~.*(1 - fz)))  %>%
dplyr::select(-one_of(shock_name))

shock_s2        <- shock %>%
dplyr::mutate_all(list(shock_s2 = ~.*fz))        %>%
dplyr::select(-one_of(shock_name))

x_nl              <- cbind(shock_s1, shock_s2,  x_nl)
}

# Include no trend, trend or quadratic trend
if(specs\$trend == 0){

# Only constant
x_nl             <-   x_nl

} else if (specs\$trend == 1){

# Constant and trend
x_nl            <-   x_nl %>%
dplyr::mutate(trend = row_number())

}  else {

x_nl             <-   x_nl %>%
dplyr::mutate(trend = row_number())     %>%
dplyr::mutate(sq_trend = trend^2)
}

# Construct (lagged) exogenous data and merge it with lagged endogenous data
if(!(is.null(specs\$exog_data))){

# Create lagged exogenous data and merge with endogenous data
x_exog    <- create_lags(specs\$exog_data, specs\$lags_exog)     %>%
`rownames<-`(NULL)

x_nl      <- cbind(x_nl, x_exog)

}

# Add contemporaneous data if supplied
if(!(is.null(specs\$contemp_data))){

x_nl                         <- cbind(x_nl , specs\$contemp_data)

}

# Combine endogenous and exogenous data
yx_all    <- cbind(y_nl, fz, x_nl) %>%
stats::na.omit()

yx_all    <- yx_all[, !(colSums(yx_all) == Inf)]

y_nl      <- yx_all[, 1:ncol(endog_data)]  %>%
as.matrix()

fz        <- yx_all[, (1 + ncol(endog_data))]

x_nl      <- yx_all[, (2 + ncol(endog_data)): dim(yx_all)[2]]   %>%
as.matrix()

################################################################################
} else {
################################################################################

# Create list to store matrices
y_nl_store     <- rep(list(NaN), specs\$max_lags)
x_nl_store     <- rep(list(NaN), specs\$max_lags)
fz_store       <- rep(list(NaN), specs\$max_lags)

# Prepare data outside of loop

# Create list with endogenous variables
y_nl      <- endog_data

# Get transition probabilities by logistic function?
if(isTRUE(specs\$use_logistic)){

fz      <- get_vals_switching(specs\$switching, specs)

} else {

fz      <- specs\$switching
}

# Use first lag of value from switching function?
if(isTRUE(specs\$lag_switching)){

fz            <-   dplyr::lag(fz, 1)

}

# Prepare instrument variable
# Check whether model type is 'iv'.
# 0 = Normal model, 1 = IV model
# Prepare instrument variable and add to exogenous data
if(specs\$model_type == 1){
shock           <- specs\$shock
colnames(shock) <- 'shock'
shock_name     <- colnames(shock)
}

for(ii in 1:specs\$max_lags){

# Create lagged variables
x_nl_temp      <- create_lags(endog_data, ii)

linear_names   <- names(x_nl_temp)

x_nl_s1        <- x_nl_temp %>%
dplyr::mutate_all(list(s1 = ~.*(1 - fz))) %>%
dplyr::select(-one_of(linear_names))

x_nl_s2        <- x_nl_temp %>%
dplyr::mutate_all(list(s2 = ~.*fz))        %>%
dplyr::select(-one_of(linear_names))

x_nl            <- cbind(x_nl_s1, x_nl_s2)

# Prepare states of instrument
if(specs\$model_type == 1){
shock_s1      <- shock %>%
dplyr::mutate_all(list(shock_s1 = ~.*(1 - fz)))  %>%
dplyr::select(-one_of(shock_name))

shock_s2      <- shock %>%
dplyr::mutate_all(list(shock_s2 = ~.*fz))        %>%
dplyr::select(-one_of(shock_name))

x_nl          <- cbind(shock_s1, shock_s2,  x_nl)
}

if(specs\$trend == 0){

x_nl            <-   x_nl

} else if (specs\$trend == 1){

x_nl            <-   x_nl                                    %>%
dplyr::mutate(trend = row_number())

}  else {

x_nl            <-   x_nl                                       %>%
dplyr::mutate(trend = row_number())      %>%
dplyr::mutate(sq_trend = trend^2)
}

# Construct (lagged) exogenous data and merge it with lagged endogenous data
if(!(is.null(specs\$exog_data))){

x_exog    <- create_lags(specs\$exog_data, specs\$lags_exog)     %>%
`rownames<-`(NULL)
x_nl      <- cbind(x_nl, x_exog)

}

# Add contemporaneous data if set
if(!(is.null(specs\$contemp_data))){

x_nl      <- cbind(x_nl , specs\$contemp_data)

}

# Merge endogenous and exogenous data
yx_all               <-  cbind(y_nl, fz, x_nl)         %>%
stats::na.omit()

y_nl_store[[ii]]      <-  yx_all[, 1:ncol(endog_data)]  %>%
as.matrix()

fz_store[[ii]]        <-  yx_all[, (1 + ncol(endog_data))]

x_nl_store[[ii]]      <-  yx_all[, (2 + ncol(endog_data)): dim(yx_all)[2]]   %>%
as.matrix()

}
# Save values te return in list
y_nl <- y_nl_store
x_nl <- x_nl_store
fz   <- fz_store
}

return(list(y_nl = y_nl, x_nl = x_nl, fz = fz))
}
```

## Try the lpirfs package in your browser

Any scripts or data that you put into this service are public.

lpirfs documentation built on March 24, 2021, 1:10 a.m.