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("geometry-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('geometry') > > assign(".oldSearch", search(), env = .CheckExEnv) > assign(".oldNS", loadedNamespaces(), env = .CheckExEnv) > cleanEx(); ..nameEx <- "Unique" > > ### * Unique > > flush(stderr()); flush(stdout()) > > ### Name: Unique > ### Title: Extract Unique Rows > ### Aliases: Unique > ### Keywords: arith math array > > ### ** Examples > > # `Unique' is faster than `unique' > x = matrix(sample(1:(4*8),4*8),ncol=4) > y = x[sample(1:nrow(x),3000,TRUE), ] > gc(); system.time(unique(y)) used (Mb) gc trigger (Mb) max used (Mb) Ncells 170039 4.6 350000 9.4 350000 9.4 Vcells 69777 0.6 786432 6.0 300630 2.3 [1] 0.23 0.00 0.23 0.00 0.00 > gc(); system.time(Unique(y)) used (Mb) gc trigger (Mb) max used (Mb) Ncells 170454 4.6 350000 9.4 350000 9.4 Vcells 69832 0.6 786432 6.0 300630 2.3 [1] 0.01 0.00 0.02 0.00 0.00 > > # > z = Unique(y) > x[matorder(x),] [,1] [,2] [,3] [,4] [1,] 6 14 24 21 [2,] 9 16 31 13 [3,] 12 2 15 19 [4,] 17 32 23 10 [5,] 18 5 28 1 [6,] 25 8 3 22 [7,] 27 4 11 26 [8,] 29 20 7 30 > z[matorder(z),] [,1] [,2] [,3] [,4] [1,] 6 14 24 21 [2,] 9 16 31 13 [3,] 12 2 15 19 [4,] 17 32 23 10 [5,] 18 5 28 1 [6,] 25 8 3 22 [7,] 27 4 11 26 [8,] 29 20 7 30 > > > > > cleanEx(); ..nameEx <- "convhulln" > > ### * convhulln > > flush(stderr()); flush(stdout()) qhull warning: joggle ('QJ') always produces simplicial output. Triangulated output ('Qt') does nothing. Convex hull of 1000 points in 3-d: Number of vertices: 1000 Number of facets: 1996 Statistics for: | qhull s Qt Tcv QJ Number of points processed: 1000 Number of hyperplanes created: 5478 Number of distance tests for qhull: 25611 CPU seconds to compute hull (after input): 0.02 Input joggled by: 7.2e-11 qhull output completed. Verifying that 1000 points are below 7.2e-15 of the nearest facet. > > ### Name: convhulln > ### Title: Compute smallest convex hull that encloses a set of points > ### Aliases: convhulln > ### Keywords: math dplot graphs > > ### ** Examples > > # example delaunayn > d = c(-1,1) > pc = as.matrix(rbind(expand.grid(d,d,d),0)) > tc = delaunayn(pc) > > # example tetramesh > ## Not run: > ##D library(rgl) > ##D rgl.viewpoint(60) > ##D rgl.light(120,60) > ##D tetramesh(tc,pc, alpha=0.9) # render tetrahedron mesh > ## End(Not run) > > # example convhulln > # ==> see also surf.tri to avoid unwanted messages printed to the console by qhull > ps = matrix(rnorm(3000),ncol=3) # generate poinst on a sphere > ps = sqrt(3) * ps / drop(sqrt((ps^2) %*% rep(1,3))) > ts.surf = t( convhulln(ps,"QJ") ) # see the qhull documentations for the options > ## Not run: > ##D rgl.triangles(ps[ts.surf,1],ps[ts.surf,2],ps[ts.surf,3],col="blue",alpha=.2) > ##D for(i in 1:(8*360)) rgl.viewpoint(i/8) > ## End(Not run) > > > > cleanEx(); ..nameEx <- "delaunayn" > > ### * delaunayn > > flush(stderr()); flush(stdout()) > > ### Name: delaunayn > ### Title: Delaunay triangulation in N-dimensions > ### Aliases: delaunayn > ### Keywords: math dplot graphs > > ### ** Examples > > # example delaunayn > d = c(-1,1) > pc = as.matrix(rbind(expand.grid(d,d,d),0)) > tc = delaunayn(pc) > > # example tetramesh > ## Not run: > ##D library(rgl) > ##D rgl.viewpoint(60) > ##D rgl.light(120,60) > ##D tetramesh(tc,pc, alpha=0.9) > ## End(Not run) > > # example surf.tri > # ==> see also convhulln, but it currently prints an unavoidable > # message to the console > ps = matrix(rnorm(3000),ncol=3) # generate poinst on a sphere > ps = sqrt(3) * ps / drop(sqrt((ps^2) %*%rep(1,3))) > ts = delaunayn(ps) > ts.surf = t( surf.tri(ps,ts) ) > ## Not run: > ##D rgl.triangles(ps[ts.surf,1], ps[ts.surf,2] ,ps[ts.surf,3], > ##D col="blue", alpha=.2) > ##D for(i in 1:(8*360)) rgl.viewpoint(i/8) > ## End(Not run) > > > > cleanEx(); ..nameEx <- "distmesh2d" > > ### * distmesh2d > > flush(stderr()); flush(stdout()) > > ### Name: distmesh2d > ### Title: A simple mesh generator for non-convex regions > ### Aliases: distmesh2d > ### Keywords: math optimize dplot graphs > > ### ** Examples > > # examples distmesh2d > fd = function(p, ...) sqrt((p^2)%*%c(1,1)) - 1 > # also predefined as `mesh.dcircle' > fh = function(p,...) rep(1,nrow(p)) > bbox = matrix(c(-1,1,-1,1),2,2) > p = distmesh2d(fd,fh,0.2,bbox, maxiter=100) Press esc if the mesh seems fine but the algorithm hasn't converged. > # this may take a while: > # press Esc to get result of current iteration > > # example with non-convex region > fd = function(p, ...) mesh.diff( p , mesh.drectangle, mesh.dcircle, radius=.3) > # fd defines difference of square and circle > > p = distmesh2d(fd,fh,0.05,bbox,radius=0.3,maxiter=4) Press esc if the mesh seems fine but the algorithm hasn't converged. Warning in distmesh2d(fd, fh, 0.05, bbox, radius = 0.3, maxiter = 4) : Maximum iterations reached. Relaxation process not completed > p = distmesh2d(fd,fh,0.05,bbox,radius=0.3, maxiter=10) Press esc if the mesh seems fine but the algorithm hasn't converged. Warning in distmesh2d(fd, fh, 0.05, bbox, radius = 0.3, maxiter = 10) : Maximum iterations reached. Relaxation process not completed > # continue on previous mesh > > > > cleanEx(); ..nameEx <- "distmeshnd" > > ### * distmeshnd > > flush(stderr()); flush(stdout()) > > ### Name: distmeshnd > ### Title: A simple mesh generator for non-convex regions in n-D space > ### Aliases: distmeshnd > ### Keywords: math optimize dplot graphs > > ### ** Examples > > ## Not run: > ##D # examples distmeshnd > ##D require(rgl) > ##D > ##D fd = function(p, ...) sqrt((p^2)%*%c(1,1,1)) - 1 > ##D # also predefined as `mesh.dsphere' > ##D fh = function(p,...) rep(1,nrow(p)) > ##D # also predefined as `mesh.hunif' > ##D bbox = matrix(c(-1,1),2,3) > ##D p = distmeshnd(fd,fh,0.2,bbox, maxiter=100) > ##D # this may take a while: > ##D # press Esc to get result of current iteration > ##D > ##D # example with non-convex region > ##D fd = function(p, ...) mesh.diff( p , mesh.drectangle, mesh.dcircle, radius=.3) > ##D # fd defines difference of square and circle > ##D > ##D p = distmesh2d(fd,fh,0.05,bbox,radius=0.3,maxiter=4) > ##D p = distmesh2d(fd,fh,0.05,bbox,radius=0.3, maxiter=10) > ##D # continue on previous mesh > ## End(Not run) > > > > cleanEx(); ..nameEx <- "entry.value" > > ### * entry.value > > flush(stderr()); flush(stdout()) > > ### Name: entry.value > ### Title: Retrieve or set a list of array element values > ### Aliases: entry.value entry.value<- > ### Keywords: arith math array > > ### ** Examples > > a = array(1:(4^4),c(4,4,4,4)) > entry.value(a,cbind(1:4,1:4,1:4,1:4)) [1] 1 86 171 256 > entry.value(a,cbind(1:4,1:4,1:4,1:4)) <- 0 > > entry.value(a, as.matrix(expand.grid(1:4,1:4,1:4,1:4))) [1] 0 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 [19] 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 [37] 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 [55] 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 [73] 73 74 75 76 77 78 79 80 81 82 83 84 85 0 87 88 89 90 [91] 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 [109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 [127] 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 [145] 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 [163] 163 164 165 166 167 168 169 170 0 172 173 174 175 176 177 178 179 180 [181] 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 [199] 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 [217] 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 [235] 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 [253] 253 254 255 0 > # same as `c(a[1:4,1:4,1:4,1:4])' which is same as `c(a)' > > > > cleanEx(); ..nameEx <- "matmax" > > ### * matmax > > flush(stderr()); flush(stdout()) > > ### Name: matmax, matmin, matsort > ### Title: Row-wise matrix functions > ### Aliases: matmax matmin matsort matorder > ### Keywords: array arith > > ### ** Examples > > example(Unique) Unique> x = matrix(sample(1:(4 * 8), 4 * 8), ncol = 4) Unique> y = x[sample(1:nrow(x), 3000, TRUE), ] Unique> gc() used (Mb) gc trigger (Mb) max used (Mb) Ncells 179727 4.8 407500 10.9 350000 9.4 Vcells 71530 0.6 786432 6.0 786343 6.0 Unique> system.time(unique(y)) [1] 0.23 0.00 0.35 0.00 0.00 Unique> gc() used (Mb) gc trigger (Mb) max used (Mb) Ncells 179836 4.9 407500 10.9 407500 10.9 Vcells 71543 0.6 786432 6.0 786343 6.0 Unique> system.time(Unique(y)) [1] 0.01 0.00 0.01 0.00 0.00 Unique> z = Unique(y) Unique> x[matorder(x), ] [,1] [,2] [,3] [,4] [1,] 6 14 24 21 [2,] 9 16 31 13 [3,] 12 2 15 19 [4,] 17 32 23 10 [5,] 18 5 28 1 [6,] 25 8 3 22 [7,] 27 4 11 26 [8,] 29 20 7 30 Unique> z[matorder(z), ] [,1] [,2] [,3] [,4] [1,] 6 14 24 21 [2,] 9 16 31 13 [3,] 12 2 15 19 [4,] 17 32 23 10 [5,] 18 5 28 1 [6,] 25 8 3 22 [7,] 27 4 11 26 [8,] 29 20 7 30 > > > > cleanEx(); ..nameEx <- "mesh.functions" > > ### * mesh.functions > > flush(stderr()); flush(stdout()) > > ### Name: mesh.functions > ### Title: Special Distance Functions > ### Aliases: mesh.dcircle mesh.drectangle mesh.diff mesh.union > ### mesh.intersect mesh.dsphere mesh.hunif > ### Keywords: arith math > > ### ** Examples > > example(distmesh2d) dstms2> fd = function(p, ...) sqrt((p^2) %*% c(1, 1)) - 1 dstms2> fh = function(p, ...) rep(1, nrow(p)) dstms2> bbox = matrix(c(-1, 1, -1, 1), 2, 2) dstms2> p = distmesh2d(fd, fh, 0.2, bbox, maxiter = 100) Press esc if the mesh seems fine but the algorithm hasn't converged. dstms2> fd = function(p, ...) mesh.diff(p, mesh.drectangle, mesh.dcircle, radius = 0.3) dstms2> p = distmesh2d(fd, fh, 0.05, bbox, radius = 0.3, maxiter = 4) Press esc if the mesh seems fine but the algorithm hasn't converged. Warning in distmesh2d(fd, fh, 0.05, bbox, radius = 0.3, maxiter = 4) : Maximum iterations reached. Relaxation process not completed dstms2> p = distmesh2d(fd, fh, 0.05, bbox, radius = 0.3, maxiter = 10) Press esc if the mesh seems fine but the algorithm hasn't converged. Warning in distmesh2d(fd, fh, 0.05, bbox, radius = 0.3, maxiter = 10) : Maximum iterations reached. Relaxation process not completed > > > > cleanEx(); ..nameEx <- "surf.tri" > > ### * surf.tri > > flush(stderr()); flush(stdout()) > > ### Name: surf.tri > ### Title: Find surface triangles from tetrahedra mesh > ### Aliases: surf.tri > ### Keywords: math optimize dplot > > ### ** Examples > > ## Not run: > ##D # more extensive example of surf.tri > ##D library(rgl) # to render tesselation > ##D library(R.matlab) # to read matlab .mat files > ##D > ##D # url's of publically available data: > ##D data1.url = "http://neuroimage.usc.edu/USCPhantom/mesh_data.bin" > ##D data2.url = "http://neuroimage.usc.edu/USCPhantom/CT_PCS_trans.bin" > ##D > ##D meshdata = readMat(url(data1.url)) > ##D elec = readMat(url(data2.url))$eeg.ct2pcs/1000 > ##D brain = meshdata$mesh.brain[,c(1,3,2)] > ##D scalp = meshdata$mesh.scalp[,c(1,3,2)] > ##D skull = meshdata$mesh.skull[,c(1,3,2)] > ##D tbr = t(surf.tri(brain, delaunayn(brain))) > ##D tsk = t(surf.tri(skull, delaunayn(skull))) > ##D tsc = t(surf.tri(scalp, delaunayn(scalp))) > ##D rgl.triangles(brain[tbr,1], brain[tbr,2], brain[tbr,3],col="gray") > ##D rgl.triangles(skull[tsk,1], skull[tsk,2], skull[tsk,3],col="white", alpha=0.3) > ##D rgl.triangles(scalp[tsc,1], scalp[tsc,2], scalp[tsc,3],col="#a53900", alpha=0.6) > ##D rgl.viewpoint(-40,30,.4,zoom=.03) > ##D lx = c(-.025,.025); ly = -c(.02,.02); > ##D rgl.spheres(elec[,1],elec[,3],elec[,2],radius=.0025,col='gray') > ##D rgl.spheres( lx, ly,.11,radius=.015,col="white") > ##D rgl.spheres( lx, ly,.116,radius=.015*.7,col="brown") > ##D rgl.spheres( lx, ly,.124,radius=.015*.25,col="black") > ## End(Not run) > > > > cleanEx(); ..nameEx <- "tetramesh" > > ### * tetramesh > > flush(stderr()); flush(stdout()) > > ### Name: tetramesh > ### Title: Display triangles mesh (2D) render tetrahedron mesh (3D) > ### Aliases: tetramesh trimesh > ### Keywords: hplot > > ### ** Examples > > #example trimesh > p = cbind(x=rnorm(30), y=rnorm(30)) > tt = delaunayn(p) > trimesh(tt,p) > > ## Not run: > ##D # example delaunayn > ##D d = c(-1,1) > ##D pc = as.matrix(rbind(expand.grid(d,d,d),0)) > ##D tc = delaunayn(pc) > ##D > ##D # example tetramesh > ##D library(rgl) > ##D clr = rep(1,3) > ##D rgl.viewpoint(60,fov=20) > ##D rgl.light(270,60) > ##D tetramesh(tc,pc,alpha=0.7,col=clr) > ## End(Not run) > > > > ### *