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 2202, Mon Jun 9 21:36:21 2008 UTC revision 2203, Sat Jun 14 20:09:17 2008 UTC
# Line 619  Line 619 
619  ## ddi*: Arith: result numeric, potentially ddiMatrix  ## ddi*: Arith: result numeric, potentially ddiMatrix
620  setMethod("Arith", signature(e1 = "ddiMatrix", e2 = "numeric"),  setMethod("Arith", signature(e1 = "ddiMatrix", e2 = "numeric"),
621            function(e1,e2) {            function(e1,e2) {
622                n <- e1@Dim[1]; nsq <- n*n                n <- e1@Dim[1]; nsq <- n^2
623                f0 <- callGeneric(0, e2)                f0 <- callGeneric(0, e2)
624                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
625                    L1 <- (le <- length(e2)) == 1L                    L1 <- (le <- length(e2)) == 1L
# Line 637  Line 637 
637    
638  setMethod("Arith", signature(e1 = "numeric", e2 = "ddiMatrix"),  setMethod("Arith", signature(e1 = "numeric", e2 = "ddiMatrix"),
639            function(e1,e2) {            function(e1,e2) {
640                n <- e2@Dim[1]; nsq <- n*n                n <- e2@Dim[1]; nsq <- n^2
641                f0 <- callGeneric(e1, 0)                f0 <- callGeneric(e1, 0)
642                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
643                    L1 <- (le <- length(e1)) == 1L                    L1 <- (le <- length(e1)) == 1L
# Line 656  Line 656 
656  ## ldi* Arith --> result numeric, potentially ddiMatrix  ## ldi* Arith --> result numeric, potentially ddiMatrix
657  setMethod("Arith", signature(e1 = "ldiMatrix", e2 = "numeric"),  setMethod("Arith", signature(e1 = "ldiMatrix", e2 = "numeric"),
658            function(e1,e2) {            function(e1,e2) {
659                n <- e1@Dim[1]; nsq <- n*n                n <- e1@Dim[1]; nsq <- n^2
660                f0 <- callGeneric(0, e2)                f0 <- callGeneric(0, e2)
661                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
662                    L1 <- (le <- length(e2)) == 1L                    L1 <- (le <- length(e2)) == 1L
# Line 675  Line 675 
675    
676  setMethod("Arith", signature(e1 = "numeric", e2 = "ldiMatrix"),  setMethod("Arith", signature(e1 = "numeric", e2 = "ldiMatrix"),
677            function(e1,e2) {            function(e1,e2) {
678                n <- e2@Dim[1]; nsq <- n*n                n <- e2@Dim[1]; nsq <- n^2
679                f0 <- callGeneric(e1, 0)                f0 <- callGeneric(e1, 0)
680                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
681                    L1 <- (le <- length(e1)) == 1L                    L1 <- (le <- length(e1)) == 1L
# Line 695  Line 695 
695  ## ddi*: for "Ops" without Arith --> result logical, potentially ldi  ## ddi*: for "Ops" without Arith --> result logical, potentially ldi
696  setMethod("Ops", signature(e1 = "ddiMatrix", e2 = "numeric"),  setMethod("Ops", signature(e1 = "ddiMatrix", e2 = "numeric"),
697            function(e1,e2) {            function(e1,e2) {
698                n <- e1@Dim[1]; nsq <- n*n                n <- e1@Dim[1]; nsq <- n^2
699                f0 <- callGeneric(0, e2)                f0 <- callGeneric(0, e2)
700                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
701                    L1 <- (le <- length(e2)) == 1L                    L1 <- (le <- length(e2)) == 1L
# Line 714  Line 714 
714    
715  setMethod("Ops", signature(e1 = "numeric", e2 = "ddiMatrix"),  setMethod("Ops", signature(e1 = "numeric", e2 = "ddiMatrix"),
716            function(e1,e2) {            function(e1,e2) {
717                n <- e2@Dim[1]; nsq <- n*n                n <- e2@Dim[1]; nsq <- n^2
718                f0 <- callGeneric(e1, 0)                f0 <- callGeneric(e1, 0)
719                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
720                    L1 <- (le <- length(e1)) == 1L                    L1 <- (le <- length(e1)) == 1L
# Line 734  Line 734 
734  ## ldi*: for "Ops" without Arith --> result logical, potentially ldi  ## ldi*: for "Ops" without Arith --> result logical, potentially ldi
735  setMethod("Ops", signature(e1 = "ldiMatrix", e2 = "numeric"),  setMethod("Ops", signature(e1 = "ldiMatrix", e2 = "numeric"),
736            function(e1,e2) {            function(e1,e2) {
737                n <- e1@Dim[1]; nsq <- n*n                n <- e1@Dim[1]; nsq <- n^2
738                f0 <- callGeneric(FALSE, e2)                f0 <- callGeneric(FALSE, e2)
739                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
740                    L1 <- (le <- length(e2)) == 1L                    L1 <- (le <- length(e2)) == 1L
# Line 752  Line 752 
752    
753  setMethod("Ops", signature(e1 = "numeric", e2 = "ldiMatrix"),  setMethod("Ops", signature(e1 = "numeric", e2 = "ldiMatrix"),
754            function(e1,e2) {            function(e1,e2) {
755                n <- e2@Dim[1]; nsq <- n*n                n <- e2@Dim[1]; nsq <- n^2
756                f0 <- callGeneric(e1, FALSE)                f0 <- callGeneric(e1, FALSE)
757                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
758                    L1 <- (le <- length(e1)) == 1L                    L1 <- (le <- length(e1)) == 1L
# Line 851  Line 851 
851            function(object) {            function(object) {
852                d <- dim(object)                d <- dim(object)
853                cl <- class(object)                cl <- class(object)
854                cat(sprintf('%d x %d diagonal matrix of class "%s"\n',                cat(sprintf('%d x %d diagonal matrix of class "%s"',
855                            d[1], d[2], cl))                            d[1], d[2], cl))
856                  if(d[1] < 50) {
857                      cat("\n")
858                prDiag(object)                prDiag(object)
859                  } else {
860                      cat(", with diagonal entries\n")
861                      show(diag(object))
862                      invisible(object)
863                  }
864            })            })

Legend:
Removed from v.2202  
changed lines
  Added in v.2203

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