SCM

SCM Repository

[matrix] Diff of /pkg/Matrix/R/diagMatrix.R
ViewVC logotype

Diff of /pkg/Matrix/R/diagMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2197, Mon Jun 2 14:34:42 2008 UTC revision 2239, Mon Jul 28 19:26:40 2008 UTC
# Line 32  Line 32 
32      }      }
33  }  }
34    
35  ## Pkg 'spdep' had (relatively slow) versions of this as_dsCMatrix_I()  .sparseDiagonal <- function(n, x = rep.int(1,n), uplo = "U", shape = "t") {
 .symDiagonal <- function(n, x = rep.int(1,n), uplo = "U") {  
36      stopifnot(n == (n. <- as.integer(n)), (n <- n.) >= 0)      stopifnot(n == (n. <- as.integer(n)), (n <- n.) >= 0)
37      if((lx <- length(x)) == 1) x <- rep.int(x, n)      if((lx <- length(x)) == 1) x <- rep.int(x, n)
38      else if(lx != n) stop("length(x) must be 1 or n")      else if(lx != n) stop("length(x) must be 1 or n")
39      cls <-      stopifnot(is.character(shape), nchar(shape) == 1,
40          if(is.double(x)) "dsCMatrix"                any(shape == c("t","s","g"))) # triangular / symmetric / general
41          else if(is.logical(x)) "lsCMatrix"      kind <-
42            if(is.double(x)) "d"
43            else if(is.logical(x)) "l"
44          else { ## for now          else { ## for now
45              storage.mode(x) <- "double"              storage.mode(x) <- "double"
46              "dsCMatrix"              "d"
47          }          }
48      new(cls, Dim = c(n,n), x = x, uplo = uplo,      new(paste(kind, shape, "CMatrix", sep=''),
49            Dim = c(n,n), x = x, uplo = uplo,
50          i = if(n) 0:(n - 1L) else integer(0), p = 0:n)          i = if(n) 0:(n - 1L) else integer(0), p = 0:n)
51  }  }
52    
53    ## Pkg 'spdep' had (relatively slow) versions of this as_dsCMatrix_I()
54    .symDiagonal <- function(n, x = rep.int(1,n), uplo = "U")
55        .sparseDiagonal(n, x, uplo, shape = "s")
56    
57    ## instead of   diagU2N(as(Diagonal(n), "CsparseMatrix")), diag = "N" in any case:
58    .trDiagonal <- function(n, x = rep.int(1,n), uplo = "U")
59        .sparseDiagonal(n, x, uplo, shape = "t")
60    
61    
62  ### This is modified from a post of Bert Gunter to R-help on  1 Sep 2005.  ### This is modified from a post of Bert Gunter to R-help on  1 Sep 2005.
63  ### Bert's code built on a post by Andy Liaw who most probably was influenced  ### Bert's code built on a post by Andy Liaw who most probably was influenced
64  ### by earlier posts, notably one by Scott Chasalow on S-news, 16 Jan 2002  ### by earlier posts, notably one by Scott Chasalow on S-news, 16 Jan 2002
65  ### who posted his bdiag() function written in December 1995.  ### who posted his bdiag() function written in December 1995.
66    if(FALSE)##--- no longer used:
67  bdiag <- function(...) {  .bdiag <- function(lst) {
68      if(nargs() == 0) return(new("dgCMatrix"))      ### block-diagonal matrix [a dgTMatrix] from list of matrices
69      ## else :      stopifnot(is.list(lst), length(lst) >= 1)
70      mlist <- if (nargs() == 1) as.list(...) else list(...)      dims <- sapply(lst, dim, USE.NAMES=FALSE)
     dims <- sapply(mlist, dim)  
71      ## make sure we had all matrices:      ## make sure we had all matrices:
72      if(!(is.matrix(dims) && nrow(dims) == 2))      if(!(is.matrix(dims) && nrow(dims) == 2))
73          stop("some arguments are not matrices")          stop("some arguments are not matrices")
74      csdim <- rbind(rep.int(0L, 2),      csdim <- rbind(rep.int(0L, 2),
75                     apply(sapply(mlist, dim), 1, cumsum))                     apply(dims, 1, cumsum))
76      ret <- new("dgTMatrix", Dim = as.integer(csdim[nrow(csdim),]))      r <- new("dgTMatrix")
77        r@Dim <- as.integer(csdim[nrow(csdim),])
78      add1 <- matrix(1:0, 2,2)      add1 <- matrix(1:0, 2,2)
79      for(i in seq_along(mlist)) {      for(i in seq_along(lst)) {
80          indx <- apply(csdim[i:(i+1),] + add1, 2, function(n) n[1]:n[2])          indx <- apply(csdim[i:(i+1),] + add1, 2, function(n) n[1]:n[2])
81          if(is.null(dim(indx))) ## non-square matrix          if(is.null(dim(indx))) ## non-square matrix
82              ret[indx[[1]],indx[[2]]] <- mlist[[i]]              r[indx[[1]],indx[[2]]] <- lst[[i]]
83          else ## square matrix          else ## square matrix
84              ret[indx[,1],indx[,2]] <- mlist[[i]]              r[indx[,1], indx[,2]] <- lst[[i]]
85        }
86        r
87    }
88    ## expand(<mer>) needed something like bdiag() for lower-triangular
89    ## (Tsparse) Matrices; hence Doug Bates provided a much more efficient
90    ##  implementation for those; now extended and generalized:
91    .bdiag <- function(lst) {
92        ## block-diagonal matrix [a dgTMatrix] from list of matrices
93        stopifnot(is.list(lst), (nl <- length(lst)) >= 1)
94    
95        Tlst <- lapply(lapply(lst, Matrix:::as_Csp2), # includes "diagU2N"
96                       as, "TsparseMatrix")
97        if(nl == 1) return(Tlst[[1]])
98        ## else
99        i_off <- c(0L, cumsum(sapply(Tlst, nrow)))
100        j_off <- c(0L, cumsum(sapply(Tlst, ncol)))
101    
102        clss <- sapply(Tlst, class)
103        knds <- substr(clss, 2, 2)
104        sym  <- knds == "s" # symmetric ones
105        tri  <- knds == "t" # triangular ones
106        use.n <- any(is.n <- substr(clss,1,1) == "n")
107        if(use.n && !(use.n <- all(is.n)))
108            Tlst[is.n] <- lapply(Tlst[is.n], as, "lMatrix")
109        if(all(sym)) { ## result should be *symmetric*
110            uplos <- sapply(Tlst, slot, "uplo") ## either "U" or "L"
111            tLU <- table(uplos)# of length 1 or 2 ..
112            if(length(tLU) == 1) { ## all "U" or all "L"
113                useU <- uplos[1] == "U"
114            } else { ## length(tLU) == 2, counting "L" and "U"
115                useU <- diff(tLU) >= 0
116                if(useU && (hasL <- tLU[1] > 0))
117                    Tlst[hasL] <- lapply(Tlst[hasL], t)
118                else if(!useU && (hasU <- tLU[2] > 0))
119                    Tlst[hasU] <- lapply(Tlst[hasU], t)
120            }
121            if(use.n) { ## return nsparseMatrix :
122                r <- new("nsTMatrix")
123            } else {
124                r <- new("dsTMatrix")
125                r@x <- unlist(lapply(Tlst, slot, "x"))
126            }
127            r@uplo <- if(useU) "U" else "L"
128      }      }
129      ## slightly debatable if we really should return Csparse.. :      else if(all(tri) && { ULs <- sapply(Tlst, slot, "uplo")##  "U" or "L"
130      as(ret, "CsparseMatrix")                            all(ULs[1L] == ULs[-1L]) } ## all upper or all lower
131           ){ ## *triangular* result
132    
133            if(use.n) { ## return nsparseMatrix :
134                r <- new("ntTMatrix")
135            } else {
136                r <- new("dtTMatrix")
137                r@x <- unlist(lapply(Tlst, slot, "x"))
138            }
139            r@uplo <- ULs[1L]
140        }
141        else {
142            if(any(sym))
143                Tlst[sym] <- lapply(Tlst[sym], as, "generalMatrix")
144            if(use.n) { ## return nsparseMatrix :
145                r <- new("ngTMatrix")
146            } else {
147                r <- new("dgTMatrix")
148                r@x <- unlist(lapply(Tlst, slot, "x"))
149            }
150        }
151        r@Dim <- c(i_off[nl+1], j_off[nl + 1])
152        r@i <- unlist(lapply(1:nl, function(k) Tlst[[k]]@i + i_off[k]))
153        r@j <- unlist(lapply(1:nl, function(k) Tlst[[k]]@j + j_off[k]))
154        r
155    }
156    
157    bdiag <- function(...) {
158        if((nA <- nargs()) == 0) return(new("dgCMatrix"))
159        if(nA == 1 && !is.list(...))
160            return(as(..., "CsparseMatrix"))
161        alis <- if(nA == 1 && is.list(..1)) ..1 else list(...)
162        if(length(alis) == 1)
163            return(as(alis[[1]], "CsparseMatrix"))
164    
165        ## else : two or more arguments
166        as(.bdiag(alis), "CsparseMatrix")
167  }  }
168    
169    
# Line 124  Line 214 
214  ## ddi*:  ## ddi*:
215  diag2tT <- function(from) .diag2tT(from, "U", "d")  diag2tT <- function(from) .diag2tT(from, "U", "d")
216  setAs("ddiMatrix", "triangularMatrix", diag2tT)  setAs("ddiMatrix", "triangularMatrix", diag2tT)
217  setAs("ddiMatrix", "sparseMatrix", diag2tT)  ##_no_longer_ setAs("ddiMatrix", "sparseMatrix", diag2tT)
218  ## needed too (otherwise <dense> -> Tsparse is taken):  ## needed too (otherwise <dense> -> Tsparse is taken):
219  setAs("ddiMatrix", "TsparseMatrix", diag2tT)  setAs("ddiMatrix", "TsparseMatrix", diag2tT)
220  setAs("ddiMatrix", "CsparseMatrix",  setAs("ddiMatrix", "CsparseMatrix",
# Line 135  Line 225 
225  ## ldi*:  ## ldi*:
226  diag2tT <- function(from) .diag2tT(from, "U", "l")  diag2tT <- function(from) .diag2tT(from, "U", "l")
227  setAs("ldiMatrix", "triangularMatrix", diag2tT)  setAs("ldiMatrix", "triangularMatrix", diag2tT)
228  setAs("ldiMatrix", "sparseMatrix", diag2tT)  ##_no_longer_ setAs("ldiMatrix", "sparseMatrix", diag2tT)
229  ## needed too (otherwise <dense> -> Tsparse is taken):  ## needed too (otherwise <dense> -> Tsparse is taken):
230  setAs("ldiMatrix", "TsparseMatrix", diag2tT)  setAs("ldiMatrix", "TsparseMatrix", diag2tT)
231  setAs("ldiMatrix", "CsparseMatrix",  setAs("ldiMatrix", "CsparseMatrix",
# Line 152  Line 242 
242                Dim = from@Dim, Dimnames = from@Dimnames)                Dim = from@Dim, Dimnames = from@Dimnames)
243        })        })
244    
245    setAs("diagonalMatrix", "nsparseMatrix", function(from) as(from, "nMatrix"))
246    
247  ## Cheap fast substitute for diag() which *does* preserve the mode of x :  ## Cheap fast substitute for diag() which *does* preserve the mode of x :
248  mkDiag <- function(x, n) {  mkDiag <- function(x, n) {
# Line 240  Line 331 
331            function(x = 1, nrow, ncol) .diag.x(x))            function(x = 1, nrow, ncol) .diag.x(x))
332    
333  subDiag <- function(x, i, j, ..., drop) {  subDiag <- function(x, i, j, ..., drop) {
334      x <- as(x, "sparseMatrix")      x <- as(x, "TsparseMatrix")
335      x <- if(missing(i))      x <- if(missing(i))
336          x[, j, drop=drop]          x[, j, drop=drop]
337      else if(missing(j))      else if(missing(j))
# Line 264  Line 355 
355  ## FIXME: this now fails because the "denseMatrix" methods come first in dispatch  ## FIXME: this now fails because the "denseMatrix" methods come first in dispatch
356  ## Only(?) current bug:  x[i] <- value  is wrong when  i is *vector*  ## Only(?) current bug:  x[i] <- value  is wrong when  i is *vector*
357  replDiag <- function(x, i, j, ..., value) {  replDiag <- function(x, i, j, ..., value) {
358      x <- as(x, "sparseMatrix")      x <- as(x, "TsparseMatrix")
359      if(missing(i))      if(missing(i))
360          x[, j] <- value          x[, j] <- value
361      else if(missing(j)) { ##  x[i , ] <- v  *OR*   x[i] <- v      else if(missing(j)) { ##  x[i , ] <- v  *OR*   x[i] <- v
# Line 309  Line 400 
400                               x@x[ii] <- value                               x@x[ii] <- value
401                               x                               x
402                           } else { ## no longer diagonal, but remain sparse:                           } else { ## no longer diagonal, but remain sparse:
403                               x <- as(x, "sparseMatrix")                               x <- as(x, "TsparseMatrix")
404                               x[i] <- value                               x[i] <- value
405                               x                               x
406                           }                           }
# Line 325  Line 416 
416                                  j = "index", value = "replValue"),                                  j = "index", value = "replValue"),
417                   function(x,i,j, ..., value) replDiag(x, j=j, value=value))                   function(x,i,j, ..., value) replDiag(x, j=j, value=value))
418    
419    setReplaceMethod("[", signature(x = "diagonalMatrix", i = "missing", j = "index",
420                                    value = "sparseMatrix"),
421                     function (x, i, j, ..., value)
422                     callGeneric(x=x, , j=j, value = as(value, "sparseVector")))
423    setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "missing",
424                                    value = "sparseMatrix"),
425                     function (x, i, j, ..., value)
426                     callGeneric(x=x, i=i, , value = as(value, "sparseVector")))
427    setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "index",
428                                    value = "sparseMatrix"),
429                     function (x, i, j, ..., value)
430                     callGeneric(x=x, i=i, j=j, value = as(value, "sparseVector")))
431    
432    setReplaceMethod("[", signature(x = "diagonalMatrix", i = "missing", j = "index",
433                                    value = "sparseVector"),
434                     replDiag)
435    setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "missing",
436                                    value = "sparseVector"),
437                     replDiag)
438    setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "index",
439                                    value = "sparseVector"),
440                     replDiag)
441    
442    
443  setMethod("t", signature(x = "diagonalMatrix"),  setMethod("t", signature(x = "diagonalMatrix"),
444            function(x) { x@Dimnames <- x@Dimnames[2:1] ; x })            function(x) { x@Dimnames <- x@Dimnames[2:1] ; x })
# Line 477  Line 591 
591  ##           })  ##           })
592    
593  setMethod("crossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),  setMethod("crossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),
594            function(x, y = NULL) crossprod(as(x, "sparseMatrix"), y))            function(x, y = NULL) crossprod(as(x, "TsparseMatrix"), y))
595    
596  setMethod("crossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),  setMethod("crossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),
597            function(x, y = NULL) crossprod(x, as(y, "sparseMatrix")))            function(x, y = NULL) crossprod(x, as(y, "TsparseMatrix")))
598    
599  setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),  setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),
600            function(x, y = NULL) tcrossprod(as(x, "sparseMatrix"), y))            function(x, y = NULL) tcrossprod(as(x, "TsparseMatrix"), y))
601    
602  setMethod("tcrossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),  setMethod("tcrossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),
603            function(x, y = NULL) tcrossprod(x, as(y, "sparseMatrix")))            function(x, y = NULL) tcrossprod(x, as(y, "TsparseMatrix")))
604    
605    
606  ## FIXME?: In theory, this can be done *FASTER*, in some cases, via tapply1()  ## FIXME?: In theory, this can be done *FASTER*, in some cases, via tapply1()
607  setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"),  setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"),
608            function(x, y) as(x, "sparseMatrix") %*% y)            function(x, y) as(x, "TsparseMatrix") %*% y)
609  setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"),  setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"),
610            function(x, y) x %*% as(y, "sparseMatrix"))            function(x, y) x %*% as(y, "TsparseMatrix"))
611  ## NB: The previous is *not* triggering for  "ddi" o "dgC" (= distance 3)  ## NB: The previous is *not* triggering for  "ddi" o "dgC" (= distance 3)
612  ##     since there's a "ddense" o "Csparse" at dist. 2 => triggers first.  ##     since there's a "ddense" o "Csparse" at dist. 2 => triggers first.
613  ## ==> do this:  ## ==> do this:
# Line 619  Line 733 
733  ## ddi*: Arith: result numeric, potentially ddiMatrix  ## ddi*: Arith: result numeric, potentially ddiMatrix
734  setMethod("Arith", signature(e1 = "ddiMatrix", e2 = "numeric"),  setMethod("Arith", signature(e1 = "ddiMatrix", e2 = "numeric"),
735            function(e1,e2) {            function(e1,e2) {
736                n <- e1@Dim[1]; nsq <- n*n                n <- e1@Dim[1]; nsq <- n^2
737                f0 <- callGeneric(0, e2)                f0 <- callGeneric(0, e2)
738                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
739                    L1 <- (le <- length(e2)) == 1L                    L1 <- (le <- length(e2)) == 1L
# Line 637  Line 751 
751    
752  setMethod("Arith", signature(e1 = "numeric", e2 = "ddiMatrix"),  setMethod("Arith", signature(e1 = "numeric", e2 = "ddiMatrix"),
753            function(e1,e2) {            function(e1,e2) {
754                n <- e2@Dim[1]; nsq <- n*n                n <- e2@Dim[1]; nsq <- n^2
755                f0 <- callGeneric(e1, 0)                f0 <- callGeneric(e1, 0)
756                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
757                    L1 <- (le <- length(e1)) == 1L                    L1 <- (le <- length(e1)) == 1L
# Line 656  Line 770 
770  ## ldi* Arith --> result numeric, potentially ddiMatrix  ## ldi* Arith --> result numeric, potentially ddiMatrix
771  setMethod("Arith", signature(e1 = "ldiMatrix", e2 = "numeric"),  setMethod("Arith", signature(e1 = "ldiMatrix", e2 = "numeric"),
772            function(e1,e2) {            function(e1,e2) {
773                n <- e1@Dim[1]; nsq <- n*n                n <- e1@Dim[1]; nsq <- n^2
774                f0 <- callGeneric(0, e2)                f0 <- callGeneric(0, e2)
775                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
776                    L1 <- (le <- length(e2)) == 1L                    L1 <- (le <- length(e2)) == 1L
# Line 675  Line 789 
789    
790  setMethod("Arith", signature(e1 = "numeric", e2 = "ldiMatrix"),  setMethod("Arith", signature(e1 = "numeric", e2 = "ldiMatrix"),
791            function(e1,e2) {            function(e1,e2) {
792                n <- e2@Dim[1]; nsq <- n*n                n <- e2@Dim[1]; nsq <- n^2
793                f0 <- callGeneric(e1, 0)                f0 <- callGeneric(e1, 0)
794                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
795                    L1 <- (le <- length(e1)) == 1L                    L1 <- (le <- length(e1)) == 1L
# Line 695  Line 809 
809  ## ddi*: for "Ops" without Arith --> result logical, potentially ldi  ## ddi*: for "Ops" without Arith --> result logical, potentially ldi
810  setMethod("Ops", signature(e1 = "ddiMatrix", e2 = "numeric"),  setMethod("Ops", signature(e1 = "ddiMatrix", e2 = "numeric"),
811            function(e1,e2) {            function(e1,e2) {
812                n <- e1@Dim[1]; nsq <- n*n                n <- e1@Dim[1]; nsq <- n^2
813                f0 <- callGeneric(0, e2)                f0 <- callGeneric(0, e2)
814                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
815                    L1 <- (le <- length(e2)) == 1L                    L1 <- (le <- length(e2)) == 1L
# Line 714  Line 828 
828    
829  setMethod("Ops", signature(e1 = "numeric", e2 = "ddiMatrix"),  setMethod("Ops", signature(e1 = "numeric", e2 = "ddiMatrix"),
830            function(e1,e2) {            function(e1,e2) {
831                n <- e2@Dim[1]; nsq <- n*n                n <- e2@Dim[1]; nsq <- n^2
832                f0 <- callGeneric(e1, 0)                f0 <- callGeneric(e1, 0)
833                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
834                    L1 <- (le <- length(e1)) == 1L                    L1 <- (le <- length(e1)) == 1L
# Line 734  Line 848 
848  ## ldi*: for "Ops" without Arith --> result logical, potentially ldi  ## ldi*: for "Ops" without Arith --> result logical, potentially ldi
849  setMethod("Ops", signature(e1 = "ldiMatrix", e2 = "numeric"),  setMethod("Ops", signature(e1 = "ldiMatrix", e2 = "numeric"),
850            function(e1,e2) {            function(e1,e2) {
851                n <- e1@Dim[1]; nsq <- n*n                n <- e1@Dim[1]; nsq <- n^2
852                f0 <- callGeneric(FALSE, e2)                f0 <- callGeneric(FALSE, e2)
853                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
854                    L1 <- (le <- length(e2)) == 1L                    L1 <- (le <- length(e2)) == 1L
# Line 752  Line 866 
866    
867  setMethod("Ops", signature(e1 = "numeric", e2 = "ldiMatrix"),  setMethod("Ops", signature(e1 = "numeric", e2 = "ldiMatrix"),
868            function(e1,e2) {            function(e1,e2) {
869                n <- e2@Dim[1]; nsq <- n*n                n <- e2@Dim[1]; nsq <- n^2
870                f0 <- callGeneric(e1, FALSE)                f0 <- callGeneric(e1, FALSE)
871                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
872                    L1 <- (le <- length(e1)) == 1L                    L1 <- (le <- length(e1)) == 1L
# Line 847  Line 961 
961      invisible(x)      invisible(x)
962  }  }
963    
964    ## somewhat consistent with "print" for sparseMatrix :
965    setMethod("print", signature(x = "diagonalMatrix"), prDiag)
966    
967  setMethod("show", signature(object = "diagonalMatrix"),  setMethod("show", signature(object = "diagonalMatrix"),
968            function(object) {            function(object) {
969                d <- dim(object)                d <- dim(object)
970                cl <- class(object)                cl <- class(object)
971                cat(sprintf('%d x %d diagonal matrix of class "%s"\n',                cat(sprintf('%d x %d diagonal matrix of class "%s"',
972                            d[1], d[2], cl))                            d[1], d[2], cl))
973                  if(d[1] < 50) {
974                      cat("\n")
975                prDiag(object)                prDiag(object)
976                  } else {
977                      cat(", with diagonal entries\n")
978                      show(diag(object))
979                      invisible(object)
980                  }
981            })            })

Legend:
Removed from v.2197  
changed lines
  Added in v.2239

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge