Как применить свою собственную функцию к матрицам? - PullRequest
1 голос
/ 14 апреля 2020

Я новичок ie в R, и я учусь, как применять свою собственную функцию к матрицам. Я написал следующий код:

HAR_ReV<-function(vec){
  name<-rlang::enexpr(vec)
  x<-vec
  ReV_d = ReV_w = ReV_m = NULL

  TT = length(x)
  for (i in 31:TT){
    ReV_d[i] = x[(i-1)]
    ReV_w[i] = sum(x[(i-7):(i-1)],na.rm = T)/7 
    ReV_m[i] = sum(x[(i-30):(i-1)],na.rm = T)/30 
  }
  Realized_Variances = cbind(ReV_d, ReV_w, ReV_m)
  colnames(Realized_Variances)= c(paste("ReV_d",name, sep = "_"), 
                                  paste("ReV_w",name, sep = "_"),
                                  paste("ReV_m",name, sep = "_"))
  Realized_Variances
}

Код был создан для применения в векторах, а функция выше создает новую матрицу размером 3530 (включая NA) X 3 для каждого вектора. Теперь у меня есть матрица, которая содержит все векторы, и я хочу применить эту функцию, чтобы получить единичный размер матрицы 3530 x 36.

Моя матрица имеет следующую структуру:

Matrix<-matrix(1:45, nrow = 3530,   ncol = 12)
dimnames(Matrix) <- list(NULL, NULL)
dimnames(Matrix) <- list(c(1:3530), c("rrp_nsw_d", "rrp_qld_d"  , "rrp_sa_d", "rrp_vic_d",     "rrp_nsw_RV_pos", "rrp_qld_RV_pos", "rrp_sa_RV_pos", "rrp_vic_RV_pos", 
                      "rrp_nsw_RV_neg" , "rrp_qld_RV_neg", "rrp_sa_RV_neg", "rrp_vic_RV_neg"))

Спасибо за вашу помощь

Ответы [ 2 ]

1 голос
/ 14 апреля 2020

Следующее даст вам результат, который вы ищете:

result <- as.matrix(do.call("cbind", lapply(as.data.frame(Matrix), 
                                            function(x) {
                                              y <- as.integer(x); 
                                              HAR_ReV(y)
                                            })))

Очевидно, что я не могу уместить результат здесь, но вы можете проверить размеры результата:

dim(result)
#> [1] 3530   36
1 голос
/ 14 апреля 2020

Рассмотрим lapply, чтобы построить список матриц, которые вы затем можете cbind вместе в конце. Однако для этого требуется небольшая корректировка. Вместо определения name с rlang::enexpr, которое принимает буквальное имя аргумента, рассмотрите возможность передачи name в качестве параметра, такого как исходный номер столбца матрицы. Кроме того, заранее определите длину векторов, а не увеличивайте их в al oop:

Скорректированная функция

HAR_ReV <- function(vec, name){
  #name <- rlang::enexpr(vec)          # REMOVE LINE
  x <- vec
  TT <- length(x)
  # DEFINE VECTOR LENGTH IN ADVANCE (MORE EFFICIENT THAN GROWING THEM IN LOOP)
  ReV_d <- ReV_w <- ReV_m <- vector(mode="numeric", length=TT-30)

  for (i in 31:TT){
    ReV_d[i] <- x[(i-1)]
    ReV_w[i] <- sum(x[(i-7):(i-1)],na.rm = T)/7 
    ReV_m[i] <- sum(x[(i-30):(i-1)],na.rm = T)/30 
  }
  Realized_Variances <- cbind(ReV_d, ReV_w, ReV_m)
  colnames(Realized_Variances) <- c(paste("ReV_d", name, sep = "_"), 
                                    paste("ReV_w", name, sep = "_"),
                                    paste("ReV_m", name, sep = "_"))
  return(Realized_Variances)
}

Сборка матрицы

my_matrix <- matrix(1:45, nrow = 3530, ncol = 12,
                    dimnames = list(c(1:3530), 
                                    c("rrp_nsw_d", "rrp_qld_d"  , "rrp_sa_d", "rrp_vic_d",     
                                      "rrp_nsw_RV_pos", "rrp_qld_RV_pos", "rrp_sa_RV_pos", 
                                      "rrp_vic_RV_pos", "rrp_nsw_RV_neg" , "rrp_qld_RV_neg", 
                                      "rrp_sa_RV_neg", "rrp_vic_RV_neg")
                    )
)

# LIST OF MATRICES
final_matrix_list <- Map(function(i,n) HAR_ReV(my_matrix[,i], n), 
                         1:ncol(my_matrix), colnames(my_matrix))

# FINAL MATRIX
final_matrix <- do.call(cbind, final_matrix_list)

dim(final_matrix)
# [1] 3530   36

str(final_matrix)
# num [1:3530, 1:36] 0 0 0 0 0 0 0 0 0 0 ...
# - attr(*, "dimnames")=List of 2
# ..$ : NULL
# ..$ : chr [1:36] "ReV_d_rrp_nsw_d" "ReV_w_rrp_nsw_d" "ReV_m_rrp_nsw_d" "ReV_d_rrp_qld_d" ...

str(final_matrix)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...