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("ResistorArray-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('ResistorArray') > > assign(".oldSearch", search(), env = .CheckExEnv) > assign(".oldNS", loadedNamespaces(), env = .CheckExEnv) > cleanEx(); ..nameEx <- "Wu" > > ### * Wu > > flush(stderr()); flush(stdout()) > > ### Name: Wu > ### Title: Wu's resistance matrix > ### Aliases: Wu > ### Keywords: array > > ### ** Examples > > > Wu(cube()) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [1,] 0.0000000 0.5833333 0.7500000 0.5833333 0.5833333 0.7500000 0.8333333 [2,] 0.5833333 0.0000000 0.5833333 0.7500000 0.7500000 0.5833333 0.7500000 [3,] 0.7500000 0.5833333 0.0000000 0.5833333 0.8333333 0.7500000 0.5833333 [4,] 0.5833333 0.7500000 0.5833333 0.0000000 0.7500000 0.8333333 0.7500000 [5,] 0.5833333 0.7500000 0.8333333 0.7500000 0.0000000 0.5833333 0.7500000 [6,] 0.7500000 0.5833333 0.7500000 0.8333333 0.5833333 0.0000000 0.5833333 [7,] 0.8333333 0.7500000 0.5833333 0.7500000 0.7500000 0.5833333 0.0000000 [8,] 0.7500000 0.8333333 0.7500000 0.5833333 0.5833333 0.7500000 0.5833333 [,8] [1,] 0.7500000 [2,] 0.8333333 [3,] 0.7500000 [4,] 0.5833333 [5,] 0.5833333 [6,] 0.7500000 [7,] 0.5833333 [8,] 0.0000000 > > Wu(cube())[1,2] - resistance(cube(),1,2) [1] -1.110223e-16 > > Wu(series(7)) [,1] [,2] [1,] 0 7 [2,] 7 0 > > > > > cleanEx(); ..nameEx <- "array.resistance" > > ### * array.resistance > > flush(stderr()); flush(stdout()) > > ### Name: array.resistance > ### Title: Resistance between two arbitrary points on a regular lattice of > ### unit resistors > ### Aliases: array.resistance > ### Keywords: array > > ### ** Examples > > jj.approximate <- array.resistance(1,2,15,17,give=FALSE) > jj.exact <- 4/pi-1/2 > print(jj.exact - jj.approximate) [1] 0.01040859 > > persp(array.resistance(4,0,14,16,give=TRUE),theta=50,r=1e9,expand=0.6) > > > > cleanEx(); ..nameEx <- "circuit" > > ### * circuit > > flush(stderr()); flush(stdout()) > > ### Name: circuit > ### Title: Mensurates a circuit given potentials of some nodes > ### Aliases: circuit > ### Keywords: array > > ### ** Examples > > > #reproduce first example on ?cube: > v <- c(0,rep(NA,5),1,NA) > circuit(cube(),v) $potentials [1] 0.0 0.4 0.6 0.4 0.4 0.6 1.0 0.6 $currents [1] -1.2 0.0 0.0 0.0 0.0 0.0 1.2 0.0 > circuit(cube(),v+1000) $potentials [1] 1000.0 1000.4 1000.6 1000.4 1000.4 1000.6 1001.0 1000.6 $currents [1] -1.2 0.0 0.0 0.0 0.0 0.0 1.2 0.0 > > # problem: The nodes of a skeleton cube are at potentials > # 1,2,3,... volts. What current is needed to maintain this? Ans: > circuit(cube(),1:8) $potentials [1] 1 2 3 4 5 6 7 8 $currents [1] -8 -4 -4 0 0 4 4 8 > > #sanity check: maintain one node at 101 volts: > circuit(cube(),c(rep(NA,7),101)) $potentials [1] 101 101 101 101 101 101 101 101 $currents [1] 0 0 0 0 0 0 0 0 > > #now, nodes 1-4 have potential 1,2,3,4 volts. Nodes 5-8 each have one > #Amp shoved in them. What is the potential of nodes 5-8, and what > #current is needed to maintain nodes 1-4 at their potential? > # Answer: > v <- c(1:4,rep(NA,4)) > currents <- c(rep(NA,4),rep(1,4)) > circuit(cube(),v,currents) $potentials [1] 1.000000 2.000000 3.000000 4.000000 3.066667 3.266667 3.733333 3.933333 $currents [1] -6.0666667 -1.2666667 -0.7333333 4.0666667 1.0000000 1.0000000 1.0000000 [8] 1.0000000 > > > > > cleanEx(); ..nameEx <- "cube" > > ### * cube > > flush(stderr()); flush(stdout()) > > ### Name: cube > ### Title: Specimen conductance matrices > ### Aliases: cube tetrahedron octahedron dodecahedron icosahedron > ### Wheatstone Wheatstone > ### Keywords: array > > ### ** Examples > > > resistance(cube(),1,7) #known to be 5/6 ohm [1] 0.8333333 > resistance(cube(),1,2) #known to be 7/12 ohm [1] 0.5833333 > > resistance(octahedron(),1,6) #known to be 1/2 ohm [1] 0.5 > resistance(octahedron(),1,5) #known to be 5/12 ohm [1] 0.4166667 > > resistance(dodecahedron(),1,5) [1] 0.6333333 > > > > > cleanEx(); ..nameEx <- "currents" > > ### * currents > > flush(stderr()); flush(stdout()) > > ### Name: currents > ### Title: Calculates currents in an arbitrary resistor array > ### Aliases: currents currents.matrix > ### Keywords: array > > ### ** Examples > > currents(cube(),1,7) from to [1,] 1 2 0.3333333 [2,] 2 3 0.1666667 [3,] 1 4 0.3333333 [4,] 3 4 -0.1666667 [5,] 1 5 0.3333333 [6,] 2 6 0.1666667 [7,] 5 6 0.1666667 [8,] 3 7 0.3333333 [9,] 6 7 0.3333333 [10,] 4 8 0.1666667 [11,] 5 8 0.1666667 [12,] 7 8 -0.3333333 > currents.matrix(cube(),1,7) [,1] [,2] [,3] [,4] [,5] [,6] [1,] 0.0000000 0.3333333 0.0000000 0.3333333 0.3333333 0.0000000 [2,] -0.3333333 0.0000000 0.1666667 0.0000000 0.0000000 0.1666667 [3,] 0.0000000 -0.1666667 0.0000000 -0.1666667 0.0000000 0.0000000 [4,] -0.3333333 0.0000000 0.1666667 0.0000000 0.0000000 0.0000000 [5,] -0.3333333 0.0000000 0.0000000 0.0000000 0.0000000 0.1666667 [6,] 0.0000000 -0.1666667 0.0000000 0.0000000 -0.1666667 0.0000000 [7,] 0.0000000 0.0000000 -0.3333333 0.0000000 0.0000000 -0.3333333 [8,] 0.0000000 0.0000000 0.0000000 -0.1666667 -0.1666667 0.0000000 [,7] [,8] [1,] 0.0000000 0.0000000 [2,] 0.0000000 0.0000000 [3,] 0.3333333 0.0000000 [4,] 0.0000000 0.1666667 [5,] 0.0000000 0.1666667 [6,] 0.3333333 0.0000000 [7,] 0.0000000 -0.3333333 [8,] 0.3333333 0.0000000 > > #check above solution: print out the currents flowing into each node: > zapsmall(apply(currents.matrix(cube(),1,7),1,sum)) [1] 1 0 0 0 0 0 -1 0 > > > > cleanEx(); ..nameEx <- "ladder" > > ### * ladder > > flush(stderr()); flush(stdout()) > > ### Name: ladder > ### Title: Jacob's ladder of resistors > ### Aliases: ladder > ### Keywords: array > > ### ** Examples > > > ##Resistance of an infinite Jacob's ladder known to be (sqrt(5)-1)/2: > > phi <- (sqrt(5)-1)/2 > resistance(ladder(20),1,2) - phi [1] 2.220446e-16 > resistance(ladder(60),1,2) - phi [1] 0 > > Wu(ladder(20))[1,2]-phi [1] -2.220446e-16 > > > > > cleanEx(); ..nameEx <- "makefullmatrix" > > ### * makefullmatrix > > flush(stderr()); flush(stdout()) > > ### Name: makefullmatrix > ### Title: Conductance matrix for a lattice of unit resistors > ### Aliases: makefullmatrix > ### Keywords: array > > ### ** Examples > > makefullmatrix(3,3) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [1,] 4 -1 0 -1 0 0 -1 0 -1 [2,] -1 4 -1 0 -1 0 0 -1 0 [3,] 0 -1 4 -1 0 -1 0 0 -1 [4,] -1 0 -1 4 -1 0 -1 0 0 [5,] 0 -1 0 -1 4 -1 0 -1 0 [6,] 0 0 -1 0 -1 4 -1 0 -1 [7,] -1 0 0 -1 0 -1 4 -1 0 [8,] 0 -1 0 0 -1 0 -1 4 -1 [9,] -1 0 -1 0 0 -1 0 -1 4 > > > > cleanEx(); ..nameEx <- "platonic" > > ### * platonic > > flush(stderr()); flush(stdout()) > > ### Name: platonic > ### Title: Adjacency of platonic solids > ### Aliases: platonic > ### Keywords: array > > ### ** Examples > > platonic("octahedron") [,1] [,2] [1,] 1 2 [2,] 1 3 [3,] 1 4 [4,] 1 5 [5,] 2 3 [6,] 2 5 [7,] 2 6 [8,] 3 4 [9,] 3 6 [10,] 4 5 [11,] 4 6 [12,] 5 6 > > > > cleanEx(); ..nameEx <- "resistance" > > ### * resistance > > flush(stderr()); flush(stdout()) > > ### Name: resistance > ### Title: Resistance for arbitrarily connected networks of resistors > ### Aliases: resistance > ### Keywords: array > > ### ** Examples > > resistance(cube(),earth.node=1, input.node=7) #known to be 5/6 ohm [1] 0.8333333 > resistance(cube(),1,7, give=TRUE) [1] 0.0000000 0.3333333 0.5000000 0.3333333 0.3333333 0.5000000 0.8333333 [8] 0.5000000 > > > > cleanEx(); ..nameEx <- "series" > > ### * series > > flush(stderr()); flush(stdout()) > > ### Name: series > ### Title: Conductance matrix for resistors in series > ### Aliases: series > ### Keywords: array > > ### ** Examples > > ## Resistance of four resistors in series: > > resistance(series(rep(1,5)),1,5) ##sic! FOUR resistors have FIVE nodes [1] 4 > > ## What current do we need to push into a circuit of five equal > ## resistors in order to maintain the potentials at 1v, 2v, ..., 6v? > > circuit(series(rep(1,5)),v=1:6) $potentials [1] 1 2 3 4 5 6 $currents [1] -1 0 0 0 0 1 > > > > > ### *