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. > ### *
> ### > 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("shapes-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('shapes') > > assign(".oldSearch", search(), env = .CheckExEnv) > assign(".oldNS", loadedNamespaces(), env = .CheckExEnv) > cleanEx(); ..nameEx <- "bookstein2d" > > ### * bookstein2d > > flush(stderr()); flush(stdout()) > > ### Name: bookstein2d > ### Title: Bookstein's baseline registration for 2D data > ### Aliases: bookstein2d > ### Keywords: multivariate > > ### ** Examples > > data(gorf.dat) > data(gorm.dat) > > bookf<-bookstein2d(gorf.dat) > bookm<-bookstein2d(gorm.dat) > > plotshapes(bookf$mshape,bookm$mshape,joinline=c(1,6,7,8,2,3,4,5,1)) > > > > cleanEx(); ..nameEx <- "digit3.dat" > > ### * digit3.dat > > flush(stderr()); flush(stdout()) > > ### Name: digit3.dat > ### Title: Digit 3 data > ### Aliases: digit3.dat > ### Keywords: datasets > > ### ** Examples > > data(digit3.dat) > k<-dim(digit3.dat)[1] > n<-dim(digit3.dat)[3] > digit3.dat[,2,]<- -digit3.dat[,2,]+50 > plotshapes(digit3.dat,joinline=c(1:13)) > > > > cleanEx(); ..nameEx <- "gorf.dat" > > ### * gorf.dat > > flush(stderr()); flush(stdout()) > > ### Name: gorf.dat > ### Title: Female gorilla data > ### Aliases: gorf.dat > ### Keywords: datasets > > ### ** Examples > > data(gorf.dat) > plotshapes(gorf.dat) > > > > cleanEx(); ..nameEx <- "gorm.dat" > > ### * gorm.dat > > flush(stderr()); flush(stdout()) > > ### Name: gorm.dat > ### Title: Male gorilla data > ### Aliases: gorm.dat > ### Keywords: datasets > > ### ** Examples > > data(gorm.dat) > plotshapes(gorm.dat) > > > > cleanEx(); ..nameEx <- "macf.dat" > > ### * macf.dat > > flush(stderr()); flush(stdout()) > > ### Name: macf.dat > ### Title: Female macaque data > ### Aliases: macf.dat > ### Keywords: datasets > > ### ** Examples > > data(macf.dat) > plotshapes(macf.dat) > > > > cleanEx(); ..nameEx <- "macm.dat" > > ### * macm.dat > > flush(stderr()); flush(stdout()) > > ### Name: macm.dat > ### Title: Male macaque data > ### Aliases: macm.dat > ### Keywords: datasets > > ### ** Examples > > data(macm.dat) > plotshapes(macm.dat) > > > > cleanEx(); ..nameEx <- "plotshapes" > > ### * plotshapes > > flush(stderr()); flush(stdout()) > > ### Name: plotshapes > ### Title: Plot configurations > ### Aliases: plotshapes > ### Keywords: hplot multivariate > > ### ** Examples > > data(gorf.dat) > data(gorm.dat) > plotshapes(gorf.dat,gorm.dat,joinline=c(1,6,7,8,2,3,4,5,1)) > > data(macm.dat) > data(macf.dat) > plotshapes(macm.dat,macf.dat) > > > > cleanEx(); ..nameEx <- "procGPA" > > ### * procGPA > > flush(stderr()); flush(stdout()) > > ### Name: procGPA > ### Title: Generalised Procrustes analysis > ### Aliases: procGPA > ### Keywords: multivariate > > ### ** Examples > > > #2D example : female and male Gorillas (cf. Dryden and Mardia, 1998) > > data(gorf.dat) > data(gorm.dat) > > plotshapes(gorf.dat,gorm.dat) > n1<-dim(gorf.dat)[3] > n2<-dim(gorm.dat)[3] > k<-dim(gorf.dat)[1] > m<-dim(gorf.dat)[2] > gor.dat<-array(0,c(k,2,n1+n2)) > gor.dat[,,1:n1]<-gorf.dat > gor.dat[,,(n1+1):(n1+n2)]<-gorm.dat > > gor<-procGPA(gor.dat) > shapepca(gor,type="r",mag=3) > shapepca(gor,type="v",mag=3) > > gor.gp<-c(rep("f",times=30),rep("m",times=29)) > x<-cbind(gor$size,gor$rho,gor$scores[,1:3]) > pairs(x,panel=function(x,y) text(x,y,gor.gp), + label=c("s","rho","score 1","score 2","score 3")) > > ########################################################## > #3D example > > data(macm.dat) > out<-procGPA(macm.dat,scale=FALSE) > > par(mfrow=c(2,2)) > plot(out$rawscores[,1],out$rawscores[,2],xlab="PC1",ylab="PC2") > title("PC scores") > plot(out$rawscores[,2],out$rawscores[,3],xlab="PC2",ylab="PC3") > plot(out$rawscores[,1],out$rawscores[,3],xlab="PC1",ylab="PC3") > plot(out$size,out$rho,xlab="size",ylab="rho") > title("Size versus shape distance") > > > > > graphics::par(get("par.postscript", env = .CheckExEnv)) > cleanEx(); ..nameEx <- "procOPA" > > ### * procOPA > > flush(stderr()); flush(stdout()) > > ### Name: procOPA > ### Title: Ordinary Procrustes analysis > ### Aliases: procOPA > ### Keywords: multivariate > > ### ** Examples > > data(digit3.dat) > > A<-digit3.dat[,,1] > B<-digit3.dat[,,2] > ans<-procOPA(A,B) > plotshapes(A,B,joinline=1:13) > plotshapes(ans$Ahat,ans$Bhat,joinline=1:13) > > #Sooty Mangabey data > data(sooty.dat) > A<-sooty.dat[,,1] #juvenile > B<-sooty.dat[,,2] #adult > par(mfrow=c(1,3)) > par(pty="s") > plot(A,xlim=c(-2000,3000),ylim=c(-2000,3000),xlab=" ",ylab=" ") > lines(A[c(1:12,1),]) > points(B) > lines(B[c(1:12,1),],lty=2) > title("Juvenile (-------) Adult (- - - -)") > #match B onto A > out<-procOPA(A,B) > #rotation angle > print(atan2(out$R[1,2],out$R[1,1])*180/pi) [1] -45.52717 > #scale > print(out$s) [1] 0.8745017 > plot(A,xlim=c(-2000,3000),ylim=c(-2000,3000),xlab=" ",ylab=" ") > lines(A[c(1:12,1),]) > points(out$Bhat) > lines(out$Bhat[c(1:12,1),],lty=2) > title("Match adult onto juvenile") > #match A onto B > out<-procOPA(B,A) > #rotation angle > print(atan2(out$R[1,2],out$R[1,1])*180/pi) [1] 45.52717 > #scale > print(out$s) [1] 1.130936 > plot(B,xlim=c(-2000,3000),ylim=c(-2000,3000),xlab=" ",ylab=" ") > lines(B[c(1:12,1),],lty=2) > points(out$Bhat) > lines(out$Bhat[c(1:12,1),]) > title("Match juvenile onto adult") > > > > graphics::par(get("par.postscript", env = .CheckExEnv)) > cleanEx(); ..nameEx <- "qcet2.dat" > > ### * qcet2.dat > > flush(stderr()); flush(stdout()) > > ### Name: qcet2.dat > ### Title: Control T2 mouse vertabrae data > ### Aliases: qcet2.dat > ### Keywords: datasets > > ### ** Examples > > data(qcet2.dat) > plotshapes(qcet2.dat) > > > > cleanEx(); ..nameEx <- "qlet2.dat" > > ### * qlet2.dat > > flush(stderr()); flush(stdout()) > > ### Name: qlet2.dat > ### Title: Large T2 mouse vertabrae data > ### Aliases: qlet2.dat > ### Keywords: datasets > > ### ** Examples > > data(qlet2.dat) > plotshapes(qlet2.dat) > > > > cleanEx(); ..nameEx <- "qset2.dat" > > ### * qset2.dat > > flush(stderr()); flush(stdout()) > > ### Name: qset2.dat > ### Title: Small T2 mouse vertabrae data > ### Aliases: qset2.dat > ### Keywords: datasets > > ### ** Examples > > data(qset2.dat) > plotshapes(qset2.dat) > > > > cleanEx(); ..nameEx <- "riemdist" > > ### * riemdist > > flush(stderr()); flush(stdout()) > > ### Name: riemdist > ### Title: Riemannian shape distance > ### Aliases: riemdist > ### Keywords: multivariate > > ### ** Examples > > data(gorf.dat) > data(gorm.dat) > gorf<-procGPA(gorf.dat) > gorm<-procGPA(gorm.dat) > rho<-riemdist(gorf$mshape,gorm$mshape) > cat("Riemannian distance between mean shapes is ",rho," \n") Riemannian distance between mean shapes is 0.05866407 > > > > cleanEx(); ..nameEx <- "shapepca" > > ### * shapepca > > flush(stderr()); flush(stdout()) > > ### Name: shapepca > ### Title: Principal components for shape > ### Aliases: shapepca > ### Keywords: hplot multivariate > > ### ** Examples > > #2d example > data(gorf.dat) > data(gorm.dat) > > gorf<-procGPA(gorf.dat) > gorm<-procGPA(gorm.dat) > shapepca(gorf,type="r",mag=3) > shapepca(gorf,type="v",mag=3) > shapepca(gorm,type="r",mag=3) > shapepca(gorm,type="v",mag=3) > > #3D example > #data(macm.dat) > #out<-procGPA(macm.dat) > #movie > #shapepca(out,pcno=1) > > > > cleanEx(); ..nameEx <- "sooty.dat" > > ### * sooty.dat > > flush(stderr()); flush(stdout()) > > ### Name: sooty.dat > ### Title: Sooty mangabey data > ### Aliases: sooty.dat > ### Keywords: datasets > > ### ** Examples > > data(sooty.dat) > plotshapes(sooty.dat,joinline=c(1:12,1)) > > > > cleanEx(); ..nameEx <- "testmeanshapes" > > ### * testmeanshapes > > flush(stderr()); flush(stdout()) > > ### Name: testmeanshapes > ### Title: Tests for mean shape difference > ### Aliases: testmeanshapes > ### Keywords: multivariate > > ### ** Examples > > > #2D example : female and male Gorillas (cf. Dryden and Mardia, 1998) > > data(gorf.dat) > data(gorm.dat) > > #Hotelling's Tsq test > test1<-testmeanshapes(gorf.dat,gorm.dat) Hotelling's T^2 test: Test statistic = 26.47 p-value = 0 Degrees of freedom = 12 46 > > #Goodall's isotropic test > test2<-testmeanshapes(gorf.dat,gorm.dat,Hotelling=FALSE) Goodall's F test: Test statistic = 22.29 p-value = 0 Degrees of freedom = 12 684 > > > > > cleanEx(); ..nameEx <- "tpsgrid" > > ### * tpsgrid > > flush(stderr()); flush(stdout()) > > ### Name: tpsgrid > ### Title: Thin-plate spline transformation grids > ### Aliases: tpsgrid > ### Keywords: multivariate hplot > > ### ** Examples > > data(gorf.dat) > data(gorm.dat) > > #TPS grid with shape change exaggerated (2x) > gorf<-procGPA(gorf.dat) > gorm<-procGPA(gorm.dat) > mag<-2 > TT<-gorf$mshape > YY<-gorm$mshape > par(mfrow=c(1,2)) > YY<-TT+(YY-TT)*mag > tpsgrid(TT,YY,-0.6,-0.6,1.2,2,0.1,22) > title("TPS grid: Female mean (left) to Male mean (right)") > > > > > graphics::par(get("par.postscript", env = .CheckExEnv)) > ### *