pkg/R/lagImpactMat.R

   1 ### This function is a copy of spdep:::lagImpactMat
   2 ### It has been copied because lagImpactMat is not exported by spdep
   3 ### There is no help available for lagImpactMat in spdep,
   4 ### so I have not provided any help, and I am unable to trace the author
   5 ###
   6 lagImpactMat <- function (x, reportQ = NULL)
   7 {
   8   if (is.null(x$res)) {
   9     direct <- x$direct
  10     indirect <- x$indirect
  11     total <- x$total
  12   } else {
  13     direct <- x$res$direct
  14     indirect <- x$res$indirect
  15     total <- x$res$total
  16   }
  17   mat <- cbind(direct, indirect, total)
  18   colnames(mat) <- c("Direct", "Indirect", "Total")
  19   rownames(mat) <- attr(x, "bnames")
  20   if (!is.null(reportQ) && reportQ) {
  21     if (is.null(x$res)) {
  22       Qobj <- attr(x, "Qres")
  23     } else {
  24       Qobj <- attr(x$res, "Qres")
  25     }
  26     if (is.null(Qobj)) {
  27       warning("No impact components to report")
  28     } else {
  29       if (length(attr(x, "bnames")) == 1L) {
  30         Qobj$direct <- matrix(Qobj$direct, ncol = 1)
  31         Qobj$indirect <- matrix(Qobj$indirect, ncol = 1)
  32         Qobj$total <- matrix(Qobj$total, ncol = 1)
  33       }
  34       colnames(Qobj$direct) <- attr(x, "bnames")
  35       colnames(Qobj$indirect) <- attr(x, "bnames")
  36       colnames(Qobj$total) <- attr(x, "bnames")
  37       rownames(Qobj$direct) <- paste0("Q", 1:nrow(Qobj$direct))
  38       rownames(Qobj$indirect) <- paste0("Q", 1:nrow(Qobj$indirect))
  39       rownames(Qobj$total) <- paste0("Q", 1:nrow(Qobj$total))
  40       attr(mat, "Qobj") <- Qobj
  41     }
  42   }
  43   mat
  44 }