Last updated on 2020-02-19 10:48:57 CET.
Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
---|---|---|---|---|---|---|
r-devel-linux-x86_64-debian-clang | 0.2.1 | 7.98 | 55.02 | 63.00 | ERROR | |
r-devel-linux-x86_64-debian-gcc | 0.2.1 | 5.59 | 41.42 | 47.01 | ERROR | |
r-devel-linux-x86_64-fedora-clang | 0.2.1 | 74.75 | ERROR | |||
r-devel-linux-x86_64-fedora-gcc | 0.2.1 | 71.69 | ERROR | |||
r-devel-windows-ix86+x86_64 | 0.2.1 | 13.00 | 67.00 | 80.00 | OK | |
r-devel-windows-ix86+x86_64-gcc8 | 0.2.1 | 22.00 | 96.00 | 118.00 | OK | |
r-patched-linux-x86_64 | 0.2.1 | 7.04 | 48.08 | 55.12 | OK | |
r-patched-solaris-x86 | 0.2.1 | 91.10 | OK | |||
r-release-linux-x86_64 | 0.2.1 | 6.32 | 48.06 | 54.38 | OK | |
r-release-windows-ix86+x86_64 | 0.2.1 | 12.00 | 65.00 | 77.00 | OK | |
r-release-osx-x86_64 | 0.2.1 | OK | ||||
r-oldrel-windows-ix86+x86_64 | 0.2.1 | 11.00 | 59.00 | 70.00 | OK | |
r-oldrel-osx-x86_64 | 0.2.1 | OK |
Version: 0.2.1
Check: examples
Result: ERROR
Running examples in 'ioanalysis-Ex.R' failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: as.inputoutput
> ### Title: Creating an Input-Output Object
> ### Aliases: as.inputoutput
>
> ### ** Examples
>
> # In toy,FullIOTable it is a full matrix of characters: a pseudo worst case scenario
> data(toy.FullIOTable)
> Z <- matrix(as.numeric(toy.FullIOTable[3:12, 3:12]), ncol = 10)
> f <- matrix(as.numeric(toy.FullIOTable[3:12, c(13:15, 17:19)]), nrow = dim(Z)[1])
> E <- matrix(as.numeric(toy.FullIOTable[3:12, c(16, 20)]), nrow = 10)
> X <- matrix(as.numeric(toy.FullIOTable[3:12, 21]), ncol = 1)
> V <- matrix(as.numeric(toy.FullIOTable[13:15, 3:12]), ncol = 10)
> M <- as.numeric(toy.FullIOTable[16, 3:12])
> fV <- matrix(as.numeric(toy.FullIOTable[15:16, c(13:15,17:19)]), nrow = 2)
>
> # Note toy.FullIOTable is a matrix of characters: non-numeric
> toy.IO <- as.inputoutput(Z = Z, RS_label = toy.FullIOTable[3:12, 1:2],
+ f = f, f_label = toy.FullIOTable[1:2, c(13:15, 17:19)],
+ E = E, E_label = toy.FullIOTable[1:2, c(16, 20)],
+ X = X,
+ V = V, V_label = toy.FullIOTable[13:15, 2],
+ M = M, M_label = toy.FullIOTable[16,2],
+ fV = fV, fV_label = toy.FullIOTable[15:16, 2])
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
ioanalysis
--- call from context ---
as.inputoutput(Z = Z, RS_label = toy.FullIOTable[3:12, 1:2],
f = f, f_label = toy.FullIOTable[1:2, c(13:15, 17:19)], E = E,
E_label = toy.FullIOTable[1:2, c(16, 20)], X = X, V = V,
V_label = toy.FullIOTable[13:15, 2], M = M, M_label = toy.FullIOTable[16,
2], fV = fV, fV_label = toy.FullIOTable[15:16, 2])
--- call from argument ---
if (class(X) != "matrix") {
X = as.matrix(X)
}
--- R stacktrace ---
where 1: as.inputoutput(Z = Z, RS_label = toy.FullIOTable[3:12, 1:2],
f = f, f_label = toy.FullIOTable[1:2, c(13:15, 17:19)], E = E,
E_label = toy.FullIOTable[1:2, c(16, 20)], X = X, V = V,
V_label = toy.FullIOTable[13:15, 2], M = M, M_label = toy.FullIOTable[16,
2], fV = fV, fV_label = toy.FullIOTable[15:16, 2])
--- value of length: 2 type: logical ---
[1] FALSE TRUE
--- function from context ---
function (Z, RS_label, f, f_label, E, E_label, X, V, V_label,
M, M_label, fV, fV_label, P, P_label, A, B, L, G)
{
io <- NULL
n <- dim(Z)[1]
if (dim(Z)[1] != dim(Z)[2])
stop("The intermediate transaction (Z) matrix needs to be a square matrix")
if (dim(Z)[1] != length(X))
stop("Check dimensions/length; Z should be a nxn matrix and X should be a nx1 vector")
io$Z <- as.matrix(Z)
if (dim(RS_label)[1] != dim(io$Z)[1])
stop("Row dimension of Z and RS_label must match")
if (dim(RS_label)[2] != 2)
stop("RS_label must have the first column of regions and second regions sectors")
io$RS_label <- as.character(RS_label[, 1])
io$RS_label <- cbind(io$RS_label, as.character(RS_label[,
2]))
if (class(X) != "matrix") {
X = as.matrix(X)
}
io$X <- matrix(X, ncol = 1)
if (!missing(f)) {
if (class(f) != "matrix") {
f = as.matrix(f)
}
if (is.null(dim(f))) {
if (length(f) != dim(io$Z))
stop("Column dimension of f and Z must match")
io$f <- matrix(f, ncol = 1)
}
else {
if (dim(f)[1] != length(X))
stop("Column dimension of f and Z must match")
io$f <- as.matrix(f)
}
if (missing("f_label")) {
stop("If the final demand matrix (f) is supplied, a label must match")
}
if (is.null(dim(f_label))) {
if (length(f_label) != dim(io$f)[2])
stop("Column dimension of f and f_label must match")
io$E_label <- matrix(f_label, ncol = 1)
}
else {
if (dim(f_label)[2] != dim(io$f)[2])
stop("Column dimension of f and f_label must match")
io$f_label <- f_label
}
}
else if (missing(f)) {
cat("\n Final Demand matrix (f) was not provided. Calculating aggregate Final Demand... \n\n")
one <- matrix(rep(1, n))
io$f <- io$X - io$Z %*% one
io$f_label <- matrix(c("aggregate", "aggregate"))
}
if (!missing(E)) {
if (class(E) != "matrix") {
E = as.matrix(E)
}
if (is.null(dim(E))) {
if (length(E) != length(X))
stop("Column dimension of E and Z must match")
io$E <- matrix(E)
}
else {
if (dim(E)[1] != length(X))
stop("Check dimensions/length; E should be a nxm matrix")
io$E <- as.matrix(E)
}
if (missing("E_label")) {
stop("If the export matrix (E) is supplied, a label must match")
}
if (is.null(dim(E_label))) {
if (length(E_label) != dim(io$E)[2])
stop("Column dimension of E and E_label must match")
io$E_label <- matrix(E_label, ncol = 1)
}
else {
if (dim(E_label)[2] != dim(io$E)[2])
stop("Column dimension of E and E_label must match")
io$E_label <- E_label
}
}
if (!missing(V)) {
if (class(V) != "matrix") {
X = as.matrix(V)
}
if (is.null(dim(V))) {
if (length(V) != length(X))
stop("Row dimension of V and Z must match")
io$V <- matrix(V, nrow = 1)
}
else {
if (dim(V)[2] != length(X))
stop("Column dimension of V and Z must match")
io$V <- as.matrix(V)
}
if (missing(V_label)) {
stop("If the value added matrix (V) is supplied, a label must match")
}
if (is.null(dim(V_label))) {
if (length(V_label) != dim(io$V)[1])
stop("Row dimension of V and V_label must match")
io$V_label <- matrix(V_label, ncol = 1)
}
else {
if (dim(V_label)[1] != dim(io$V)[1])
stop("Row dimension of V and V_label must match")
io$V_label <- V_label
}
}
if (!missing(M)) {
if (missing(M_label)) {
stop("If the import matrix (M) is supplied, a label must match")
}
if (is.null(dim(M))) {
if (length(M) != length(X))
stop("Column dimension of M and Z must match")
io$M <- matrix(M, nrow = 1)
check <- 1
}
else {
if (dim(M)[2] != length(X))
stop("Column dimension of M and Z must match")
io$M <- as.matrix(M)
check <- 1
}
if (check == 1) {
if (!missing("M_label")) {
if (is.null(dim(M_label))) {
if (length(M_label) != dim(io$M)[1])
stop("Row dimension of M and M_label must match")
}
io$M_label <- matrix(M_label, nrow = 1)
}
}
else {
if (!missing("M_label")) {
if (is.null(dim(M_label))) {
if (length(M_label) != dim(io$M)[1])
stop("Row dimension of M and M_label must match")
io$M_label <- matrix(M_label, nrow = 1)
}
else {
if (dim(M_label)[1] != dim(io$M)[1])
stop("Row dimension of M and M_label must match")
io$M_label <- M_label
}
}
}
}
if (!missing(fV)) {
if (dim(fV)[2] != dim(f)[2])
stop("The number of columns of fV must match f. It's fine to have NAs in fV")
io$fV <- as.matrix(fV)
if (missing(fV_label))
stop("If the fV matrix is provided, there must be an fV_label")
if (dim(fV)[1] != length(fV_label))
stop("The number of rows of fV and fV_label must match")
io$fV_label <- matrix(fV_label)
}
if (!missing(P) & missing(P_label))
stop("If the physical matrix (P) is supplied, a label must match")
if (!missing(P) & !missing(P_label)) {
if (is.null(dim(P_label)))
stop("P_label must be an nx2 matrix")
if (dim(P)[1] != dim(P_label)[1])
stop("The row dimension of P must match P_label")
if (all(dim(P) != dim(A)))
stop("The dimensions of P and Z must match")
io$P = as.matrix(P)
io$P_label = P_label
}
i <- which(X == 0)
X[i] <- 1
if (missing(A)) {
xhat <- diag(c(1/X))
io$A <- Z %*% xhat
}
else {
if (class(A) != "matrix") {
A = as.matrix(A)
}
io$A <- A
}
io$A <- as.matrix(io$A)
if (missing(B)) {
xhat <- diag(c(1/X))
io$B <- xhat %*% Z
}
else {
if (class(B) != "matrix") {
B = as.matrix(B)
}
io$B <- B
}
io$B <- as.matrix(io$B)
if (missing(L)) {
io$L <- leontief.inv(A = io$A)
}
else {
if (class(L) != "matrix") {
L = as.matrix(L)
}
io$L = L
}
if (missing(G)) {
io$G <- ghosh.inv(B = io$B)
}
else {
if (class(G) != "matrix") {
G = as.matrix(G)
}
io$G = G
}
class(io) <- "InputOutput"
io
}
<bytecode: 0x4fdaec0>
<environment: namespace:ioanalysis>
--- function search by body ---
Function as.inputoutput in namespace ioanalysis has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(X) != "matrix") { : the condition has length > 1
Calls: as.inputoutput
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 0.2.1
Check: examples
Result: ERROR
Running examples in ‘ioanalysis-Ex.R’ failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: as.inputoutput
> ### Title: Creating an Input-Output Object
> ### Aliases: as.inputoutput
>
> ### ** Examples
>
> # In toy,FullIOTable it is a full matrix of characters: a pseudo worst case scenario
> data(toy.FullIOTable)
> Z <- matrix(as.numeric(toy.FullIOTable[3:12, 3:12]), ncol = 10)
> f <- matrix(as.numeric(toy.FullIOTable[3:12, c(13:15, 17:19)]), nrow = dim(Z)[1])
> E <- matrix(as.numeric(toy.FullIOTable[3:12, c(16, 20)]), nrow = 10)
> X <- matrix(as.numeric(toy.FullIOTable[3:12, 21]), ncol = 1)
> V <- matrix(as.numeric(toy.FullIOTable[13:15, 3:12]), ncol = 10)
> M <- as.numeric(toy.FullIOTable[16, 3:12])
> fV <- matrix(as.numeric(toy.FullIOTable[15:16, c(13:15,17:19)]), nrow = 2)
>
> # Note toy.FullIOTable is a matrix of characters: non-numeric
> toy.IO <- as.inputoutput(Z = Z, RS_label = toy.FullIOTable[3:12, 1:2],
+ f = f, f_label = toy.FullIOTable[1:2, c(13:15, 17:19)],
+ E = E, E_label = toy.FullIOTable[1:2, c(16, 20)],
+ X = X,
+ V = V, V_label = toy.FullIOTable[13:15, 2],
+ M = M, M_label = toy.FullIOTable[16,2],
+ fV = fV, fV_label = toy.FullIOTable[15:16, 2])
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
ioanalysis
--- call from context ---
as.inputoutput(Z = Z, RS_label = toy.FullIOTable[3:12, 1:2],
f = f, f_label = toy.FullIOTable[1:2, c(13:15, 17:19)], E = E,
E_label = toy.FullIOTable[1:2, c(16, 20)], X = X, V = V,
V_label = toy.FullIOTable[13:15, 2], M = M, M_label = toy.FullIOTable[16,
2], fV = fV, fV_label = toy.FullIOTable[15:16, 2])
--- call from argument ---
if (class(X) != "matrix") {
X = as.matrix(X)
}
--- R stacktrace ---
where 1: as.inputoutput(Z = Z, RS_label = toy.FullIOTable[3:12, 1:2],
f = f, f_label = toy.FullIOTable[1:2, c(13:15, 17:19)], E = E,
E_label = toy.FullIOTable[1:2, c(16, 20)], X = X, V = V,
V_label = toy.FullIOTable[13:15, 2], M = M, M_label = toy.FullIOTable[16,
2], fV = fV, fV_label = toy.FullIOTable[15:16, 2])
--- value of length: 2 type: logical ---
[1] FALSE TRUE
--- function from context ---
function (Z, RS_label, f, f_label, E, E_label, X, V, V_label,
M, M_label, fV, fV_label, P, P_label, A, B, L, G)
{
io <- NULL
n <- dim(Z)[1]
if (dim(Z)[1] != dim(Z)[2])
stop("The intermediate transaction (Z) matrix needs to be a square matrix")
if (dim(Z)[1] != length(X))
stop("Check dimensions/length; Z should be a nxn matrix and X should be a nx1 vector")
io$Z <- as.matrix(Z)
if (dim(RS_label)[1] != dim(io$Z)[1])
stop("Row dimension of Z and RS_label must match")
if (dim(RS_label)[2] != 2)
stop("RS_label must have the first column of regions and second regions sectors")
io$RS_label <- as.character(RS_label[, 1])
io$RS_label <- cbind(io$RS_label, as.character(RS_label[,
2]))
if (class(X) != "matrix") {
X = as.matrix(X)
}
io$X <- matrix(X, ncol = 1)
if (!missing(f)) {
if (class(f) != "matrix") {
f = as.matrix(f)
}
if (is.null(dim(f))) {
if (length(f) != dim(io$Z))
stop("Column dimension of f and Z must match")
io$f <- matrix(f, ncol = 1)
}
else {
if (dim(f)[1] != length(X))
stop("Column dimension of f and Z must match")
io$f <- as.matrix(f)
}
if (missing("f_label")) {
stop("If the final demand matrix (f) is supplied, a label must match")
}
if (is.null(dim(f_label))) {
if (length(f_label) != dim(io$f)[2])
stop("Column dimension of f and f_label must match")
io$E_label <- matrix(f_label, ncol = 1)
}
else {
if (dim(f_label)[2] != dim(io$f)[2])
stop("Column dimension of f and f_label must match")
io$f_label <- f_label
}
}
else if (missing(f)) {
cat("\n Final Demand matrix (f) was not provided. Calculating aggregate Final Demand... \n\n")
one <- matrix(rep(1, n))
io$f <- io$X - io$Z %*% one
io$f_label <- matrix(c("aggregate", "aggregate"))
}
if (!missing(E)) {
if (class(E) != "matrix") {
E = as.matrix(E)
}
if (is.null(dim(E))) {
if (length(E) != length(X))
stop("Column dimension of E and Z must match")
io$E <- matrix(E)
}
else {
if (dim(E)[1] != length(X))
stop("Check dimensions/length; E should be a nxm matrix")
io$E <- as.matrix(E)
}
if (missing("E_label")) {
stop("If the export matrix (E) is supplied, a label must match")
}
if (is.null(dim(E_label))) {
if (length(E_label) != dim(io$E)[2])
stop("Column dimension of E and E_label must match")
io$E_label <- matrix(E_label, ncol = 1)
}
else {
if (dim(E_label)[2] != dim(io$E)[2])
stop("Column dimension of E and E_label must match")
io$E_label <- E_label
}
}
if (!missing(V)) {
if (class(V) != "matrix") {
X = as.matrix(V)
}
if (is.null(dim(V))) {
if (length(V) != length(X))
stop("Row dimension of V and Z must match")
io$V <- matrix(V, nrow = 1)
}
else {
if (dim(V)[2] != length(X))
stop("Column dimension of V and Z must match")
io$V <- as.matrix(V)
}
if (missing(V_label)) {
stop("If the value added matrix (V) is supplied, a label must match")
}
if (is.null(dim(V_label))) {
if (length(V_label) != dim(io$V)[1])
stop("Row dimension of V and V_label must match")
io$V_label <- matrix(V_label, ncol = 1)
}
else {
if (dim(V_label)[1] != dim(io$V)[1])
stop("Row dimension of V and V_label must match")
io$V_label <- V_label
}
}
if (!missing(M)) {
if (missing(M_label)) {
stop("If the import matrix (M) is supplied, a label must match")
}
if (is.null(dim(M))) {
if (length(M) != length(X))
stop("Column dimension of M and Z must match")
io$M <- matrix(M, nrow = 1)
check <- 1
}
else {
if (dim(M)[2] != length(X))
stop("Column dimension of M and Z must match")
io$M <- as.matrix(M)
check <- 1
}
if (check == 1) {
if (!missing("M_label")) {
if (is.null(dim(M_label))) {
if (length(M_label) != dim(io$M)[1])
stop("Row dimension of M and M_label must match")
}
io$M_label <- matrix(M_label, nrow = 1)
}
}
else {
if (!missing("M_label")) {
if (is.null(dim(M_label))) {
if (length(M_label) != dim(io$M)[1])
stop("Row dimension of M and M_label must match")
io$M_label <- matrix(M_label, nrow = 1)
}
else {
if (dim(M_label)[1] != dim(io$M)[1])
stop("Row dimension of M and M_label must match")
io$M_label <- M_label
}
}
}
}
if (!missing(fV)) {
if (dim(fV)[2] != dim(f)[2])
stop("The number of columns of fV must match f. It's fine to have NAs in fV")
io$fV <- as.matrix(fV)
if (missing(fV_label))
stop("If the fV matrix is provided, there must be an fV_label")
if (dim(fV)[1] != length(fV_label))
stop("The number of rows of fV and fV_label must match")
io$fV_label <- matrix(fV_label)
}
if (!missing(P) & missing(P_label))
stop("If the physical matrix (P) is supplied, a label must match")
if (!missing(P) & !missing(P_label)) {
if (is.null(dim(P_label)))
stop("P_label must be an nx2 matrix")
if (dim(P)[1] != dim(P_label)[1])
stop("The row dimension of P must match P_label")
if (all(dim(P) != dim(A)))
stop("The dimensions of P and Z must match")
io$P = as.matrix(P)
io$P_label = P_label
}
i <- which(X == 0)
X[i] <- 1
if (missing(A)) {
xhat <- diag(c(1/X))
io$A <- Z %*% xhat
}
else {
if (class(A) != "matrix") {
A = as.matrix(A)
}
io$A <- A
}
io$A <- as.matrix(io$A)
if (missing(B)) {
xhat <- diag(c(1/X))
io$B <- xhat %*% Z
}
else {
if (class(B) != "matrix") {
B = as.matrix(B)
}
io$B <- B
}
io$B <- as.matrix(io$B)
if (missing(L)) {
io$L <- leontief.inv(A = io$A)
}
else {
if (class(L) != "matrix") {
L = as.matrix(L)
}
io$L = L
}
if (missing(G)) {
io$G <- ghosh.inv(B = io$B)
}
else {
if (class(G) != "matrix") {
G = as.matrix(G)
}
io$G = G
}
class(io) <- "InputOutput"
io
}
<bytecode: 0x55622a5e4e40>
<environment: namespace:ioanalysis>
--- function search by body ---
Function as.inputoutput in namespace ioanalysis has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(X) != "matrix") { : the condition has length > 1
Calls: as.inputoutput
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 0.2.1
Check: examples
Result: ERROR
Running examples in ‘ioanalysis-Ex.R’ failed
The error most likely occurred in:
> ### Name: as.inputoutput
> ### Title: Creating an Input-Output Object
> ### Aliases: as.inputoutput
>
> ### ** Examples
>
> # In toy,FullIOTable it is a full matrix of characters: a pseudo worst case scenario
> data(toy.FullIOTable)
> Z <- matrix(as.numeric(toy.FullIOTable[3:12, 3:12]), ncol = 10)
> f <- matrix(as.numeric(toy.FullIOTable[3:12, c(13:15, 17:19)]), nrow = dim(Z)[1])
> E <- matrix(as.numeric(toy.FullIOTable[3:12, c(16, 20)]), nrow = 10)
> X <- matrix(as.numeric(toy.FullIOTable[3:12, 21]), ncol = 1)
> V <- matrix(as.numeric(toy.FullIOTable[13:15, 3:12]), ncol = 10)
> M <- as.numeric(toy.FullIOTable[16, 3:12])
> fV <- matrix(as.numeric(toy.FullIOTable[15:16, c(13:15,17:19)]), nrow = 2)
>
> # Note toy.FullIOTable is a matrix of characters: non-numeric
> toy.IO <- as.inputoutput(Z = Z, RS_label = toy.FullIOTable[3:12, 1:2],
+ f = f, f_label = toy.FullIOTable[1:2, c(13:15, 17:19)],
+ E = E, E_label = toy.FullIOTable[1:2, c(16, 20)],
+ X = X,
+ V = V, V_label = toy.FullIOTable[13:15, 2],
+ M = M, M_label = toy.FullIOTable[16,2],
+ fV = fV, fV_label = toy.FullIOTable[15:16, 2])
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
ioanalysis
--- call from context ---
as.inputoutput(Z = Z, RS_label = toy.FullIOTable[3:12, 1:2],
f = f, f_label = toy.FullIOTable[1:2, c(13:15, 17:19)], E = E,
E_label = toy.FullIOTable[1:2, c(16, 20)], X = X, V = V,
V_label = toy.FullIOTable[13:15, 2], M = M, M_label = toy.FullIOTable[16,
2], fV = fV, fV_label = toy.FullIOTable[15:16, 2])
--- call from argument ---
if (class(X) != "matrix") {
X = as.matrix(X)
}
--- R stacktrace ---
where 1: as.inputoutput(Z = Z, RS_label = toy.FullIOTable[3:12, 1:2],
f = f, f_label = toy.FullIOTable[1:2, c(13:15, 17:19)], E = E,
E_label = toy.FullIOTable[1:2, c(16, 20)], X = X, V = V,
V_label = toy.FullIOTable[13:15, 2], M = M, M_label = toy.FullIOTable[16,
2], fV = fV, fV_label = toy.FullIOTable[15:16, 2])
--- value of length: 2 type: logical ---
[1] FALSE TRUE
--- function from context ---
function (Z, RS_label, f, f_label, E, E_label, X, V, V_label,
M, M_label, fV, fV_label, P, P_label, A, B, L, G)
{
io <- NULL
n <- dim(Z)[1]
if (dim(Z)[1] != dim(Z)[2])
stop("The intermediate transaction (Z) matrix needs to be a square matrix")
if (dim(Z)[1] != length(X))
stop("Check dimensions/length; Z should be a nxn matrix and X should be a nx1 vector")
io$Z <- as.matrix(Z)
if (dim(RS_label)[1] != dim(io$Z)[1])
stop("Row dimension of Z and RS_label must match")
if (dim(RS_label)[2] != 2)
stop("RS_label must have the first column of regions and second regions sectors")
io$RS_label <- as.character(RS_label[, 1])
io$RS_label <- cbind(io$RS_label, as.character(RS_label[,
2]))
if (class(X) != "matrix") {
X = as.matrix(X)
}
io$X <- matrix(X, ncol = 1)
if (!missing(f)) {
if (class(f) != "matrix") {
f = as.matrix(f)
}
if (is.null(dim(f))) {
if (length(f) != dim(io$Z))
stop("Column dimension of f and Z must match")
io$f <- matrix(f, ncol = 1)
}
else {
if (dim(f)[1] != length(X))
stop("Column dimension of f and Z must match")
io$f <- as.matrix(f)
}
if (missing("f_label")) {
stop("If the final demand matrix (f) is supplied, a label must match")
}
if (is.null(dim(f_label))) {
if (length(f_label) != dim(io$f)[2])
stop("Column dimension of f and f_label must match")
io$E_label <- matrix(f_label, ncol = 1)
}
else {
if (dim(f_label)[2] != dim(io$f)[2])
stop("Column dimension of f and f_label must match")
io$f_label <- f_label
}
}
else if (missing(f)) {
cat("\n Final Demand matrix (f) was not provided. Calculating aggregate Final Demand... \n\n")
one <- matrix(rep(1, n))
io$f <- io$X - io$Z %*% one
io$f_label <- matrix(c("aggregate", "aggregate"))
}
if (!missing(E)) {
if (class(E) != "matrix") {
E = as.matrix(E)
}
if (is.null(dim(E))) {
if (length(E) != length(X))
stop("Column dimension of E and Z must match")
io$E <- matrix(E)
}
else {
if (dim(E)[1] != length(X))
stop("Check dimensions/length; E should be a nxm matrix")
io$E <- as.matrix(E)
}
if (missing("E_label")) {
stop("If the export matrix (E) is supplied, a label must match")
}
if (is.null(dim(E_label))) {
if (length(E_label) != dim(io$E)[2])
stop("Column dimension of E and E_label must match")
io$E_label <- matrix(E_label, ncol = 1)
}
else {
if (dim(E_label)[2] != dim(io$E)[2])
stop("Column dimension of E and E_label must match")
io$E_label <- E_label
}
}
if (!missing(V)) {
if (class(V) != "matrix") {
X = as.matrix(V)
}
if (is.null(dim(V))) {
if (length(V) != length(X))
stop("Row dimension of V and Z must match")
io$V <- matrix(V, nrow = 1)
}
else {
if (dim(V)[2] != length(X))
stop("Column dimension of V and Z must match")
io$V <- as.matrix(V)
}
if (missing(V_label)) {
stop("If the value added matrix (V) is supplied, a label must match")
}
if (is.null(dim(V_label))) {
if (length(V_label) != dim(io$V)[1])
stop("Row dimension of V and V_label must match")
io$V_label <- matrix(V_label, ncol = 1)
}
else {
if (dim(V_label)[1] != dim(io$V)[1])
stop("Row dimension of V and V_label must match")
io$V_label <- V_label
}
}
if (!missing(M)) {
if (missing(M_label)) {
stop("If the import matrix (M) is supplied, a label must match")
}
if (is.null(dim(M))) {
if (length(M) != length(X))
stop("Column dimension of M and Z must match")
io$M <- matrix(M, nrow = 1)
check <- 1
}
else {
if (dim(M)[2] != length(X))
stop("Column dimension of M and Z must match")
io$M <- as.matrix(M)
check <- 1
}
if (check == 1) {
if (!missing("M_label")) {
if (is.null(dim(M_label))) {
if (length(M_label) != dim(io$M)[1])
stop("Row dimension of M and M_label must match")
}
io$M_label <- matrix(M_label, nrow = 1)
}
}
else {
if (!missing("M_label")) {
if (is.null(dim(M_label))) {
if (length(M_label) != dim(io$M)[1])
stop("Row dimension of M and M_label must match")
io$M_label <- matrix(M_label, nrow = 1)
}
else {
if (dim(M_label)[1] != dim(io$M)[1])
stop("Row dimension of M and M_label must match")
io$M_label <- M_label
}
}
}
}
if (!missing(fV)) {
if (dim(fV)[2] != dim(f)[2])
stop("The number of columns of fV must match f. It's fine to have NAs in fV")
io$fV <- as.matrix(fV)
if (missing(fV_label))
stop("If the fV matrix is provided, there must be an fV_label")
if (dim(fV)[1] != length(fV_label))
stop("The number of rows of fV and fV_label must match")
io$fV_label <- matrix(fV_label)
}
if (!missing(P) & missing(P_label))
stop("If the physical matrix (P) is supplied, a label must match")
if (!missing(P) & !missing(P_label)) {
if (is.null(dim(P_label)))
stop("P_label must be an nx2 matrix")
if (dim(P)[1] != dim(P_label)[1])
stop("The row dimension of P must match P_label")
if (all(dim(P) != dim(A)))
stop("The dimensions of P and Z must match")
io$P = as.matrix(P)
io$P_label = P_label
}
i <- which(X == 0)
X[i] <- 1
if (missing(A)) {
xhat <- diag(c(1/X))
io$A <- Z %*% xhat
}
else {
if (class(A) != "matrix") {
A = as.matrix(A)
}
io$A <- A
}
io$A <- as.matrix(io$A)
if (missing(B)) {
xhat <- diag(c(1/X))
io$B <- xhat %*% Z
}
else {
if (class(B) != "matrix") {
B = as.matrix(B)
}
io$B <- B
}
io$B <- as.matrix(io$B)
if (missing(L)) {
io$L <- leontief.inv(A = io$A)
}
else {
if (class(L) != "matrix") {
L = as.matrix(L)
}
io$L = L
}
if (missing(G)) {
io$G <- ghosh.inv(B = io$B)
}
else {
if (class(G) != "matrix") {
G = as.matrix(G)
}
io$G = G
}
class(io) <- "InputOutput"
io
}
<bytecode: 0x4f76528>
<environment: namespace:ioanalysis>
--- function search by body ---
Function as.inputoutput in namespace ioanalysis has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(X) != "matrix") { : the condition has length > 1
Calls: as.inputoutput
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 0.2.1
Check: examples
Result: ERROR
Running examples in ‘ioanalysis-Ex.R’ failed
The error most likely occurred in:
> ### Name: as.inputoutput
> ### Title: Creating an Input-Output Object
> ### Aliases: as.inputoutput
>
> ### ** Examples
>
> # In toy,FullIOTable it is a full matrix of characters: a pseudo worst case scenario
> data(toy.FullIOTable)
> Z <- matrix(as.numeric(toy.FullIOTable[3:12, 3:12]), ncol = 10)
> f <- matrix(as.numeric(toy.FullIOTable[3:12, c(13:15, 17:19)]), nrow = dim(Z)[1])
> E <- matrix(as.numeric(toy.FullIOTable[3:12, c(16, 20)]), nrow = 10)
> X <- matrix(as.numeric(toy.FullIOTable[3:12, 21]), ncol = 1)
> V <- matrix(as.numeric(toy.FullIOTable[13:15, 3:12]), ncol = 10)
> M <- as.numeric(toy.FullIOTable[16, 3:12])
> fV <- matrix(as.numeric(toy.FullIOTable[15:16, c(13:15,17:19)]), nrow = 2)
>
> # Note toy.FullIOTable is a matrix of characters: non-numeric
> toy.IO <- as.inputoutput(Z = Z, RS_label = toy.FullIOTable[3:12, 1:2],
+ f = f, f_label = toy.FullIOTable[1:2, c(13:15, 17:19)],
+ E = E, E_label = toy.FullIOTable[1:2, c(16, 20)],
+ X = X,
+ V = V, V_label = toy.FullIOTable[13:15, 2],
+ M = M, M_label = toy.FullIOTable[16,2],
+ fV = fV, fV_label = toy.FullIOTable[15:16, 2])
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
ioanalysis
--- call from context ---
as.inputoutput(Z = Z, RS_label = toy.FullIOTable[3:12, 1:2],
f = f, f_label = toy.FullIOTable[1:2, c(13:15, 17:19)], E = E,
E_label = toy.FullIOTable[1:2, c(16, 20)], X = X, V = V,
V_label = toy.FullIOTable[13:15, 2], M = M, M_label = toy.FullIOTable[16,
2], fV = fV, fV_label = toy.FullIOTable[15:16, 2])
--- call from argument ---
if (class(X) != "matrix") {
X = as.matrix(X)
}
--- R stacktrace ---
where 1: as.inputoutput(Z = Z, RS_label = toy.FullIOTable[3:12, 1:2],
f = f, f_label = toy.FullIOTable[1:2, c(13:15, 17:19)], E = E,
E_label = toy.FullIOTable[1:2, c(16, 20)], X = X, V = V,
V_label = toy.FullIOTable[13:15, 2], M = M, M_label = toy.FullIOTable[16,
2], fV = fV, fV_label = toy.FullIOTable[15:16, 2])
--- value of length: 2 type: logical ---
[1] FALSE TRUE
--- function from context ---
function (Z, RS_label, f, f_label, E, E_label, X, V, V_label,
M, M_label, fV, fV_label, P, P_label, A, B, L, G)
{
io <- NULL
n <- dim(Z)[1]
if (dim(Z)[1] != dim(Z)[2])
stop("The intermediate transaction (Z) matrix needs to be a square matrix")
if (dim(Z)[1] != length(X))
stop("Check dimensions/length; Z should be a nxn matrix and X should be a nx1 vector")
io$Z <- as.matrix(Z)
if (dim(RS_label)[1] != dim(io$Z)[1])
stop("Row dimension of Z and RS_label must match")
if (dim(RS_label)[2] != 2)
stop("RS_label must have the first column of regions and second regions sectors")
io$RS_label <- as.character(RS_label[, 1])
io$RS_label <- cbind(io$RS_label, as.character(RS_label[,
2]))
if (class(X) != "matrix") {
X = as.matrix(X)
}
io$X <- matrix(X, ncol = 1)
if (!missing(f)) {
if (class(f) != "matrix") {
f = as.matrix(f)
}
if (is.null(dim(f))) {
if (length(f) != dim(io$Z))
stop("Column dimension of f and Z must match")
io$f <- matrix(f, ncol = 1)
}
else {
if (dim(f)[1] != length(X))
stop("Column dimension of f and Z must match")
io$f <- as.matrix(f)
}
if (missing("f_label")) {
stop("If the final demand matrix (f) is supplied, a label must match")
}
if (is.null(dim(f_label))) {
if (length(f_label) != dim(io$f)[2])
stop("Column dimension of f and f_label must match")
io$E_label <- matrix(f_label, ncol = 1)
}
else {
if (dim(f_label)[2] != dim(io$f)[2])
stop("Column dimension of f and f_label must match")
io$f_label <- f_label
}
}
else if (missing(f)) {
cat("\n Final Demand matrix (f) was not provided. Calculating aggregate Final Demand... \n\n")
one <- matrix(rep(1, n))
io$f <- io$X - io$Z %*% one
io$f_label <- matrix(c("aggregate", "aggregate"))
}
if (!missing(E)) {
if (class(E) != "matrix") {
E = as.matrix(E)
}
if (is.null(dim(E))) {
if (length(E) != length(X))
stop("Column dimension of E and Z must match")
io$E <- matrix(E)
}
else {
if (dim(E)[1] != length(X))
stop("Check dimensions/length; E should be a nxm matrix")
io$E <- as.matrix(E)
}
if (missing("E_label")) {
stop("If the export matrix (E) is supplied, a label must match")
}
if (is.null(dim(E_label))) {
if (length(E_label) != dim(io$E)[2])
stop("Column dimension of E and E_label must match")
io$E_label <- matrix(E_label, ncol = 1)
}
else {
if (dim(E_label)[2] != dim(io$E)[2])
stop("Column dimension of E and E_label must match")
io$E_label <- E_label
}
}
if (!missing(V)) {
if (class(V) != "matrix") {
X = as.matrix(V)
}
if (is.null(dim(V))) {
if (length(V) != length(X))
stop("Row dimension of V and Z must match")
io$V <- matrix(V, nrow = 1)
}
else {
if (dim(V)[2] != length(X))
stop("Column dimension of V and Z must match")
io$V <- as.matrix(V)
}
if (missing(V_label)) {
stop("If the value added matrix (V) is supplied, a label must match")
}
if (is.null(dim(V_label))) {
if (length(V_label) != dim(io$V)[1])
stop("Row dimension of V and V_label must match")
io$V_label <- matrix(V_label, ncol = 1)
}
else {
if (dim(V_label)[1] != dim(io$V)[1])
stop("Row dimension of V and V_label must match")
io$V_label <- V_label
}
}
if (!missing(M)) {
if (missing(M_label)) {
stop("If the import matrix (M) is supplied, a label must match")
}
if (is.null(dim(M))) {
if (length(M) != length(X))
stop("Column dimension of M and Z must match")
io$M <- matrix(M, nrow = 1)
check <- 1
}
else {
if (dim(M)[2] != length(X))
stop("Column dimension of M and Z must match")
io$M <- as.matrix(M)
check <- 1
}
if (check == 1) {
if (!missing("M_label")) {
if (is.null(dim(M_label))) {
if (length(M_label) != dim(io$M)[1])
stop("Row dimension of M and M_label must match")
}
io$M_label <- matrix(M_label, nrow = 1)
}
}
else {
if (!missing("M_label")) {
if (is.null(dim(M_label))) {
if (length(M_label) != dim(io$M)[1])
stop("Row dimension of M and M_label must match")
io$M_label <- matrix(M_label, nrow = 1)
}
else {
if (dim(M_label)[1] != dim(io$M)[1])
stop("Row dimension of M and M_label must match")
io$M_label <- M_label
}
}
}
}
if (!missing(fV)) {
if (dim(fV)[2] != dim(f)[2])
stop("The number of columns of fV must match f. It's fine to have NAs in fV")
io$fV <- as.matrix(fV)
if (missing(fV_label))
stop("If the fV matrix is provided, there must be an fV_label")
if (dim(fV)[1] != length(fV_label))
stop("The number of rows of fV and fV_label must match")
io$fV_label <- matrix(fV_label)
}
if (!missing(P) & missing(P_label))
stop("If the physical matrix (P) is supplied, a label must match")
if (!missing(P) & !missing(P_label)) {
if (is.null(dim(P_label)))
stop("P_label must be an nx2 matrix")
if (dim(P)[1] != dim(P_label)[1])
stop("The row dimension of P must match P_label")
if (all(dim(P) != dim(A)))
stop("The dimensions of P and Z must match")
io$P = as.matrix(P)
io$P_label = P_label
}
i <- which(X == 0)
X[i] <- 1
if (missing(A)) {
xhat <- diag(c(1/X))
io$A <- Z %*% xhat
}
else {
if (class(A) != "matrix") {
A = as.matrix(A)
}
io$A <- A
}
io$A <- as.matrix(io$A)
if (missing(B)) {
xhat <- diag(c(1/X))
io$B <- xhat %*% Z
}
else {
if (class(B) != "matrix") {
B = as.matrix(B)
}
io$B <- B
}
io$B <- as.matrix(io$B)
if (missing(L)) {
io$L <- leontief.inv(A = io$A)
}
else {
if (class(L) != "matrix") {
L = as.matrix(L)
}
io$L = L
}
if (missing(G)) {
io$G <- ghosh.inv(B = io$B)
}
else {
if (class(G) != "matrix") {
G = as.matrix(G)
}
io$G = G
}
class(io) <- "InputOutput"
io
}
<bytecode: 0x5a3b910>
<environment: namespace:ioanalysis>
--- function search by body ---
Function as.inputoutput in namespace ioanalysis has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(X) != "matrix") { : the condition has length > 1
Calls: as.inputoutput
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc