Skip to content

Commit

Permalink
Style code
Browse files Browse the repository at this point in the history
  • Loading branch information
@github-actions
github-actions[bot] committed Aug 9, 2023
1 parent 8fa5bb8 commit faf34d8
Show file tree
Hide file tree
Showing 4 changed files with 93 additions and 100 deletions.
6 changes: 3 additions & 3 deletions R/deprecated.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
#' used to verify the output of id_fevdtd.
#'
#' @noRd
#'
#'
#' @param var, vars::VAR object
#' @param target, variable name or index to maximize its fevd
#' @param horizon, integer vector (can be length 1) of the horizon to maximize
Expand Down Expand Up @@ -75,7 +75,7 @@ id_fevdtd_bca <- function(var, target, horizon) {
#' used to verify the output of id_fevdfd.
#'
#' @noRd
#'
#'
#' @param var, vars::VAR object
#' @param target, variable name or index to maximize its fevd
#' @param freqs vector of length 2 of min and max frequencies (0:2pi)
Expand Down Expand Up @@ -171,7 +171,7 @@ id_fevdfd_bca <- function(var, target, freqs) {
#' 'hmax' in time domain first.
#'
#' @noRd
#'
#'
#' @param var, vars::VAR object
#' @param target, variable name or index to maximize its fevd
#' @param freqs vector of length 2 of min and max frequencies (0:2pi)
Expand Down
61 changes: 30 additions & 31 deletions R/id_fevdfd.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -121,47 +121,46 @@ id_fevdfd.varboot <- function(
#'
#' @export
id_fevdfd.bvartools <- function(
x,
target,
freqs,
grid_size = 1000,
sign = "positive",
sign_horizon = 1
) {
k <- nrow(x$y)
p <- ncol(x$A[, 1]) %% k
var_names <- rownames(x$y)
iterations <- ncol(x$Sigma)
x,
target,
freqs,
grid_size = 1000,
sign = "positive",
sign_horizon = 1) {
k <- nrow(x$y)
p <- ncol(x$A[, 1]) %% k

Check warning on line 131 in R/id_fevdfd.R

View workflow job for this annotation

GitHub Actions / lint 

file=R/id_fevdfd.R,line=131,col=3,[object_usage_linter] local variable 'p' assigned but may not be used
var_names <- rownames(x$y)
iterations <- ncol(x$Sigma)

ti <- which(var_names == target)
ti <- which(var_names == target)

rots_sigma <- matrix(NA, k^2, iterations)
rots_sigma <- matrix(NA, k^2, iterations)

## Find the main shock rotation matrices, q, and rotate the sigma matrix
for (i in 1:iterations) {
if (i %% 10^2 == 0) print(i)
a <- matrix(x$A[, i], k)
c <- matrix(x$C[, i], k, 1)
## Find the main shock rotation matrices, q, and rotate the sigma matrix
for (i in 1:iterations) {
if (i %% 10^2 == 0) print(i)
a <- matrix(x$A[, i], k)
c <- matrix(x$C[, i], k, 1)

a_hat <- cbind(c, a)
a_hat <- cbind(c, a)

sigma <- matrix(x$Sigma[, i], k, k)
b <- t(chol(sigma))
sigma <- matrix(x$Sigma[, i], k, k)
b <- t(chol(sigma))

q <- id_fevdfd_findq(a_hat, b, ti, freqs, grid_size)
q <- id_fevdfd_findq(a_hat, b, ti, freqs, grid_size)

impulse <- b %*% q
if (impulse[ti, 1] < 0) impulse <- impulse * -1
impulse <- b %*% q
if (impulse[ti, 1] < 0) impulse <- impulse * -1

rots_sigma[, i] <- c(impulse)
}
rots_sigma[, i] <- c(impulse)
}

mvar <- x
mvar$method <- "id_fevdfd"
mvar$Sigma <- rots_sigma
mvar <- x
mvar$method <- "id_fevdfd"
mvar$Sigma <- rots_sigma

return(mvar)
}
return(mvar)
}



Expand Down
61 changes: 29 additions & 32 deletions R/id_fevdtd.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -37,8 +37,7 @@ id_fevdtd.varest <- function(
target,
horizon,
sign = "positive",
sign_horizon = 1
) {
sign_horizon = 1) {
n <- colnames(x$y)
k <- length(n)
ni <- 1:k
Expand Down Expand Up @@ -114,46 +113,44 @@ id_fevdtd.varboot <- function(
#' @export
#'
id_fevdtd.bvartools <- function(
x,
target,
horizon,
sign = "positive",
sign_horizon = 1
) {

k <- nrow(x$y)
p <- ncol(x$A[, 1]) %% k
var_names <- rownames(x$y)
iterations <- ncol(x$Sigma)
x,
target,
horizon,
sign = "positive",
sign_horizon = 1) {
k <- nrow(x$y)
p <- ncol(x$A[, 1]) %% k

Check warning on line 122 in R/id_fevdtd.R

View workflow job for this annotation

GitHub Actions / lint 

file=R/id_fevdtd.R,line=122,col=3,[object_usage_linter] local variable 'p' assigned but may not be used
var_names <- rownames(x$y)
iterations <- ncol(x$Sigma)

ti <- which(var_names == target)
ti <- which(var_names == target)

rots_sigma <- matrix(NA, k^2, iterations)
rots_sigma <- matrix(NA, k^2, iterations)

## Find the main shock rotation matrices, q, and rotate the sigma matrix
for (i in 1:iterations) {
if (i %% 10^2 == 0) print(i)
a <- matrix(x$A[, i], k)
c <- matrix(x$C[, i], k, 1)
## Find the main shock rotation matrices, q, and rotate the sigma matrix
for (i in 1:iterations) {
if (i %% 10^2 == 0) print(i)
a <- matrix(x$A[, i], k)
c <- matrix(x$C[, i], k, 1)

a_hat <- cbind(c, a)
a_hat <- cbind(c, a)

sigma <- matrix(x$Sigma[, i], k, k)
b <- t(chol(sigma))
sigma <- matrix(x$Sigma[, i], k, k)
b <- t(chol(sigma))

q <- id_fevdtd_findq(a_hat, b, ti, horizon)
q <- id_fevdtd_findq(a_hat, b, ti, horizon)

impulse <- b %*% q
if (impulse[ti, 1] < 0) impulse <- impulse * -1
impulse <- b %*% q
if (impulse[ti, 1] < 0) impulse <- impulse * -1

rots_sigma[, i] <- c(impulse)
}
rots_sigma[, i] <- c(impulse)
}

mvar <- x
mvar$method <- "id_fevdtd"
mvar$Sigma <- rots_sigma
mvar <- x
mvar$method <- "id_fevdtd"
mvar$Sigma <- rots_sigma

return(mvar)
return(mvar)
}


Expand Down
65 changes: 31 additions & 34 deletions R/irf.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,8 +44,7 @@ irf.fevdvar <- function(
ci = 0.95,
runs = 100,
seed = NULL,
...
) {
...) {
class(x) <- "svars"

k <- x$K
Expand Down Expand Up @@ -100,46 +99,44 @@ irf.bvartools <- function(
ci = 0.95,
runs = 100,
seed = NULL,
...
) {
...) {
k <- nrow(x$y)
var_names <- rownames(x$y)
iterations <- ncol(x$Sigma)

k <- nrow(x$y)
var_names <- rownames(x$y)
iterations <- ncol(x$Sigma)

if (x$method %in% c("id_fevdfd", "id_fevdtd")) {
shock_names <- c("Main", paste0("Orth_", 2:k))
} else {
shock_names <- paste0("V", 1:k)
}

iter_irfs <- array(NA, dim = c(k, k, n.ahead, iterations))
if (x$method %in% c("id_fevdfd", "id_fevdtd")) {
shock_names <- c("Main", paste0("Orth_", 2:k))
} else {
shock_names <- paste0("V", 1:k)
}

for (i in 1:iterations) {
a <- matrix(x$A[, i], k)
c <- matrix(x$C[, i], k, 1)
iter_irfs <- array(NA, dim = c(k, k, n.ahead, iterations))

a_hat <- cbind(c, a)
for (i in 1:iterations) {
a <- matrix(x$A[, i], k)
c <- matrix(x$C[, i], k, 1)

sig <- matrix(x$Sigma[, i], k, k)
a_hat <- cbind(c, a)

ssv <- as_statespace_var(a_hat, sig)
sig <- matrix(x$Sigma[, i], k, k)

iter_irfs[, , , i] <- irf_ssv(ssv, n_ahead = n.ahead)
}
ssv <- as_statespace_var(a_hat, sig)

## Create tidy IRF DF
irf_df <- data.frame(
h = rep(1:n.ahead, each = k * k),
shock = rep(shock_names, each = k, times = n.ahead),
variable = rep(var_names, times = k * n.ahead),
mean = c(rowMeans(iter_irfs, dims = 3)),
median = c(apply(iter_irfs, c(1, 2, 3), stats::median)),
lower = c(apply(iter_irfs, c(1, 2, 3), stats::quantile, probs = 0.16)),
upper = c(apply(iter_irfs, c(1, 2, 3), stats::quantile, probs = 0.84))
)
iter_irfs[, , , i] <- irf_ssv(ssv, n_ahead = n.ahead)
}

return(irf_df)
## Create tidy IRF DF
irf_df <- data.frame(
h = rep(1:n.ahead, each = k * k),
shock = rep(shock_names, each = k, times = n.ahead),
variable = rep(var_names, times = k * n.ahead),
mean = c(rowMeans(iter_irfs, dims = 3)),
median = c(apply(iter_irfs, c(1, 2, 3), stats::median)),
lower = c(apply(iter_irfs, c(1, 2, 3), stats::quantile, probs = 0.16)),
upper = c(apply(iter_irfs, c(1, 2, 3), stats::quantile, probs = 0.84))
)

return(irf_df)
}


Expand Down

0 comments on commit faf34d8

Please sign in to comment.