]> git.donarmstrong.com Git - xtable.git/commitdiff
Added lagImpact.R
authordscott <dscott@edb9625f-4e0d-4859-8d74-9fd3b1da38cb>
Fri, 29 Jan 2016 02:34:04 +0000 (02:34 +0000)
committerdscott <dscott@edb9625f-4e0d-4859-8d74-9fd3b1da38cb>
Fri, 29 Jan 2016 02:34:04 +0000 (02:34 +0000)
git-svn-id: svn://scm.r-forge.r-project.org/svnroot/xtable@108 edb9625f-4e0d-4859-8d74-9fd3b1da38cb

pkg/R/lagImpactMat.R [new file with mode: 0644]

diff --git a/pkg/R/lagImpactMat.R b/pkg/R/lagImpactMat.R
new file mode 100644 (file)
index 0000000..1ec881b
--- /dev/null
@@ -0,0 +1,44 @@
+### This function is a copy of spdep:::lagImpactMat
+### It has been copied because lagImpactMat is not exported by spdep
+### There is no help available for lagImpactMat in spdep,
+### so I have not provided any help, and I am unable to trace the author
+###
+lagImpactMat <- function (x, reportQ = NULL) 
+{
+  if (is.null(x$res)) {
+    direct <- x$direct
+    indirect <- x$indirect
+    total <- x$total
+  } else {
+    direct <- x$res$direct
+    indirect <- x$res$indirect
+    total <- x$res$total
+  }
+  mat <- cbind(direct, indirect, total)
+  colnames(mat) <- c("Direct", "Indirect", "Total")
+  rownames(mat) <- attr(x, "bnames")
+  if (!is.null(reportQ) && reportQ) {
+    if (is.null(x$res)) {
+      Qobj <- attr(x, "Qres")
+    } else {
+      Qobj <- attr(x$res, "Qres")
+    }
+    if (is.null(Qobj)) {
+      warning("No impact components to report")
+    } else {
+      if (length(attr(x, "bnames")) == 1L) {
+        Qobj$direct <- matrix(Qobj$direct, ncol = 1)
+        Qobj$indirect <- matrix(Qobj$indirect, ncol = 1)
+        Qobj$total <- matrix(Qobj$total, ncol = 1)
+      }
+      colnames(Qobj$direct) <- attr(x, "bnames")
+      colnames(Qobj$indirect) <- attr(x, "bnames")
+      colnames(Qobj$total) <- attr(x, "bnames")
+      rownames(Qobj$direct) <- paste0("Q", 1:nrow(Qobj$direct))
+      rownames(Qobj$indirect) <- paste0("Q", 1:nrow(Qobj$indirect))
+      rownames(Qobj$total) <- paste0("Q", 1:nrow(Qobj$total))
+      attr(mat, "Qobj") <- Qobj
+    }
+  }
+  mat
+}