R : Copyright 2005, The R Foundation for Statistical Computing
Version 2.1.1  (2005-06-20), ISBN 3-900051-07-0

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for a HTML browser interface to help.
Type 'q()' to quit R.

> ### * <HEADER>
> ###
> attach(NULL, name = "CheckExEnv")
> assign(".CheckExEnv", as.environment(2), pos = length(search())) # base
> ## add some hooks to label plot pages for base and grid graphics
> setHook("plot.new", ".newplot.hook")
> setHook("persp", ".newplot.hook")
> setHook("grid.newpage", ".gridplot.hook")
> 
> assign("cleanEx",
+        function(env = .GlobalEnv) {
+ 	   rm(list = ls(envir = env, all.names = TRUE), envir = env)
+            RNGkind("default", "default")
+ 	   set.seed(1)
+    	   options(warn = 1)
+ 	   delayedAssign("T", stop("T used instead of TRUE"),
+ 		  assign.env = .CheckExEnv)
+ 	   delayedAssign("F", stop("F used instead of FALSE"),
+ 		  assign.env = .CheckExEnv)
+ 	   sch <- search()
+ 	   newitems <- sch[! sch %in% .oldSearch]
+ 	   for(item in rev(newitems))
+                eval(substitute(detach(item), list(item=item)))
+ 	   missitems <- .oldSearch[! .oldSearch %in% sch]
+ 	   if(length(missitems))
+ 	       warning("items ", paste(missitems, collapse=", "),
+ 		       " have been removed from the search path")
+        },
+        env = .CheckExEnv)
> assign("..nameEx", "__{must remake R-ex/*.R}__", env = .CheckExEnv) # for now
> assign("ptime", proc.time(), env = .CheckExEnv)
> grDevices::postscript("PTAk-Examples.ps")
> assign("par.postscript", graphics::par(no.readonly = TRUE), env = .CheckExEnv)
> options(contrasts = c(unordered = "contr.treatment", ordered = "contr.poly"))
> options(warn = 1)    
> library('PTAk')
Loading required package: tensor
> 
> assign(".oldSearch", search(), env = .CheckExEnv)
> assign(".oldNS", loadedNamespaces(), env = .CheckExEnv)
> cleanEx(); ..nameEx <- "CONTRACTION"
> 
> ### * CONTRACTION
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: CONTRACTION
> ### Title: Contraction of two tensors
> ### Aliases: CONTRACTION CONTRACTION.list
> ### Keywords: array algebra
> 
> ### ** Examples
> 
>  library(tensor)
>    z <-  array(1:12,c(2,3,2))
>    X <- array(1:48,c(3,4,2,2))
>    Xcz <- CONTRACTION(X,z,Xwiz=c(1,3,4),zwiX=c(2,3,1))
>    dim(Xcz)   # 4
[1] 4
>    Xcz1 <- CONTRACTION(X,z,Xwiz=c(3,4),zwiX=c(1,3))
>    dim(Xcz1) # 3,4,3
[1] 3 4 3
>    Xcz2 <- CONTRACTION(X,z,Xwiz=c(3,4),zwiX=c(3,1))
>    Xcz1[,,1]
     [,1] [,2] [,3] [,4]
[1,]  498  552  606  660
[2,]  516  570  624  678
[3,]  534  588  642  696
>    Xcz2[,,1]
     [,1] [,2] [,3] [,4]
[1,]  438  492  546  600
[2,]  456  510  564  618
[3,]  474  528  582  636
>    #######
>    sval0 <- list(list(v=c(1,2,3,4)),list(v=rep(1,3)),list(v=c(1,3)))
>    tew <- array(1:24,c(4,3,2))
>     CONTRACTION.list(tew,sval0,moins=1)
[1] 168 180 192 204
>        #this is equivalent to the following which may be too expensive for big datasets
>     CONTRACTION(tew,TENSELE(sval0,moins=1),Xwiz=c(2,3))
[1] 168 180 192 204
>    ##
>      CONTRACTION.list(tew,sval0,moins=c(1,2)) #must be equal to
     [,1] [,2] [,3]
[1,]   40   56   72
[2,]   44   60   76
[3,]   48   64   80
[4,]   52   68   84
>      CONTRACTION(tew,sval0[[3]]$v,Xwiz=3)
     [,1] [,2] [,3]
[1,]   40   56   72
[2,]   44   60   76
[3,]   48   64   80
[4,]   52   68   84
>    
> 
> 
> cleanEx(); ..nameEx <- "CauRuimet"
> 
> ### * CauRuimet
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: CauRuimet
> ### Title: Robust estimation of within group covariance
> ### Aliases: CauRuimet
> ### Keywords: robust multivariate
> 
> ### ** Examples
> 
> 
>  data(iris)
>   iris2 <- as.matrix(iris[,1:4])
>   dimnames(iris2)[[1]] <- as.character(iris[,5])
> 
>  D2 <- CauRuimet(iris2,ker=1,withingroup=TRUE)
-----Execution Time----- 0.05 
>  D2 <- Powmat(D2,(-1))
>  iris2 <- sweep(iris2,2,apply(iris2,2,mean))
>  res <- SVDgen(iris2,D2=D2,D1=1)
>  plot(res,nb1=1,nb2=2,cex=0.5)
>  summary(res,testvar=0)

 ++++ PTA-  2 modes ++++  
               data=  iris2   150 4 
    
                ------Percent Rebuilt---- 100 % 
                ------Percent Rebuilt from Selected ---- 100 % 
    -no- --Sing Val-- --ssX-- --local Pct-- --Global Pct--
vs1    1       26.686  1901.7        37.447         37.447
vs2    2       20.869  1901.7        22.902         22.902
vs3    3       19.647  1901.7        20.297         20.297
vs4    4       19.185  1901.7        19.354         19.354

 ++++               ++++ 
 over  4  PT  
> 
>  # the same in a demo function
> 
>  # demo.CauRuimet(ker=4,withingroup=TRUE,openX11s=FALSE)
>  # demo.Cauruimet(ker=0.15,withingroup=FALSE,openX11s=FALSE)
> 
> 
> 
> cleanEx(); ..nameEx <- "FCAk"
> 
> ### * FCAk
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: FCAk
> ### Title: Generalisation of Correspondence Analysis for k-way tables
> ### Aliases: FCAk
> ### Keywords: models array algebra multivariate
> 
> ### ** Examples
> 
>  # try the demo
>    # demo.FCAk()
> 
> 
> 
> cleanEx(); ..nameEx <- "PROJOT"
> 
> ### * PROJOT
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: PROJOT
> ### Title: Orthogonal Tensor projection
> ### Aliases: PROJOT
> ### Keywords: array algebra multivariate
> 
> ### ** Examples
> 
> 
> don <- array(1:360,c(5,4,6,3))
>  don <- don + rnorm(360,10,2)
> 
>  ones <- list(list(v=rep(1,5)),list(v=rep(1,4)),list(v=rep(1,6)),list(v=rep(1,3)))
>  donfc <- PROJOT(don,ones)
> 
>  apply(donfc,c(2,3,4),mean)
, , 1

              [,1]          [,2]          [,3]          [,4]          [,5]
[1,]  1.265654e-15 -7.682743e-15 -7.638334e-15 -3.197442e-15  5.817569e-15
[2,]  4.529710e-15  8.704149e-15 -5.462297e-15  1.412204e-14 -7.149836e-15
[3,]  8.126833e-15 -8.393286e-15  6.661338e-15 -3.008704e-15 -7.271961e-15
[4,] -1.383338e-14  7.371881e-15  6.367129e-15 -7.960299e-15  8.615331e-15
              [,6]
[1,]  1.154632e-14
[2,] -1.481038e-14
[3,]  4.152234e-15
[4,] -8.659740e-16

, , 2

              [,1]          [,2]          [,3]          [,4]          [,5]
[1,]  6.761258e-15  1.401101e-14 -9.370282e-15 -2.442491e-15  1.598721e-15
[2,]  7.993606e-16 -9.814372e-15 -6.439294e-16  2.156053e-14  9.547918e-16
[3,] -1.336709e-14 -7.771561e-15  1.234568e-14 -4.796163e-15  3.064216e-15
[4,]  5.728751e-15  3.641532e-15 -2.287059e-15 -1.423306e-14 -5.462297e-15
              [,6]
[1,] -1.056932e-14
[2,] -1.301181e-14
[3,]  1.085798e-14
[4,]  1.274536e-14

, , 3

              [,1]          [,2]          [,3]          [,4]          [,5]
[1,] -7.993606e-15 -6.372680e-15  1.711964e-14  5.684342e-15 -7.371881e-15
[2,] -5.329071e-15  1.110223e-15  6.106227e-15 -3.566036e-14  6.217249e-15
[3,]  5.018208e-15  1.634248e-14 -1.896261e-14  7.949197e-15  4.352074e-15
[4,]  8.038015e-15 -1.110223e-14 -4.196643e-15  2.222666e-14 -3.141931e-15
              [,6]
[1,] -1.065814e-15
[2,]  2.779998e-14
[3,] -1.478817e-14
[4,] -1.192380e-14

> apply(donfc,c(1),mean)
[1]  1.541976e-17  9.251859e-18 -1.541976e-17 -1.541976e-17  1.850372e-17
> 
>   # implementation de PTAIVk with obvious settings
>  PTAIVk <- function(X,STruct,...)
+          {X <- PROJOT(X$data,STruct,numo=Struct[[1]]$numo,Ortho=Struct[[1]]$Ortho,metrics=X$met)
+          PTAk(X,...)
+          }
> 
>    
> 
> 
> cleanEx(); ..nameEx <- "PTA3"
> 
> ### * PTA3
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: PTA3
> ### Title: Principal Tensor Analysis on 3 modes
> ### Aliases: PTA3
> ### Keywords: array algebra multivariate
> 
> ### ** Examples
> 
>  cat(" A little fun using iris3 and matching randomly 15 for each iris sample!","\n")
 A little fun using iris3 and matching randomly 15 for each iris sample! 
>  cat("   then performing a PTA-3modes.  If many draws are done, plots")
   then performing a PTA-3modes.  If many draws are done, plots>  cat("   show the stability of the first and third Principal Tensors.","\n")
   show the stability of the first and third Principal Tensors. 
>  cat("iris3 is centered and reduced beforehand for each original variables.","\n")
iris3 is centered and reduced beforehand for each original variables. 
> #  demo function
>  # source(paste(R.home(),"/library/PTAk/demo/PTA3.R",sep=""))
>  # demo.PTA3(bootn=10,show=5,openX11s=FALSE)
> 
> 
> 
> cleanEx(); ..nameEx <- "PTAk"
> 
> ### * PTAk
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: PTAk
> ### Title: Principal Tensor Analysis on k modes
> ### Aliases: PTAk
> ### Keywords: array algebra multivariate
> 
> ### ** Examples
> 
> 
>   # don <- array((1:3)
> 
> don <- array(1:360,c(5,4,6,3))
>  don <- don + rnorm(360,1,2)
> 
>  dimnames(don) <- list(paste("s",1:5,sep=""),paste("T",1:4,sep=""),
+           paste("t",1:6,sep=""),c("young","normal","old"))
>    # hypothetic data on learning curve at different age and period of year
> 
>  ones <-list(list(v=rep(1,5)),list(v=rep(1,4)),list(v=rep(1,6)),list(v=rep(1,3)))
> 
>  don <- PROJOT(don,ones)
>  don.sol <- PTAk(don,nbPT=1,nbPT2=2,minpct=0.01,
+                verbose=TRUE,
+                 modesnam=c("Subjects","Trimester","Time","Age"),
+                  addedcomment="centered on each mode")
----------+++++++++++------------ 
   Principal Tensor Analysis on k modes  
 Data is ...  don ... 
  .... Tensor of order  4  ....  with dimensions:  5 4 6 3 
modes are  Subjects Trimester Time Age 

 centered on each mode 

 
                 ++++++  k-modes Solutions  ---- k= 4 , vs1111 ++++++ 
 

        ----------+++++++++++------------ RPVSCC algorithm  
                             ------------ Singular Value   vs1111 
                                       ----  dimensions:   5 4 6 3 
 ---------------------- 
 Initialisation  done 
 ----------- iteration- 1 
  1 ^ 11.53470  2 ^ 12.71169  3 ^ 11.36889  4 ^ 15.099
 ----------- test =          1.168128 
 --------Final iteration---- 87 
 ----------- test =          7.846839e-13 

  --Singular Value--  8.469171  -- Local Percent --  17.52572 % 
                 -- GLobal Percent --  17.52572 % 

 
             ++++++++++++++++ --APSOLUk-- vs1111  Associated solution to entry --- 1  ....  of dimension:  5 

        ----------+++++++++++------------ 
                PTA 3modes  
       ----------+++++++++++------------ 
 Data is ...  Z ...  .... Tensor of order  3  ....  with dimensions:  4 6 3 
modes are  Trimester Time Age 
----- Principal Tensor ----  vs111
        ----------+++++++++++------------ RPVSCC algorithm  
                             ------------ Singular Value   vs111 
                                       ----  dimensions:   4 6 3 
 ---------------------- 
 Initialisation  done 
 ----------- iteration- 1 
  1 ^ 9.004518  2 ^ 8.574282  3 ^ 9.070399
 ----------- test =          2.000423 
 --------Final iteration---- 18 
 ----------- test =          9.724553e-13 

  --Singular Value--  8.469171  -- Local Percent --  62.31636 % 
 --- GLobal Percent ---  62.31636 % 
 ----------APSOLU3------------ ---- Associated solution to entry --- 1  ....  of dimension:  4 
                ------Percent Rebuilt from Selected ---- 70.26113 % 
 ----------APSOLU3------------ ---- Associated solution to entry --- 2  ....  of dimension:  6 
                ------Percent Rebuilt from Selected ---- 71.67346 % 
 ----------APSOLU3------------ ---- Associated solution to entry --- 3  ....  of dimension:  3 
                ------Percent Rebuilt from Selected ---- 79.03788 % 

 +++ PTA 3modes  ------After --- vs111                ------Percent Rebuilt from Selected ---- 79.03788 % 

 -----Execution Time----- 0.52 
                ------Percent Rebuilt from Selected ---- 22.22844 % 

 
             ++++++++++++++++ --APSOLUk-- vs1111  Associated solution to entry --- 2  ....  of dimension:  4 

        ----------+++++++++++------------ 
                PTA 3modes  
       ----------+++++++++++------------ 
 Data is ...  Z ...  .... Tensor of order  3  ....  with dimensions:  5 6 3 
modes are  Subjects Time Age 
----- Principal Tensor ----  vs111
        ----------+++++++++++------------ RPVSCC algorithm  
                             ------------ Singular Value   vs111 
                                       ----  dimensions:   5 6 3 
 ---------------------- 
 Initialisation  done 
 ----------- iteration- 1 
  1 ^ 9.084513  2 ^ 9.277953  3 ^ 10.41502
 ----------- test =          0.2483048 
 --------Final iteration---- 53 
 ----------- test =          8.371725e-13 

  --Singular Value--  8.469171  -- Local Percent --  47.26581 % 
 --- GLobal Percent ---  47.26581 % 
 ----------APSOLU3------------ ---- Associated solution to entry --- 1  ....  of dimension:  5 
                ------Percent Rebuilt from Selected ---- 53.29178 % 
 ----------APSOLU3------------ ---- Associated solution to entry --- 2  ....  of dimension:  6 
                ------Percent Rebuilt from Selected ---- 62.57237 % 
 ----------APSOLU3------------ ---- Associated solution to entry --- 3  ....  of dimension:  3 
                ------Percent Rebuilt from Selected ---- 78.27973 % 

 +++ PTA 3modes  ------After --- vs111                ------Percent Rebuilt from Selected ---- 78.27973 % 

 -----Execution Time----- 1.35 
                ------Percent Rebuilt from Selected ---- 31.49374 % 

 
             ++++++++++++++++ --APSOLUk-- vs1111  Associated solution to entry --- 3  ....  of dimension:  6 

        ----------+++++++++++------------ 
                PTA 3modes  
       ----------+++++++++++------------ 
 Data is ...  Z ...  .... Tensor of order  3  ....  with dimensions:  5 4 3 
modes are  Subjects Trimester Age 
----- Principal Tensor ----  vs111
        ----------+++++++++++------------ RPVSCC algorithm  
                             ------------ Singular Value   vs111 
                                       ----  dimensions:   5 4 3 
 ---------------------- 
 Initialisation  done 
 ----------- iteration- 1 
  1 ^ 8.5748  2 ^ 9.308558  3 ^ 9.033098
 ----------- test =          2.000862 
 --------Final iteration---- 19 
 ----------- test =          5.555091e-13 

  --Singular Value--  8.469171  -- Local Percent --  69.03402 % 
 --- GLobal Percent ---  69.03402 % 
 ----------APSOLU3------------ ---- Associated solution to entry --- 1  ....  of dimension:  5 
                ------Percent Rebuilt from Selected ---- 70.5986 % 
 ----------APSOLU3------------ ---- Associated solution to entry --- 2  ....  of dimension:  4 
                ------Percent Rebuilt from Selected ---- 84.15335 % 
 ----------APSOLU3------------ ---- Associated solution to entry --- 3  ....  of dimension:  3 
                ------Percent Rebuilt from Selected ---- 91.22547 % 

 +++ PTA 3modes  ------After --- vs111                ------Percent Rebuilt from Selected ---- 91.22547 % 

 -----Execution Time----- 0.51 
                ------Percent Rebuilt from Selected ---- 33.28915 % 

 
             ++++++++++++++++ --APSOLUk-- vs1111  Associated solution to entry --- 4  ....  of dimension:  3 

        ----------+++++++++++------------ 
                PTA 3modes  
       ----------+++++++++++------------ 
 Data is ...  Z ...  .... Tensor of order  3  ....  with dimensions:  5 4 6 
modes are  Subjects Trimester Time 
----- Principal Tensor ----  vs111
        ----------+++++++++++------------ RPVSCC algorithm  
                             ------------ Singular Value   vs111 
                                       ----  dimensions:   5 4 6 
 ---------------------- 
 Initialisation  done 
 ----------- iteration- 1 
  1 ^ 9.758862  2 ^ 10.35912  3 ^ 9.671442
 ----------- test =          0.8991215 
 --------Final iteration---- 35 
 ----------- test =          8.97948e-13 

  --Singular Value--  8.469171  -- Local Percent --  31.52390 % 
 --- GLobal Percent ---  31.52390 % 
 ----------APSOLU3------------ ---- Associated solution to entry --- 1  ....  of dimension:  5 
                ------Percent Rebuilt from Selected ---- 35.24933 % 
 ----------APSOLU3------------ ---- Associated solution to entry --- 2  ....  of dimension:  4 
                ------Percent Rebuilt from Selected ---- 45.72535 % 
 ----------APSOLU3------------ ---- Associated solution to entry --- 3  ....  of dimension:  6 
                ------Percent Rebuilt from Selected ---- 48.95478 % 

 +++ PTA 3modes  ------After --- vs111                ------Percent Rebuilt from Selected ---- 48.95478 % 

 -----Execution Time----- 0.91 
                ------Percent Rebuilt from Selected ---- 33.28915 % 
                ------Percent Rebuilt from Selected ---- 33.28915 % 
-----Execution Time----- 7.6 
>  summary(don.sol,testvar=2)

 ++++ PTA-  4 modes ++++  
               data=  don   5 4 6 3 
    centered on each mode 
                ------Percent Rebuilt---- 33.28915 % 
                ------Percent Rebuilt from Selected ---- 31.09654 % 
              -no- --Sing Val-- --ssX-- --local Pct-- --Global Pct--
vs1111           1       8.4692 409.266        17.526        17.5257
5-4 vs111 6 3    4       3.0240  80.871        11.307         2.2344
5-3 vs111 4 6    8       2.9114  82.090        10.326         2.0712
4-6 vs111 5 3   13       3.7528  85.810        16.412         3.4412
4-3 vs111 5 6   15       4.8822 107.055        22.265         5.8241

 ++++               ++++ 
 Shown are selected over  7  PT  with var> 2 % total 
>   plot(don.sol,mod=c(1,2,3,4),nb1=1,nb2=NULL,
+      xlab="Subjects/Trimester/Time/Age",main="Best rank-one approx" )
>   plot(don.sol,mod=c(1,2,3,4),nb1=4,nb2=NULL,
+       xlab="Subjects/Trimester/Time/Age",main="Associated to Subject vs1111")
> 
> #  demo function
>  # demo.PTAk()
> 
>   
> 
> 
> cleanEx(); ..nameEx <- "SVDgen"
> 
> ### * SVDgen
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: SVDgen
> ### Title: SVD with metrics and smoothing approximation
> ### Aliases: SVDgen
> ### Keywords: smooth multivariate
> 
> ### ** Examples
> 
> #library(stats)
>  #library(tensor)
> 
>  # on smoothing
> 
>  data(longley)
>  long <- as.matrix(longley[,1:7])
> 
>  long.svd <- SVDgen(long,smoothing=FALSE)
>   summary.PTAk(long.svd,testvar=0)

 ++++ PTA-  2 modes ++++  
               data=  long   16 7 
    
                ------Percent Rebuilt---- 100 % 
                ------Percent Rebuilt from Selected ---- 100 % 
    -no- --Sing Val--  --ssX-- --local Pct-- --Global Pct--
vs1    1    8168.3138 67053933    9.9504e+01     9.9504e+01
vs2    2     457.3020 67053933    3.1188e-01     3.1188e-01
vs3    3     324.6093 67053933    1.5714e-01     1.5714e-01
vs4    4     134.3763 67053933    2.6929e-02     2.6929e-02
vs5    5       4.9654 67053933    3.6769e-05     3.6769e-05
vs6    6       1.7878 67053933    4.7665e-06     4.7665e-06
vs7    7       1.1893 67053933    2.1095e-06     2.1095e-06

 ++++               ++++ 
 over  7  PT  
>    # X11(width=4,height=4)
>   plot.PTAk(long.svd,scree=TRUE,RiskJack=0,type="b",lty=3)
> 
>  long.svdo <- SVDgen(long,smoothing=TRUE,
+   smoo=list(function(u)ksmooth(1:length(u),
+       u,kernel="normal",bandwidth=3,x.points=(1:length(u)))$y,NA))
> 
>   summary.PTAk(long.svdo,testvar=0)

 ++++ PTA-  2 modes ++++  
               data=  long   16 7 
    
                ------Percent Rebuilt---- 99.95274 % 
                ------Percent Rebuilt from Selected ---- 99.95274 % 
    -no- --Sing Val--  --ssX-- --local Pct-- --Global Pct--
vs1    1   8168.28276 67053933    9.9503e+01     9.9503e+01
vs2    2    449.66364 67053933    3.0154e-01     3.0154e-01
vs3    3    297.68830 67053933    1.3216e-01     1.3216e-01
vs4    4    102.78835 67053933    1.5757e-02     1.5757e-02
vs5    5      4.35026 67053933    2.8223e-05     2.8223e-05
vs6    6      1.62151 67053933    3.9212e-06     3.9212e-06
vs7    7      0.97898 67053933    1.4293e-06     1.4293e-06

 ++++               ++++ 
 over  7  PT  
>   #  X11(width=4,height=4)
>   plot.PTAk(long.svdo,scree=TRUE,RiskJack=0,type="b",lty=3)
>  ###using polynomial fitting
>    polyfit <- function(u,deg=length(u)/5)
+        {n <- length(u);time <- rep(1,n);
+         for(e in 1:deg)time<-cbind(time,(1:n)^e);return(lm.fit(time,u)$fitted.values)}
> bsfit<-function(u,deg=42)
+        {n <- length(u);time <- rep(1,n);
+         return(lm.fit(bs(time,df=deg),u)$fitted.values)}
> 
> ###
>  long.svdo2 <- SVDgen(long,nomb=4,smoothing=TRUE,smoo=list(polyfit,NA))
>   long.svdo2[[1]]$v[1:3,]
          [,1]      [,2]      [,3]       [,4]       [,5]       [,6]        [,7]
[1,] 0.2419518 0.2433432 0.2446148  0.2457821  0.2468608  0.2478663  0.24881398
[2,] 0.3969851 0.3461293 0.2957441  0.2455873  0.1954168  0.1449903  0.09406586
[3,] 0.6186565 0.3030241 0.0630601 -0.1091425 -0.2214907 -0.2818913 -0.29825133
            [,8]        [,9]      [,10]       [,11]        [,12]       [,13]
[1,]  0.24971946  0.25059819  0.2514657  0.25233739  0.253228847  0.25415554
[2,]  0.04240117 -0.01024590 -0.0641175 -0.11945580 -0.176502951 -0.23550112
[3,] -0.27847763 -0.23047717 -0.1621569 -0.08142364  0.003815586  0.08565388
          [,14]      [,15]      [,16]
[1,]  0.2551329  0.2561766  0.2573019
[2,] -0.2966925 -0.3603192 -0.4266233
[3,]  0.1561843  0.2075000  0.2316939
> long.svdo[[1]]$v[1:3,]
          [,1]      [,2]      [,3]      [,4]       [,5]       [,6]       [,7]
[1,] 0.2426743 0.2435021 0.2447127 0.2458248  0.2467617  0.2477224  0.2488531
[2,] 0.3840407 0.3347447 0.2696691 0.2270808  0.2091003  0.1813250  0.1214355
[3,] 0.3080530 0.3532238 0.3556414 0.1716270 -0.1692049 -0.4142744 -0.4268037
            [,8]         [,9]       [,10]       [,11]       [,12]      [,13]
[1,]  0.24994524  0.250554433  0.25107689  0.25213309  0.25341002  0.2543267
[2,]  0.04812469 -0.001057976 -0.04360491 -0.11651992 -0.20195576 -0.2633162
[3,] -0.30807523 -0.216228340 -0.15352432 -0.04574765  0.07643676  0.1303596
          [,14]      [,15]      [,16]
[1,]  0.2551843  0.2560875  0.2566259
[2,] -0.3172793 -0.3701456 -0.3990394
[3,]  0.1453434  0.1420260  0.1025907
> # orthogonality may be lost with non-projective smoother
> 
>      ####
> comtoplot <- function(com=1,solua=long.svd,solub=long.svdo,openX11s=FALSE,...)
+          {
+   if(openX11s)X11(width=4,height=4)
+  yla <- c(round((100*(solua[[2]]$d[com])^2)/
+      solua[[2]]$ssX[1],4),
+      round((100*(solub[[2]]$d[com])^2)/solua[[2]]$ssX[1],4))
+ 
+ limi <- range(c(solua[[1]]$v[com,],solub[[1]]$v[com,]))
+   plot(solua,nb1=com, mod=1,type="b",lty=3,lengthlabels=4,cex=0.4,
+    ylimit=limi,ylab="",col=2,...)
+ mtext(paste("vs",com,":",yla[1],"%"),2,col=2,line=2)
+  par(new=TRUE)
+ 
+   plot.PTAk(solub,nb1=com,mod=1,labels=FALSE,type="b",lty=1,
+   lengthlabels=4,cex=0.6,ylimit=limi,ylab="",main=paste("smooth vs",com,":",yla[2],"%"),...)
+   par(new=FALSE)
+ }   ####
>  comtoplot(com=1)
> 
> 
> #  on using non-diagonal metrics
> 
>  data(crimerate)
>   crimerate.mat <- sweep(crimerate,2,apply(crimerate,2,mean))
>   crimerate.mat <- sweep(crimerate.mat,2,sqrt(apply(crimerate.mat,2,var)),FUN="/")
>    metW <- Powmat(CauRuimet(crimerate.mat),(-1))
-----Execution Time----- 0.01 
>    # inverse of the within "group" (to play a bit more you could set m0 relating
>    # the neighbourhood of states (see CauRuimet)
> 
>   cri.svd <- SVDgen(crimerate.mat,D2=1,D1=1)
>   summary(cri.svd,testvar=0)

 ++++ PTA-  2 modes ++++  
               data=  crimerate.mat   50 7 
    
                ------Percent Rebuilt---- 100 % 
                ------Percent Rebuilt from Selected ---- 100 % 
    -no- --Sing Val-- --ssX-- --local Pct-- --Global Pct--
vs1    1      14.1998     343       58.7851        58.7851
vs2    2       7.7909     343       17.6960        17.6960
vs3    3       5.9636     343       10.3688        10.3688
vs4    4       3.9377     343        4.5205         4.5205
vs5    5       3.5554     343        3.6853         3.6853
vs6    6       3.2985     343        3.1720         3.1720
vs7    7       2.4655     343        1.7722         1.7722

 ++++               ++++ 
 over  7  PT  
>    plot(cri.svd,scree=TRUE,RiskJack=0,type="b",lty=3)
>   cri.svdo <- SVDgen(crimerate.mat,D2=metW,D1=1)
>    summary(cri.svdo,testvar=0)

 ++++ PTA-  2 modes ++++  
               data=  crimerate.mat   50 7 
    
                ------Percent Rebuilt---- 100 % 
                ------Percent Rebuilt from Selected ---- 100 % 
    -no- --Sing Val-- --ssX-- --local Pct-- --Global Pct--
vs1    1       17.789  1209.3       26.1688        26.1688
vs2    2       14.665  1209.3       17.7842        17.7842
vs3    3       13.213  1209.3       14.4363        14.4363
vs4    4       12.133  1209.3       12.1728        12.1728
vs5    5       11.717  1209.3       11.3533        11.3533
vs6    6       10.810  1209.3        9.6623         9.6623
vs7    7       10.092  1209.3        8.4223         8.4223

 ++++               ++++ 
 over  7  PT  
>    plot(cri.svdo,scree=TRUE,RiskJack=0,type="b",lty=3)
>   # X11(width=8,height=4)
>   par(mfrow=c(1,2))
>    plot(cri.svd,nb1=1,nb2=2,mod=1,lengthlabels=3)
>   plot(cri.svd,nb1=1,nb2=2,mod=2,lengthlabels=4,main="canonical")
>   # X11(width=8,height=4)
>   par(mfrow=c(1,2))
>  plot(cri.svdo,nb1=1,nb2=2,mod=1,lengthlabels=3)
>  plot(cri.svdo,nb1=1,nb2=2,mod=2,lengthlabels=4,
+        main=expression(paste("metric ",Wg^{-1})))
> 
> ###########
> #  demo function
>  # when ima is NULL it uses the dataset timage12 but you can put any array
>  # demo.SVDgen(ima=NULL,snr=3,openX11s=TRUE)  
> 
>     
> 
> 
> graphics::par(get("par.postscript", env = .CheckExEnv))
> cleanEx(); ..nameEx <- "plot.PTAk"
> 
> ### * plot.PTAk
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: plot.PTAk
> ### Title: Plot a PTAk object
> ### Aliases: plot.PTAk RiskJackplot
> ### Keywords: hplot multivariate
> 
> ### ** Examples
> 
> #  see the demo function   source(paste(R.home(),"/ library/PTAk/demo/PTA3.R",sep=""));
> # or    source(paste(R.home(),"/ library/PTAk/demo/PTAk.R",sep=""));
>  
>  # demo.PTA3()
>  
> 
> 
> cleanEx(); ..nameEx <- "summary.PTAk"
> 
> ### * summary.PTAk
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: summary.PTAk
> ### Title: Summary of a PTA-k modes analysis
> ### Aliases: summary.PTAk summary.FCAk
> ### Keywords: array algebra multivariate
> 
> ### ** Examples
> 
>  data(crimerate)
>  crimerate.mat <- sweep(crimerate,2,apply(crimerate,2,mean))
>  crimerate.mat <- sweep(crimerate.mat,2,sqrt(apply(crimerate,2,var)),FUN="/")
>  cri.svd <- SVDgen(crimerate.mat)
>  summary(cri.svd,testvar=0)

 ++++ PTA-  2 modes ++++  
               data=  crimerate.mat   50 7 
    
                ------Percent Rebuilt---- 100 % 
                ------Percent Rebuilt from Selected ---- 100 % 
    -no- --Sing Val-- --ssX-- --local Pct-- --Global Pct--
vs1    1      14.1998     343       58.7851        58.7851
vs2    2       7.7909     343       17.6960        17.6960
vs3    3       5.9636     343       10.3688        10.3688
vs4    4       3.9377     343        4.5205         4.5205
vs5    5       3.5554     343        3.6853         3.6853
vs6    6       3.2985     343        3.1720         3.1720
vs7    7       2.4655     343        1.7722         1.7722

 ++++               ++++ 
 over  7  PT  
>   plot(cri.svd,scree=TRUE)
>   par(new=TRUE)
>   RiskJackplot(cri.svd,nbvs=1:7,mod=NULL,max=NULL,rescaled=TRUE,
+         axes=FALSE,ann=FALSE)
>   par(new=FALSE)
> 
>   # or equivalently
> 
>   plot(cri.svd,scree=TRUE,type="b",lty=3,RiskJack=1) #set mod=NULL or c(1,2)
>   ###
>    data(crimerate)
>    criafc <- FCAmet(crimerate,chi2=TRUE)

  --
 ++++ Data is             crimerate         +++++++
 -------------- Multiple contingency Table of dimensions  50 7   ---- 

 -------------- Chi2 =  8592.442  with ddl =  294
  ------------- p(>Chi2)=  0 

  -- 
>    cri.afc <- SVDgen(criafc$data,criafc$met[[2]],criafc$met[[1]])
>     summary(cri.afc)

 ++++ PTA-  2 modes ++++  
               data=  criafc$data   50 7 
    
                ------Percent Rebuilt---- 100 % 
                ------Percent Rebuilt from Selected ---- 99.18037 % 
    -no- --Sing Val-- --ssX-- --local Pct-- --Global Pct--
vs1    1      1.00000  1.0365       96.4793        96.4793
vs2    2      0.13079  1.0365        1.6503         1.6503
vs3    3      0.10436  1.0365        1.0507         1.0507

 ++++               ++++ 
 Shown are selected over  7  PT  with var> 1 % total 
>    plot(cri.afc,scree=TRUE)
>    plot(cri.afc,scree=TRUE,type="b",lty=3,RiskJack=1,method="FCA")
> 
>    
> 
> 
> graphics::par(get("par.postscript", env = .CheckExEnv))
> ### * <FOOTER>
> ###
> cat("Time elapsed: ", proc.time() - get("ptime", env = .CheckExEnv),"\n")
Time elapsed:  6 2.32 8.35 0 0 
> grDevices::dev.off()
null device 
          1 
> ###
> ### Local variables: ***
> ### mode: outline-minor ***
> ### outline-regexp: "\\(> \\)?### [*]+" ***
> ### End: ***
> quit('no')