SCM

SCM Repository

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

Diff of /pkg/R/diagMatrix.R

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

revision 2156, Tue Mar 25 09:26:59 2008 UTC revision 2157, Tue Mar 25 15:00:01 2008 UTC
# Line 575  Line 575 
575                n <- e1@Dim[1]; nsq <- n*n                n <- e1@Dim[1]; nsq <- n*n
576                f0 <- callGeneric(0, e2)                f0 <- callGeneric(0, e2)
577                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
578                    if(e1@diag == "U" && (r <- callGeneric(1, e2)) != 1)                    L1 <- (le <- length(e2)) == 1L
579                      if(!L1 && le != nsq) e2 <- rep(e2, length.out = nsq)
580                      if(e1@diag == "U" && any((r <- callGeneric(1, e2)) != 1)) {
581                        e1@diag <- "N"                        e1@diag <- "N"
582                    else                        if(L1) r <- rep.int(r, n)
583                      } else
584                        r <- callGeneric(e1@x, e2)                        r <- callGeneric(e1@x, e2)
585                    e1@x <- if(length(e2) == nsq) r else rep(r, length.out = nsq)                    e1@x <- if(L1) r else r[1L + n*(0:(n-1L))]
586                    return(e1)                    return(e1)
587                }                }
588                callGeneric(diag2tT.u(e1,e2, "d"), e2)                callGeneric(diag2tT.u(e1,e2, "d"), e2)
# Line 590  Line 593 
593                n <- e2@Dim[1]; nsq <- n*n                n <- e2@Dim[1]; nsq <- n*n
594                f0 <- callGeneric(e1, 0)                f0 <- callGeneric(e1, 0)
595                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
596                    if(e2@diag == "U" && (r <- callGeneric(e1, 1)) != 1)                    L1 <- (le <- length(e1)) == 1L
597                      if(!L1 && le != nsq) e1 <- rep(e1, length.out = nsq)
598                      if(e2@diag == "U" && any((r <- callGeneric(e1, 1)) != 1)) {
599                        e2@diag <- "N"                        e2@diag <- "N"
600                    else                        if(L1) r <- rep.int(r, n)
601                      } else
602                        r <- callGeneric(e1, e2@x)                        r <- callGeneric(e1, e2@x)
603                    e2@x <- if(length(e1) == nsq) r else rep(r, length.out = nsq)                    e2@x <- if(L1) r else r[1L + n*(0:(n-1L))]
604                    return(e2)                    return(e2)
605                }                }
606                callGeneric(e1, diag2tT.u(e2,e1, "d"))                callGeneric(e1, diag2tT.u(e2,e1, "d"))
# Line 605  Line 611 
611                n <- e1@Dim[1]; nsq <- n*n                n <- e1@Dim[1]; nsq <- n*n
612                f0 <- callGeneric(FALSE, e2)                f0 <- callGeneric(FALSE, e2)
613                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
614                    if(e1@diag == "U" && (r <- callGeneric(TRUE, e2)) != 1)                    L1 <- (le <- length(e2)) == 1L
615                      if(!L1 && le != nsq) e2 <- rep(e2, length.out = nsq)
616                      if(e1@diag == "U" && any((r <- callGeneric(TRUE, e2)) != 1)) {
617                        e1@diag <- "N"                        e1@diag <- "N"
618                    else                        if(L1) r <- rep.int(r, n)
619                      } else
620                        r <- callGeneric(e1@x, e2)                        r <- callGeneric(e1@x, e2)
621                    e1@x <- if(length(e2) == nsq) r else rep(r, length.out = nsq)                    e1@x <- if(L1) r else r[1L + n*(0:(n-1L))]
622                    return(e1)                    return(e1)
623                }                }
624                callGeneric(diag2tT.u(e1,e2, "l"), e2)                callGeneric(diag2tT.u(e1,e2, "l"), e2)
# Line 620  Line 629 
629                n <- e2@Dim[1]; nsq <- n*n                n <- e2@Dim[1]; nsq <- n*n
630                f0 <- callGeneric(e1, FALSE)                f0 <- callGeneric(e1, FALSE)
631                if(all(is0(f0))) { # remain diagonal                if(all(is0(f0))) { # remain diagonal
632                    if(e2@diag == "U" && (r <- callGeneric(e1, TRUE)) != 1)                    L1 <- (le <- length(e1)) == 1L
633                      if(!L1 && le != nsq) e1 <- rep(e1, length.out = nsq)
634                      if(e2@diag == "U" && any((r <- callGeneric(e1, TRUE)) != 1)) {
635                        e2@diag <- "N"                        e2@diag <- "N"
636                    else                        if(L1) r <- rep.int(r, n)
637                      } else
638                        r <- callGeneric(e1, e2@x)                        r <- callGeneric(e1, e2@x)
639                    e2@x <- if(length(e1) == nsq) r else rep(r, length.out = nsq)                    e2@x <- if(L1) r else r[1L + n*(0:(n-1L))]
640                    return(e2)                    return(e2)
641                }                }
642                callGeneric(e1, diag2tT.u(e2,e1, "l"))                callGeneric(e1, diag2tT.u(e2,e1, "l"))

Legend:
Removed from v.2156  
changed lines
  Added in v.2157

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