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 2912, Sat Sep 14 17:09:49 2013 UTC revision 2945, Thu Dec 19 13:52:00 2013 UTC
# Line 251  Line 251 
251  ## "hack"  instead of signature  x = "diagonalMatrix" :  ## "hack"  instead of signature  x = "diagonalMatrix" :
252  ##  ##
253  ## ddi*:  ## ddi*:
254  diag2tT <- function(from) .diag2tT(from, "U", "d")  di2tT <- function(from) .diag2tT(from, "U", "d")
255  setAs("ddiMatrix", "triangularMatrix", diag2tT)  setAs("ddiMatrix", "triangularMatrix", di2tT)
256  ##_no_longer_ setAs("ddiMatrix", "sparseMatrix", diag2tT)  ##_no_longer_ setAs("ddiMatrix", "sparseMatrix", di2tT)
257  ## needed too (otherwise <dense> -> Tsparse is taken):  ## needed too (otherwise <dense> -> Tsparse is taken):
258  setAs("ddiMatrix", "TsparseMatrix", diag2tT)  setAs("ddiMatrix", "TsparseMatrix", di2tT)
259  setAs("ddiMatrix", "dsparseMatrix", diag2tT)  setAs("ddiMatrix", "dsparseMatrix", di2tT)
260  setAs("ddiMatrix", "CsparseMatrix",  setAs("ddiMatrix", "CsparseMatrix",
261        function(from) as(.diag2tT(from, "U", "d"), "CsparseMatrix"))        function(from) as(.diag2tT(from, "U", "d"), "CsparseMatrix"))
262  setAs("ddiMatrix", "symmetricMatrix",  setAs("ddiMatrix", "symmetricMatrix",
263        function(from) .diag2sT(from, "U", "d"))        function(from) .diag2sT(from, "U", "d"))
264  ##  ##
265  ## ldi*:  ## ldi*:
266  diag2tT <- function(from) .diag2tT(from, "U", "l")  di2tT <- function(from) .diag2tT(from, "U", "l")
267  setAs("ldiMatrix", "triangularMatrix", diag2tT)  setAs("ldiMatrix", "triangularMatrix", di2tT)
268  ##_no_longer_ setAs("ldiMatrix", "sparseMatrix", diag2tT)  ##_no_longer_ setAs("ldiMatrix", "sparseMatrix", di2tT)
269  ## needed too (otherwise <dense> -> Tsparse is taken):  ## needed too (otherwise <dense> -> Tsparse is taken):
270  setAs("ldiMatrix", "TsparseMatrix", diag2tT)  setAs("ldiMatrix", "TsparseMatrix", di2tT)
271  setAs("ldiMatrix", "lsparseMatrix", diag2tT)  setAs("ldiMatrix", "lsparseMatrix", di2tT)
272  setAs("ldiMatrix", "CsparseMatrix",  setAs("ldiMatrix", "CsparseMatrix",
273        function(from) as(.diag2tT(from, "U", "l"), "CsparseMatrix"))        function(from) as(.diag2tT(from, "U", "l"), "CsparseMatrix"))
274  setAs("ldiMatrix", "symmetricMatrix",  setAs("ldiMatrix", "symmetricMatrix",
275        function(from) .diag2sT(from, "U", "l"))        function(from) .diag2sT(from, "U", "l"))
276    rm(di2tT)
277    
278  setAs("diagonalMatrix", "nMatrix",  setAs("diagonalMatrix", "nMatrix",
279        function(from) {        function(from) {
# Line 918  Line 918 
918            function(e1,e2) {            function(e1,e2) {
919                n <- e1@Dim[1]                n <- e1@Dim[1]
920                f0 <- callGeneric(0, e2)                f0 <- callGeneric(0, e2)
921                if(all(is0(f0))) { # remain diagonal                if(all0(f0)) { # remain diagonal
922                    L1 <- (le <- length(e2)) == 1L                    L1 <- (le <- length(e2)) == 1L
923                    if(e1@diag == "U") {                    if(e1@diag == "U") {
924                        if(any((r <- callGeneric(1, e2)) != 1)) {                        if(any((r <- callGeneric(1, e2)) != 1)) {
# Line 940  Line 940 
940            function(e1,e2) {            function(e1,e2) {
941                n <- e2@Dim[1]                n <- e2@Dim[1]
942                f0 <- callGeneric(e1, 0)                f0 <- callGeneric(e1, 0)
943                if(all(is0(f0))) { # remain diagonal                if(all0(f0)) { # remain diagonal
944                    L1 <- (le <- length(e1)) == 1L                    L1 <- (le <- length(e1)) == 1L
945                    if(e2@diag == "U") {                    if(e2@diag == "U") {
946                        if(any((r <- callGeneric(e1, 1)) != 1)) {                        if(any((r <- callGeneric(e1, 1)) != 1)) {
# Line 963  Line 963 
963            function(e1,e2) {            function(e1,e2) {
964                n <- e1@Dim[1]                n <- e1@Dim[1]
965                f0 <- callGeneric(0, e2)                f0 <- callGeneric(0, e2)
966                if(all(is0(f0))) { # remain diagonal                if(all0(f0)) { # remain diagonal
967                    L1 <- (le <- length(e2)) == 1L                    L1 <- (le <- length(e2)) == 1L
968                    E <- copyClass(e1, "ddiMatrix", c("diag", "Dim", "Dimnames"))#FIXME: if ok, check=FALSE                    E <- copyClass(e1, "ddiMatrix", c("diag", "Dim", "Dimnames"))#FIXME: if ok, check=FALSE
969                    ## E <- copyClass(e1, "ddiMatrix", check=FALSE)                    ## E <- copyClass(e1, "ddiMatrix", check=FALSE)
# Line 988  Line 988 
988            function(e1,e2) {            function(e1,e2) {
989                n <- e2@Dim[1]                n <- e2@Dim[1]
990                f0 <- callGeneric(e1, 0)                f0 <- callGeneric(e1, 0)
991                if(all(is0(f0))) { # remain diagonal                if(all0(f0)) { # remain diagonal
992                    L1 <- (le <- length(e1)) == 1L                    L1 <- (le <- length(e1)) == 1L
993                    E <- copyClass(e2, "ddiMatrix", c("diag", "Dim", "Dimnames"))#FIXME: if ok, check=FALSE                    E <- copyClass(e2, "ddiMatrix", c("diag", "Dim", "Dimnames"))#FIXME: if ok, check=FALSE
994                    ## E <- copyClass(e2, "ddiMatrix", check=FALSE)                    ## E <- copyClass(e2, "ddiMatrix", check=FALSE)
# Line 1021  Line 1021 
1021            function(e1,e2) {            function(e1,e2) {
1022                n <- e1@Dim[1]                n <- e1@Dim[1]
1023                f0 <- callGeneric(0, e2)                f0 <- callGeneric(0, e2)
1024                if(all(is0(f0))) { # remain diagonal                if(all0(f0)) { # remain diagonal
1025                    L1 <- (le <- length(e2)) == 1L                    L1 <- (le <- length(e2)) == 1L
1026                    E <- copyClass(e1, "ldiMatrix", c("diag", "Dim", "Dimnames"))#FIXME: if ok, check=FALSE                    E <- copyClass(e1, "ldiMatrix", c("diag", "Dim", "Dimnames"))#FIXME: if ok, check=FALSE
1027                    ## E <- copyClass(e1, "ldiMatrix", check=FALSE)                    ## E <- copyClass(e1, "ldiMatrix", check=FALSE)
# Line 1047  Line 1047 
1047            function(e1,e2) {            function(e1,e2) {
1048                n <- e1@Dim[1]                n <- e1@Dim[1]
1049                f0 <- callGeneric(FALSE, e2)                f0 <- callGeneric(FALSE, e2)
1050                if(all(is0(f0))) { # remain diagonal                if(all0(f0)) { # remain diagonal
1051                    L1 <- (le <- length(e2)) == 1L                    L1 <- (le <- length(e2)) == 1L
1052    
1053                    if(e1@diag == "U") {                    if(e1@diag == "U") {

Legend:
Removed from v.2912  
changed lines
  Added in v.2945

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